/usr/share/doc/liblexical-persistence-perl/examples/persistence.perl is in liblexical-persistence-perl 0.98-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | #!/usr/bin/env perl
# $Id: persistence.perl 133 2006-11-13 08:25:49Z rcaputo $
# An OO form of genlex.perl. See Persistence.pm for the magic, or
# __END__ for sample output.
use warnings;
use strict;
use Lexical::Persistence;
# A handy target to show off persistence and not.
sub target {
my $arg_number; # Parameter.
my $narf_x++; # Persistent.
my $_i++; # Dynamic.
my $j++; # Persistent.
print " target arg_number($arg_number) narf_x($narf_x) _i($_i) j($j)\n";
}
### Create a context, and call something within it.
{
print "The call() way:\n";
my $persistence = Lexical::Persistence->new();
foreach my $number (qw(one two three four five)) {
$persistence->call(\&target, number => $number);
}
}
### Create a context, and wrap a function call in it.
{
print "The wrap() way:\n";
my $persistence = Lexical::Persistence->new();
my $thunk = $persistence->wrap(\&target);
foreach my $number (qw(one two three four five)) {
$thunk->(number => $number);
}
}
=for POE
### Subclass to handle some of POE's function call argument rules.
{
package PoeLex;
our @ISA = qw(Lexical::Persistence);
# TODO - Make these lazy so the work isn't done every call?
sub push_arg_context {
my $self = shift;
use POE::Session;
my %param = map { $_ - ARG0, $_[$_] } (ARG0..$#_);
my $old_arg_context = $self->get_context("arg");
$self->set_context(arg => \%param);
# Modify the catch-all context so it contains other arguments.
my $catch_all = $self->get_context("_");
@$catch_all{qw($kernel $heap $session $sender)} = @_[
KERNEL, HEAP, SESSION, SENDER
];
return $old_arg_context;
}
}
### Wrap a POE handler in PoeLex.
{
print "Using POE:\n";
use POE;
spawn();
POE::Kernel->run();
sub spawn {
my $persistence = PoeLex->new();
my %heap;
$persistence->set_context( heap => \%heap );
POE::Session->create(
heap => \%heap,
inline_states => {
_start => sub {
$_[KERNEL]->yield(moo => 0);
},
moo => $persistence->wrap(\&handle_moo),
},
);
}
# Here's a sample handler with persistence. $arg_0 has been aliased
# to $_[ARG0]. $heap_foo has been aliased to $_[HEAP]{foo}.
sub handle_moo {
my $arg_0++; # magic
my $heap_foo++; # more magic
my ($kernel, $heap); # also magic
print " moo: $arg_0 ... heap = $heap_foo ... heap b = $heap->{'$foo'}\n";
$kernel->yield(moo => $arg_0) if $arg_0 < 10;
}
}
=cut
exit;
__END__
The call() way:
target arg_number(one) narf_x(1) _i(1) j(1)
target arg_number(two) narf_x(2) _i(1) j(2)
target arg_number(three) narf_x(3) _i(1) j(3)
target arg_number(four) narf_x(4) _i(1) j(4)
target arg_number(five) narf_x(5) _i(1) j(5)
The wrap() way:
target arg_number(one) narf_x(1) _i(1) j(1)
target arg_number(two) narf_x(2) _i(1) j(2)
target arg_number(three) narf_x(3) _i(1) j(3)
target arg_number(four) narf_x(4) _i(1) j(4)
target arg_number(five) narf_x(5) _i(1) j(5)
Using POE:
moo: 1 ... heap = 1 ... heap b = 1
moo: 2 ... heap = 2 ... heap b = 2
moo: 3 ... heap = 3 ... heap b = 3
moo: 4 ... heap = 4 ... heap b = 4
moo: 5 ... heap = 5 ... heap b = 5
moo: 6 ... heap = 6 ... heap b = 6
moo: 7 ... heap = 7 ... heap b = 7
moo: 8 ... heap = 8 ... heap b = 8
moo: 9 ... heap = 9 ... heap b = 9
moo: 10 ... heap = 10 ... heap b = 10
|