ЭЛЕКТРОННАЯ БИБЛИОТЕКА КОАПП |
Сборники Художественной, Технической, Справочной, Английской, Нормативной, Исторической, и др. литературы. |
13.15. Creating Magic Variables with tieProblemYou want to add special processing to a variable or handle. SolutionUse the DiscussionAnyone who's ever used a DBM file under Perl has already used tied objects. Perhaps the most excellent way of using objects is such that the user never notices them. With The most important
Where did that Here's a simple example of a #!/usr/bin/perl # demo_valuering - show tie class use ValueRing; tie $color, 'ValueRing', qw(red blue); print "$color $color $color $color $color $color\n"; red blue red blue red blue $color = 'green'; print "$color $color $color $color $color $color\n"; green red blue green red blue The simple implementation is shown in Example 13.3. Example 13.3: ValueRingpackage ValueRing; # this is the constructor for scalar ties sub TIESCALAR { my ($class, @values) = @_; bless \@values, $class; return \@values; } # this intercepts read accesses sub FETCH { my $self = shift; push(@$self, shift(@$self)); return $self->[-1]; } # this intercepts write accesses sub STORE { my ($self, $value) = @_; unshift @$self, $value; return $value; } 1; This example might not be compelling, but it illustrates how easy it is to write ties of arbitrary complexity. To the user, For arrays and hashes, more elaborate operations are possible. Tied handles didn't appear until the 5.004 release, and prior to 5.005 use of tied arrays was somewhat limited, but tied hashes have always been richly supported. Because so many object methods are needed to fully support tied hashes, most users choose to inherit from the standard Tie::Hash module, which provides default methods for these. Following are numerous examples of interesting uses of ties. Tie Example: Outlaw $_This curious tie class is used to outlaw unlocalized uses of the implicit variable, no UnderScore; Then, all uses of the unlocalized global Here's a little test suite for the module. #!/usr/bin/perl # nounder_demo - show how to ban $_ from your program no UnderScore; @tests = ( "Assignment" => sub { $_ = "Bad" }, "Reading" => sub { print }, "Matching" => sub { $x = /badness/ }, "Chop" => sub { chop }, "Filetest" => sub { -x }, "Nesting" => sub { for (1..3) { print } }, ); while ( ($name, $code) = splice(@tests, 0, 2) ) { print "Testing $name: "; eval { &$code }; print $@ ? "detected" : "missed!"; print "\n"; } The result is the following:
The reason the last one was missed is that it was properly localized by the The UnderScore module itself is shown in Example 13.4. Notice how small it is. The module itself does the Example 13.4: UnderScore (continued)package UnderScore; use Carp; sub TIESCALAR { my $class = shift; my $dummy; return bless \$dummy => $class; } sub FETCH { croak "Read access to \$_ forbidden" } sub STORE { croak "Write access to \$_ forbidden" } sub unimport { tie($_, __PACKAGE__) } sub import { untie $_ } tie($_, __PACKAGE__) unless tied $_; 1; You can't usefully mix calls to Tie Example: Make a Hash That Always AppendsThe class shown below produces a hash whose keys accumulate in an array. #!/usr/bin/perl # appendhash_demo - show magic hash that autoappends use Tie::AppendHash; tie %tab, 'Tie::AppendHash'; $tab{beer} = "guinness"; $tab{food} = "potatoes"; $tab{food} = "peas"; while (my($k, $v) = each %tab) { print "$k => [@$v]\n"; } Here is the result: food => [potatoes peas] beer => [guinness] To make this class easy, we will use the boilerplate hash tying module from the standard distribution, shown in Example 13.5. To do this, we load the Tie::Hash module and then inherit from the Tie::StdHash class. (Yes, those are different names. The file Tie/Hash.pm provides both the Tie::Hash and Tie::StdHash classes, which are slightly different.) Example 13.5: Tie::AppendHashpackage Tie::AppendHash; use strict; use Tie::Hash; use Carp; use vars qw(@ISA); @ISA = qw(Tie::StdHash); sub STORE { my ($self, $key, $value) = @_; push @{$self->{$key}}, $value; } 1; Tie Example: Case-Insensitive HashHere's a fancier hash tie called Tie::Folded. It provides a hash with case-insensitive keys. #!/usr/bin/perl # folded_demo - demo hash that magically folds case use Tie::Folded; tie %tab, 'Tie::Folded'; $tab{VILLAIN} = "big "; $tab{herOine} = "red riding hood"; $tab{villain} .= "bad wolf"; while ( my($k, $v) = each %tab ) { print "$k is $v\n"; } The following is the output of this demo program: heroine is red riding hood villain is big bad wolf Because we have to trap more accesses, the class in Example 13.6 is slightly more complicated than the one in Example 13.5. Example 13.6: Tie::Foldedpackage Tie::Folded; use strict; use Tie::Hash; use vars qw(@ISA); @ISA = qw(Tie::StdHash); sub STORE { my ($self, $key, $value) = @_; return $self->{lc $key} = $value; } sub FETCH { my ($self, $key) = @_; return $self->{lc $key}; } sub EXISTS { my ($self, $key) = @_; return exists $self->{lc $key}; } sub DEFINED { my ($self, $key) = @_; return defined $self->{lc $key}; } 1; Tie Example: Hash That Allows Look-Ups by Key or ValueHere is a hash that lets you look up members by key or by value. It does this by having a store method that not only uses the key to store the value, it also uses the value to store the key. Normally there could be a problem if the value being stored were a reference, since you can't normally use a reference as a key. The standard distribution comes with the Tie::RefHash class that avoids this problem. We'll inherit from it so that we can also avoid this difficulty. #!/usr/bin/perl -w # revhash_demo - show hash that permits key *or* value lookups use strict; use Tie::RevHash; my %tab; tie %tab, 'Tie::RevHash'; %tab = qw{ Red Rojo Blue Azul Green Verde }; $tab{EVIL} = [ "No way!", "Way!!" ]; while ( my($k, $v) = each %tab ) { print ref($k) ? "[@$k]" : $k, " => ", ref($v) ? "[@$v]" : $v, "\n"; } When run, revhash_demo produces this: [No way! Way!!] => EVIL EVIL => [No way! Way!!] Blue => Azul Green => Verde Rojo => Red Red => Rojo Azul => Blue Verde => Green The module is shown in Example 13.7. Notice how small it is! Example 13.7: Tie::RevHashpackage Tie::RevHash; use Tie::RefHash; use vars qw(@ISA); @ISA = qw(Tie::RefHash); sub STORE { my ($self, $key, $value) = @_; $self->SUPER::STORE($key, $value); $self->SUPER::STORE($value, $key); } sub DELETE { my ($self, $key) = @_; my $value = $self->SUPER::FETCH($key); $self->SUPER::DELETE($key); $self->SUPER::DELETE($value); } 1; Tie Example: Handle That Counts AccessHere's an example of tying a filehandle: use Counter; tie *CH, 'Counter'; while (<CH>) { print "Got $_\n"; } When run, that program keeps printing Example 13.8: Counterpackage Counter; sub TIEHANDLE { my $class = shift; my $start = shift; return bless \$start => $class; } sub READLINE { my $self = shift; return ++$$self; } 1; Tie Example: Multiple Sink FilehandlesFinally, here's an example of a tied handle that implements a tee-like functionality by twinning standard out and standard error: use Tie::Tee; tie *TEE, 'Tie::Tee', *STDOUT, *STDERR; print TEE "This line goes both places.\n"; Or, more elaborately: #!/usr/bin/perl # demo_tietee use Tie::Tee; use Symbol; @handles = (*STDOUT); for $i ( 1 .. 10 ) { push(@handles, $handle = gensym()); open($handle, ">/tmp/teetest.$i"); } tie *TEE, 'Tie::Tee', @handles; print TEE "This lines goes many places.\n"; The Tie/Tee.pm file is shown in Example 13.9. Example 13.9: Tie::Teepackage Tie::Tee; sub TIEHANDLE { my $class = shift; my $handles = [@_]; bless $handles, $class; return $handles; } sub PRINT { my $href = shift; my $handle; my $success = 0; foreach $handle (@$href) { $success += print $handle @_; } return $success == @$href; } 1; See AlsoThe |