From: Perl 5 Porters Date: Sun, 25 Aug 1996 00:01:52 +0000 (+0000) Subject: Add support for tied filehandles. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a7adf1f0561599b9a11ff504577b6171e6441757;p=p5sagit%2Fp5-mst-13.2.git Add support for tied filehandles. --- diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 5d9d63f..1fd2c6b 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -46,7 +46,7 @@ op_names_init() while(i-- > 0) bitmap[i] = 0xFF; /* Take care to set the right number of bits in the last byte */ - bitmap[len-1] = ~(~0 << (maxo & 0x07)); + bitmap[len-1] = (maxo & 0x07) ? ~(~0 << (maxo & 0x07)) : 0xFF; put_op_bitspec(":all",0, opset_all); /* don't mortalise */ } diff --git a/pod/perltie.pod b/pod/perltie.pod index 658425e..c5d3686 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -33,13 +33,14 @@ In the tie() call, C is the name of the variable to be enchanted. C is the name of a class implementing objects of the correct type. Any additional arguments in the C are passed to the appropriate constructor method for that class--meaning TIESCALAR(), -TIEARRAY(), or TIEHASH(). (Typically these are arguments such as might be -passed to the dbminit() function of C.) The object returned by the "new" -method is also returned by the tie() function, which would be useful if -you wanted to access other methods in C. (You don't actually -have to return a reference to a right "type" (e.g. HASH or C) -so long as it's a properly blessed object.) You can also retrieve -a reference to the underlying object using the tied() function. +TIEARRAY(), TIEHASH() or TIEHANDLE(). (Typically these are arguments +such as might be passed to the dbminit() function of C.) The object +returned by the "new" method is also returned by the tie() function, +which would be useful if you wanted to access other methods in +C. (You don't actually have to return a reference to a right +"type" (e.g. HASH or C) so long as it's a properly blessed +object.) You can also retrieve a reference to the underlying object +using the tied() function. Unlike dbmopen(), the tie() function will not C or C a module for you--you need to do that explicitly yourself. @@ -159,7 +160,7 @@ argument--the new value the user is trying to assign. =item DESTROY this This method will be triggered when the tied variable needs to be destructed. -As with other object classes, such a method is seldom ncessary, since Perl +As with other object classes, such a method is seldom necessary, since Perl deallocates its moribund object's memory for you automatically--this isn't C++, you know. We'll use a DESTROY method here for debugging purposes only. @@ -608,7 +609,55 @@ use the each() function to iterate over such. Example: =head2 Tying FileHandles -This isn't implemented yet. Sorry; maybe someday. +This is partially implemeted now. + +A class implementing a tied scalar should define the folowing methods: +TIEHANDLE, PRINT, and possibly DESTROY. + +In future READLINE, EOF and possibly others will be added. + +It is especially useful when perl is embedded in some other program, +where output to STDOUT and STDERR may have to be redirected in some +special way. See nvi and the Apache module for examples. + +In our example we're going to create a shouting handle. + + package Shout; + +=over + +=item TIEHANDLE classname, LIST + +This is the constructor for the class. That means it is expected to +return a blessed reference of some sort. The refence can be used to +hold some internal information. We won't use it in out example. + + sub TIEHANDLE { print "\n"; bless [], shift } + +=item PRINT this, LIST + +This method will be triggered every time the tied handle is printed to. +Beyond its self refence it also expects the list that was passed to +the print function. + + sub PRINT { shift; for (@_) { print uc($_) } } + +=item DESTROY this + +As with the other types of ties, this method will be called when the +tied handle is about to be destroyed. This is useful for debugging and +possibly cleaning up. + + sub DESTROY { print "\n" } + +=back + +Here's how to use our little example: + + tie(*FOO,'Shout'); + print FOO "hello\n"; + $a = 4; $b = 6; + print FOO $a, " plus ", $b, " equals ", $a + $b, "\n"; =head1 SEE ALSO @@ -632,3 +681,5 @@ source code to MLDBM. =head1 AUTHOR Tom Christiansen + +TIEHANDLE by Sven Verdoolaege diff --git a/t/lib/opcode.t b/t/lib/opcode.t index e171aca..a785fce 100755 --- a/t/lib/opcode.t +++ b/t/lib/opcode.t @@ -77,7 +77,7 @@ print @o2 == opcodes-3 ? "ok $t\n" : "not ok $t\n"; $t++; die $t unless $t == 16; print opmask() eq empty_opset() ? "ok $t\n" : "not ok $t\n"; $t++; # work -print length opmask() == int(opcodes()/8)+1 ? "ok $t\n" : "not ok $t\n"; $t++; +print length opmask() == int((opcodes()+7)/8) ? "ok $t\n" : "not ok $t\n"; $t++; # --- verify_opset diff --git a/t/op/misc.t b/t/op/misc.t index 8fdd11a..3b88a0a 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -169,3 +169,25 @@ BEGIN { undef = 0 } EXPECT Modification of a read-only value attempted at - line 1. BEGIN failed--compilation aborted at - line 1. +######## +{ + package foo; + sub PRINT { + shift; + print join(' ', reverse @_)."\n"; + } + sub TIEHANDLE { + bless {}, shift; + } + sub DESTROY { + print "and destroyed as well\n"; + } +} +{ + local(*FOO); + tie(*FOO,'foo'); + print FOO "sentence.", "reversed", "a", "is", "This"; +} +EXPECT +This is a reversed sentence. +and destroyed as well