1: sub DESTROY { print "stick a fork in '$_[0]' it's done\n" } 2: 3: my $foo = bless []; 4: { 5: my $bar = bless {}; 6: ## keep $bar around 7: push @$foo => \$bar; 8: 9: print "in \$bar's [$bar] lexical scope\n"; 10: } 11: 12: print "we've left \$bar's lexical scope\n"; __output__ in $bar's [main=HASH(0x80fbbf0)] lexical scope we've left $bar's lexical scope stick a fork in 'main=ARRAY(0x80fbb0c)' it's done stick a fork in 'main=HASH(0x80fbbf0)' it's done #### 1: { 2: my $foo = "a string"; 3: INNER: { 4: print "\$foo: [$foo]\n"; 5: } 6: } 7: goto INNER unless $i++; __output__ $foo: [a string] $foo: [] #### 1: { 2: my $foo = "a string"; 3: sub inner { 4: print "\$foo: [$foo]\n"; 5: } 6: } 7: inner(); 8: inner(); __output__ $foo: [a string] $foo: [a string] #### 1: { 2: my $cnt = 5; 3: sub counter { 4: return $cnt--; 5: } 6: } 7: 8: while(my $i = counter()) { 9: print "$i\n"; 10: } 11: print "BOOM!\n"; __output__ 5 4 3 2 1 BOOM! #### 1: sub counter { 2: my $cnt = shift; 3: return sub { $cnt-- }; 4: } 5: 6: my $cd = counter(5); 7: while(my $i = $cd->()) { 8: print "$i\n"; 9: } 10: 11: print "BOOM!\n"; __output__ 5 4 3 2 1 BOOM! #### 1: use IO::Dir; 2: 3: sub dir_iter { 4: my $dir = IO::Dir->new(shift) or die("ack: $!"); 5: 6: return sub { 7: my $fl = $dir->read(); 8: $dir->rewind() unless defined $fl; 9: return $fl; 10: }; 11: } 12: 13: my $di = dir_iter( "." ); 14: while(defined(my $f = $di->())) { 15: print "$f\n"; 16: } __output__ . .. .closuretut.html.swp closuretut.html example5.pl example6.pl example2.pl example1.pl example3.pl example4.pl example7.pl #### 1: use strict; 2: use warnings; 3: 4: use XML::Simple; 5: use Getopt::Std; 6: use File::Basename; 7: use File::Find::Rule; 8: use Data::Dumper; 9: 10: $::PROGRAM = basename $0; 11: 12: getopts('n:t:hr', my $opts = {}); 13: 14: usage() if $opts->{h} or @ARGV == 0; 15: 16: my @dirs = $opts->{r} ? @ARGV : map dirname($_), @ARGV; 17: my @files = $opts->{r} ? '*.xml' : map basename($_), @ARGV; 18: my $callback = gensub($opts); 19: 20: my @found = find( 21: file => 22: name => \@files, 23: ## handy callback which wraps around the callback created above 24: exec => sub { $callback->( XMLin $_[-1] ) }, 25: in => [ @dirs ] 26: ); 27: 28: print "$::PROGRAM: no files matched the search criteria\n" and exit(0) 29: if @found == 0; 30: 31: print "$::PROGRAM: the following files matched the search criteria\n", 32: map "\t$_\n", @found; 33: 34: exit(0); 35: 36: sub usage { 37: print "Usage: $::PROGRAM -t TEXT [-n NODE -h -r] FILES\n"; 38: exit(0); 39: } 40: 41: sub gensub { 42: my $opts = shift; 43: 44: ## basic matcher wraps around the program options 45: return sub { Dumper($_[0]) =~ /\Q$opts->{t}/sm } 46: unless exists $opts->{n}; 47: 48: ## node based matcher wraps around options and itself! 49: my $self; $self = sub { 50: my($tree, $seennode) = @_; 51: 52: for(keys %$tree) { 53: $seennode = 1 if $_ eq $opts->{n}; 54: 55: if( ref $tree->{$_} eq 'HASH') { 56: return $self->($tree->{$_}, $seennode); 57: } elsif( ref $tree->{$_} eq 'ARRAY') { 58: return !!grep $self->($_, $seennode), @{ $tree->{$_} }; 59: } else { 60: next unless $seennode; 61: return !!1 62: if $tree->{$_} =~ /\Q$opts->{t}/; 63: } 64: } 65: return; 66: }; 67: 68: return $self; 69: }