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: }