#!perl -w

##  Note that this example only works as described if the "-w" switch
##  is set!

# ======================================================================
#   $toplocation = Data::Locations->new();
#   $sublocation = $location->new();
#   $location->filename($filename);
#   $location->print(@items);
#   $location->print($sublocation);
#   @list = $location->read();
# ======================================================================

package Non::Sense;

##  (This is to demonstrate that this example works with ANY package)

use Data::Locations;
use FileHandle;

use strict;
no strict "vars";

print "1..2\n";

$n = 1;

$self = $0;
$self =~ s!^.*/!!;

$temp = $ENV{'TMP'} || $ENV{'TEMP'} || '/tmp';
$temp =~ s!/+$!!;

$file = "$temp/$self.$$";

##  Redirect all output sent to STDOUT:

unless (open(FILE, ">$file"))
{
    die "$self: can't write '$file': \L$!\E\n";
}

##  Create scope for redirected STDOUT:

{
    local(*STDOUT) = *FILE;
    
    ##  Create the topmost location:
    
    $level0 = Data::Locations->new("level0.txt");
    
    print $level0 <<'VERBATIM';
Printing first line to location 'level0' via OPERATOR 'print'.
VERBATIM
    
    ##  Create an embedded location (nested 1 level deep):
    
    $level1 = $level0->new();
    
    $level0->print(<<'VERBATIM');
Printing last line to location 'level0' via METHOD 'print'.
VERBATIM
    
    ##  Now "tie" the embedded location to file handle STDOUT:
    
    $level1->tie('STDOUT');
    
    print "Printing to location 'level1' via STDOUT.\n";
    
    ##  Create another location (which will be embedded later):
    
    $level2 = Data::Locations->new();
    
    ##  Create a file handle ("IO::Handle" works equally well):
    
    $fh = FileHandle->new();
    
    ##  Now "tie" the location "$level2" to this file handle "$fh":
    
    $level2->tie($fh);
    
    ##  And select "$fh" as the default output file handle:
    
    select($fh);
    
    print "Printing to location 'level2' via default file handle '\$fh'.\n";
    
    ##  Embed location "$level2" in location "$level1":
    
    print $level1 $level2;
    
    ##  (Automatically removes "toplevel" status from location "$level2")
    
    print STDOUT "Printing to location 'level1' explicitly via STDOUT.\n";
    
    ##  Create a third embedded location (nested 3 levels deep):
    
    $level3 = $level2->new();
    
    ##  Restore STDOUT as the default output file handle:
    
    select(STDOUT);
    
    print $fh "Printing to location 'level2' via file handle '\$fh'.\n";
    
    ##  Trap all warnings:
    
    $SIG{__WARN__} = sub
    {
        print STDERR "WARNING intercepted:\n", @_, "End Of Warning.\n";
    };
    
    ##  Note that WITHOUT this trap, warnings would go to the system
    ##  standard error device DIRECTLY, WITHOUT passing through the
    ##  file handle STDERR!
    
    ##  Now "tie" location "$level3" to file handle STDERR:
    
    $level3->tie(*STDERR);
    
    ##  Provoke a warning message (don't forget the "-w" switch!):
    
    $fake = \$fh;
    $level3->print($fake);
    
    ##  Provoke another warning message (don't forget the "-w" switch!):
    
    $level3->dump();
    
    {
        ##  Silence warning that reference count of location is still > 0:
    
        local($^W) = 0;
    
        ##  And untie file handle STDOUT from location "$level1":
    
        untie *STDOUT;
    }
    
    print "Now STDOUT goes to the screen again.\n";
    
    ##  Read from location "$level3":
    
    while (<STDERR>)  ##  Copy warning messages to the screen:
    {
        print if
        (s/^Data::Locations::.+?\(\):\s+(.+?)\s+at\s+.+$/Warning: $1/m);
    }
    
    while (<STDERR>) { print; }
    
    ##  (Prints nothing because location was already read past its end)
    
    ##  Reset the internal reading mark:
    
    (tied *{STDERR})->reset();
    
    ##  (You should usually use "$level3->reset();", though!)
    
    while (<STDERR>) { print; }
    
    ##  (Copies the contents of location "$level3" to the screen)
}

##  (End of scope for redirected STDOUT)

close(FILE);
    
##  Read output file "level0.txt":

$txt = join('', $level0->read());
$ref = <<"VERBATIM";
Printing first line to location 'level0' via OPERATOR 'print'.
Printing to location 'level1' via STDOUT.
Printing to location 'level2' via default file handle '\$fh'.
WARNING intercepted:
Data::Locations::print(): reference 'REF' ignored at t/$self line 125
End Of Warning.
WARNING intercepted:
Data::Locations::dump(): filename missing or empty at t/$self line 129
End Of Warning.
Printing to location 'level2' via file handle '\$fh'.
Printing to location 'level1' explicitly via STDOUT.
Printing last line to location 'level0' via METHOD 'print'.
VERBATIM

if ($txt eq $ref)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

unless (open(FILE, "<$file"))
{
    die "$self: can't read '$file': \L$!\E\n";
}
$txt = join('', <FILE>);
close(FILE);
unlink($file);

$ref = <<"VERBATIM";
Now STDOUT goes to the screen again.
Warning: reference 'REF' ignored
Warning: filename missing or empty
WARNING intercepted:
Data::Locations::print(): reference 'REF' ignored at t/$self line 125
End Of Warning.
WARNING intercepted:
Data::Locations::dump(): filename missing or empty at t/$self line 129
End Of Warning.
VERBATIM

if ($txt eq $ref)
{print "ok $n\n";} else {print "not ok $n\n";}
$n++;

__END__

