Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Re^2: Breaking Tie::Hash into three modules

by afoken (Chancellor)
on Sep 10, 2018 at 21:52 UTC ( [id://1222096]=note: print w/replies, xml ) Need Help??


in reply to Re: Breaking Tie::Hash into three modules
in thread Breaking Tie::Hash into three modules

Perhaps the way to go would be making the three modules into just one: Tie::Hash. Same with Tie::Array and Tie::Scalar.

And for completeness, also merge Tie::StdHandle into Tie::Handle.

I really like that idea. I shortly thought about it, but I did not have the courage to drastically change the behaviour of Tie::Hash, Tie::Array, Tie::Scalar, and Tie::Handle.

But:

Looking again at the source, there is a pattern in Tie::Array, Tie::Hash, and Tie::Handle, hidden between the nonsense code: All three classes implement methods for inheriting classes that do NOT depend on the actual implementation of the class, but use existing primitive methods. And I think that for this reason, we should keep the class names and functionality as they are now. The generic class implements generic methods that allow omitting some methods in inheriting classes, even with completely different inner structures, and the Std* class implements standard behaviour based on a trivial blessed reference of the respective type.

Tie::Hash

In case of Tie::Hash, there is only CLEAR() that slowly clears the tied hash by iterating over all keys and removing them one after the other. Consequentially, both Tie::StdHash and Tie::ExtraHash implement faster variants that simply assign an empty list to the internal hash.

All of the other methods in Tie::Hash are just code that complains where perl would also complain without any extra code. use Carp, use warnings::register, and the methods new(), TIEHASH(), and EXISTS() can simply be removed from Tie::Hash.

Tie::Array

The methods UNSHIFT, SHIFT, CLEAR, PUSH, POP, and SPLICE, and EXTEND in Tie::Array are again generic methods that do not depend on the implementation.

The remaining methods EXISTS and DELETE in Tie::Array just complain, and DESTROY is redundant. They all should be removed.

Tie::StdArray implements standard array behaviour in short and efficient code, reimplementing most of the methods in Tie::Array with faster code.

Tie::Scalar

A scalar is so simple that it needs only three methods. All of them are primitive and can not be replaced by calls to other methods. Consequentially, Tie::Scalar contains only code to complain, all of it should be removed: All methods, use Carp, and use warnings::register. What remains is POD, the package Tie::Scalar, and our $VERSION. Moving Tie::StdScalar to Tie/StdScalar.pm breaks backwards compatibility, so use Tie::StdScalar should be added to Tie::Scalar. Also, Tie::StdScalar should keep inheriting from the empty Tie::Scalar.

Yes, it looks like nonsense. But it allows to add more methods to a tied scalar class in future perl versions, and having a sane default for the extra methods in either Tie::Scalar or Tie::StdScalar.

Tie::Handle

Tie::Handle once again contains some generic methods (PRINT and PRINTF use WRITE, GETC uses READ), and several complaining methods (TIEHANDLE, READLINE, READ, WRITE, CLOSE), as well as the useless new(). new() and the complaining ones have to go. Tie::StdHandle implements all standard methods, and a simpler version of GETC. No changes needed here, except for the wrong class name in the SYNOPSIS section of the POD.

Backwards compatibility needed?

I wanted to know which CPAN modules use one of the Tie::* classes, and which of those modules actually use the new() nonsense. https://grep.metacpan.org/search?size=20&q=Tie%3A%3A&qd=*&qft= runs into an HTTP 500 error. Is there a better way than downloading and unpacking the entire CPAN?

Alexander

--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

Replies are listed 'Best First'.
Re^3: Breaking Tie::Hash into three modules
by afoken (Chancellor) on Sep 22, 2018 at 10:32 UTC

    There is a life outside Perl, that keeps me dry, warm and well-fed. But sometimes, it needs time I wanted to use for perl. So, after an unplanned delay, here are ...

    Even more patches

    Preparing

    I've downloaded perl 5.28.0 from cpan to a spare machine, unpacked and compiled it, and run its test. No errors, no warnings, no problems. So my testing environment (Slackware 14.2) is ok. I did not expect anything else.

    Then, I did the same after changing Tie/Scalar.pm, Tie/Array.pm, Tie/Hash.pm and moving the Tie::Scalar, Tie::StdArray, Tie::StdHash, and Tie::ExtraHash classes to new files. I've completely removed Carp, warnings::register and new(). The latter is nonsense, as explained in Re: Breaking Tie::Hash into three modules and in Note 1 below. Removing new() made all of the checks and warnings in the dummy TIEARRAY() / TIESCALAR() / TIEHASH() constructors obsolete, and because they contained no useful code beyond that, I just removed them. I also removed dummy methods that just called called croak() together with Carp used only there. If the constructors or required methods are missing, tie will complain as loudly as the code in the dummy constructors and methods did before. No Perl code needed for that.

    Perl compiled fine, but unrelated tests failed. Typos, missing edits, you name it. The new files have to be added to MANIFEST. D'oh! Could have thought of that. Maintainers.pl complains about the new files. Patch that, wash, rinse, repeat.

    Strange Tests

    With clean code, some tests still failed. Not because the cleanup did not work. It worked fine, not a single test complained about the methods I've moved around or removed. They failed because abusing the classes did not cause the same errors as before.

    They failed because the nonsense new() constructor no longer existed that tie never ever calls. lib/Tie/scalar.t explicitly calls Tie::StdScalar->new(). No sane code would do that!

    Patching Tests

    I've considered a long time if I should treat the tests like a requirement document that must not be changed. And yes, for me, they are a kind of requirement document, but with bad wording. Following the wording would have meant to re-introduce all of that nonsense code around new() just to pass the unmodified tests.

    I choose to follow the spirit, but not the words of that implied requirement document. Wrong or missing constructors shall fail, and I won't change that requirement. But I will change the test that checks for the exact error message. And because I've removed the nonsense new(), the tests rotating around that will have to go.

    A huge patch

    34 kBytes, 1128 lines. Much of the POD for the new files wss copied, and moving stuff from one file to another really inflates diff output. If there was a notation for "move this chunk of text to that file", the output would be much shorter.

    diff -Naur perl-5.28.0.orig/MANIFEST perl-5.28.0/MANIFEST --- perl-5.28.0.orig/MANIFEST 2018-05-23 15:29:56.000000000 +0200 +++ perl-5.28.0/MANIFEST 2018-09-16 18:29:15.492576340 +0200 @@ -4747,7 +4747,8 @@ lib/Tie/Array/splice.t Test for Tie::Array::SPLICE lib/Tie/Array/std.t Test for Tie::StdArray lib/Tie/Array/stdpush.t Test for Tie::StdArray -lib/Tie/ExtraHash.t Test for Tie::ExtraHash (in Tie/Hash.pm) +lib/Tie/ExtraHash.pm Tie::ExtraHash +lib/Tie/ExtraHash.t Test for Tie::ExtraHash lib/Tie/Handle.pm Base class for tied handles lib/Tie/Handle/stdhandle.t Test for Tie::StdHandle lib/Tie/Handle/stdhandle_from_handle.t Test for Tie::StdHandle/Han +dle backwards compat @@ -4755,7 +4756,10 @@ lib/Tie/Hash.t See if Tie::Hash works lib/Tie/Scalar.pm Base class for tied scalars lib/Tie/Scalar.t See if Tie::Scalar works +lib/Tie/StdArray.pm Tie::StdArray lib/Tie/StdHandle.pm Tie::StdHandle +lib/Tie/StdHash.pm Tie::StdHash +lib/Tie/StdScalar.pm Tie::StdScalar lib/Tie/SubstrHash.pm Compact hash for known key, value and ta +ble size lib/Tie/SubstrHash.t Test for Tie::SubstrHash lib/Time/gmtime.pm By-name interface to Perl's builtin gmtime diff -Naur perl-5.28.0.orig/Porting/Maintainers.pl perl-5.28.0/Porting +/Maintainers.pl --- perl-5.28.0.orig/Porting/Maintainers.pl 2018-06-19 23:15:34.000 +000000 +0200 +++ perl-5.28.0/Porting/Maintainers.pl 2018-09-16 19:08:13.32743827 +1 +0200 @@ -1406,12 +1406,15 @@ lib/Thread.{pm,t} lib/Tie/Array.pm lib/Tie/Array/ - lib/Tie/ExtraHash.t + lib/Tie/ExtraHash.{pm,t} lib/Tie/Handle.pm lib/Tie/Handle/ lib/Tie/Hash.{pm,t} lib/Tie/Scalar.{pm,t} + lib/Tie/StdArray.pm lib/Tie/StdHandle.pm + lib/Tie/StdHash.pm + lib/Tie/StdScalar.pm lib/Tie/SubstrHash.{pm,t} lib/Time/gmtime.{pm,t} lib/Time/localtime.{pm,t} diff -Naur perl-5.28.0.orig/lib/Tie/Array.pm perl-5.28.0/lib/Tie/Array +.pm --- perl-5.28.0.orig/lib/Tie/Array.pm 2018-05-21 14:29:23.000000000 + +0200 +++ perl-5.28.0/lib/Tie/Array.pm 2018-09-16 19:08:59.525376168 +020 +0 @@ -2,12 +2,13 @@ use 5.006_001; use strict; -use Carp; -our $VERSION = '1.07'; +use warnings; +use Tie::StdArray (); # for backwards compatibility + +our $VERSION = '1.08'; # Pod documentation after __END__ below. -sub DESTROY { } sub EXTEND { } sub UNSHIFT { scalar shift->SPLICE(0,0,@_) } sub SHIFT { shift->SPLICE(0,1) } @@ -72,42 +73,6 @@ return wantarray ? @result : pop @result; } -sub EXISTS { - my $pkg = ref $_[0]; - croak "$pkg doesn't define an EXISTS method"; -} - -sub DELETE { - my $pkg = ref $_[0]; - croak "$pkg doesn't define a DELETE method"; -} - -package Tie::StdArray; -our @ISA = 'Tie::Array'; - -sub TIEARRAY { bless [], $_[0] } -sub FETCHSIZE { scalar @{$_[0]} } -sub STORESIZE { $#{$_[0]} = $_[1]-1 } -sub STORE { $_[0]->[$_[1]] = $_[2] } -sub FETCH { $_[0]->[$_[1]] } -sub CLEAR { @{$_[0]} = () } -sub POP { pop(@{$_[0]}) } -sub PUSH { my $o = shift; push(@$o,@_) } -sub SHIFT { shift(@{$_[0]}) } -sub UNSHIFT { my $o = shift; unshift(@$o,@_) } -sub EXISTS { exists $_[0]->[$_[1]] } -sub DELETE { delete $_[0]->[$_[1]] } - -sub SPLICE -{ - my $ob = shift; - my $sz = $ob->FETCHSIZE; - my $off = @_ ? shift : 0; - $off += $sz if $off < 0; - my $len = @_ ? shift : $sz-$off; - return splice(@$ob,$off,$len,@_); -} - 1; __END__ @@ -119,8 +84,7 @@ =head1 SYNOPSIS package Tie::NewArray; - use Tie::Array; - @ISA = ('Tie::Array'); + use parent 'Tie::Array'; # mandatory methods sub TIEARRAY { ... } @@ -142,37 +106,21 @@ sub EXTEND { ... } sub DESTROY { ... } - package Tie::NewStdArray; - use Tie::Array; - - @ISA = ('Tie::StdArray'); - - # all methods provided by default - package main; $object = tie @somearray,'Tie::NewArray'; - $object = tie @somearray,'Tie::StdArray'; - $object = tie @somearray,'Tie::NewStdArray'; - =head1 DESCRIPTION This module provides methods for array-tying classes. See L<perltie> for a list of the functions required in order to tie an ar +ray -to a package. The basic B<Tie::Array> package provides stub C<DESTROY +>, -and C<EXTEND> methods that do nothing, stub C<DELETE> and C<EXISTS> -methods that croak() if the delete() or exists() builtins are ever ca +lled -on the tied array, and implementations of C<PUSH>, C<POP>, C<SHIFT>, +to a package. The basic B<Tie::Array> package provides a stub +C<EXTEND> method that does nothing, +and implementations of C<PUSH>, C<POP>, C<SHIFT>, C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STOR +E>, C<FETCHSIZE>, C<STORESIZE>. -The B<Tie::StdArray> package provides efficient methods required for +tied arrays -which are implemented as blessed references to an "inner" perl array. -It inherits from B<Tie::Array>, and should cause tied arrays to behav +e exactly -like standard arrays, allowing for selective overloading of methods. - For developers wishing to write their own tied arrays, the required m +ethods are briefly defined below. See the L<perltie> section for more detail +ed descriptive, as well as example code: @@ -270,6 +218,18 @@ =back +=head1 CHANGES + +C<Tie::Array> up to version 1.07 had an unnecessarily complex setup +of C<TIEARRAY()> and C<new()>. To inherit from C<Tie::Array>, just ad +d +a C<TIEARRAY()> constructor to your class. If your code used C<new()> +, just +rename it to C<TIEARRAY()>. C<new()> is gone, and so are C<Carp> and +C<warnings::register>. + +C<Tie::StdArray> was included in C<Tie::Array> up to version 1.07. No +w, +it is a properly separated classes. C<Tie::Array> still loads it to a +void +breaking code. + =head1 CAVEATS There is no support at present for tied @ISA. There is a potential co +nflict diff -Naur perl-5.28.0.orig/lib/Tie/ExtraHash.pm perl-5.28.0/lib/Tie/E +xtraHash.pm --- perl-5.28.0.orig/lib/Tie/ExtraHash.pm 1970-01-01 01:00:00.00000 +0000 +0100 +++ perl-5.28.0/lib/Tie/ExtraHash.pm 2018-09-16 18:01:49.062782093 ++0200 @@ -0,0 +1,100 @@ +package Tie::ExtraHash; + +use strict; +use warnings; +use parent 'Tie::Hash'; # allow for new methods in future versions of + perl + +our $VERSION = '1.06'; + +=head1 NAME + +Tie::ExtraHash - base class definition for tied hashes + +=head1 SYNOPSIS + + package NewExtraHash; + + use parent 'Tie::ExtraHash'; + + # All methods provided by default, define + # only those needing overrides + # Accessors access the storage in %{$_[0][0]}; + # TIEHASH should return an array reference with the first element + # being the reference to the actual storage + sub DELETE { + $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer + delete $_[0][0]->{$_[1]}; # $_[0]->SUPER::DELETE($_[1 +]) + } + + + package main; + + tie %new_extra_hash, 'NewExtraHash', + sub {warn "Doing \U$_[1]\E of $_[2].\n"}; + +=head1 DESCRIPTION + + +This module provides some skeletal methods for hash-tying classes, +behaving exactly like standard hashes +and allows for selective overwriting of methods. +See L<perltie> for a list of the functions required in order to tie a + hash +to a package. + +For developers wishing to write their own tied hashes, the required m +ethods +are briefly defined in L<Tie::Hash>. See the L<perltie> section for m +ore detailed +descriptive, as well as example code. + +=head1 Inheriting from B<Tie::ExtraHash> + +The accessor methods assume that the actual storage for the data in t +he tied +hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thu +s overwritten +C<TIEHASH> method should return an array reference with the first +element being a hash reference, and the remaining methods should oper +ate on the +hash C<< %{ $_[0]->[0] } >>: + + package ReportHash; + use parent 'Tie::ExtraHash'; + + sub TIEHASH { + my $class = shift; + my $self = bless [{}, @_], $class; + warn "New ReportHash created, stored in $sself.\n"; + $self; + } + sub STORE { + warn "Storing data with key $_[1] at $_[0].\n"; + $_[0][0]{$_[1]} = $_[2] + } + +The default C<TIEHASH> method stores "extra" arguments to tie() start +ing +from offset 1 in the array referenced by C<tied(%tiedhash)>; this is +the +same storage algorithm as in TIEHASH subroutine above. Hence, a typi +cal +package inheriting from B<Tie::ExtraHash> does not need to overwrite +this +method. + +=head1 CHANGES + +C<Tie::ExtraHash> prior to version 1.06 was hidden in C<Tie::Hash>, a +nd so you +had to manually load C<Tie::Hash> and manipulate C<@ISA> like this: + + use Tie::Hash; + our @ISA=('Tie::ExtraHash'); + +And while this still works, new code should do this instead: + + use parent 'Tie::ExtraHash'; + +=cut + +sub TIEHASH { my $p = shift; bless [{}, @_], $p } +sub STORE { $_[0][0]{$_[1]} = $_[2] } +sub FETCH { $_[0][0]{$_[1]} } +sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } +sub NEXTKEY { each %{$_[0][0]} } +sub EXISTS { exists $_[0][0]->{$_[1]} } +sub DELETE { delete $_[0][0]->{$_[1]} } +sub CLEAR { %{$_[0][0]} = () } +sub SCALAR { scalar %{$_[0][0]} } + +1; diff -Naur perl-5.28.0.orig/lib/Tie/Hash.pm perl-5.28.0/lib/Tie/Hash.p +m --- perl-5.28.0.orig/lib/Tie/Hash.pm 2018-03-20 21:06:36.000000000 ++0100 +++ perl-5.28.0/lib/Tie/Hash.pm 2018-09-16 18:23:34.233034429 +0200 @@ -1,68 +1,38 @@ package Tie::Hash; -our $VERSION = '1.05'; +use strict; +use warnings; +use Tie::StdHash (); # for backwards compatibility +use Tie::ExtraHash (); # for backwards compatibility + +our $VERSION = '1.06'; =head1 NAME -Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for +tied hashes +Tie::Hash - base class for tied hashes =head1 SYNOPSIS package NewHash; - require Tie::Hash; - - @ISA = qw(Tie::Hash); + use parent 'Tie::Hash'; sub DELETE { ... } # Provides needed method sub CLEAR { ... } # Overrides inherited method - package NewStdHash; - require Tie::Hash; - - @ISA = qw(Tie::StdHash); - - # All methods provided by default, define - # only those needing overrides - # Accessors access the storage in %{$_[0]}; - # TIEHASH should return a reference to the actual storage - sub DELETE { ... } - - package NewExtraHash; - require Tie::Hash; - - @ISA = qw(Tie::ExtraHash); - - # All methods provided by default, define - # only those needing overrides - # Accessors access the storage in %{$_[0][0]}; - # TIEHASH should return an array reference with the first element - # being the reference to the actual storage - sub DELETE { - $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer - delete $_[0][0]->{$_[1]}; # $_[0]->SUPER::DELETE($_[1 +]) - } - - package main; tie %new_hash, 'NewHash'; - tie %new_std_hash, 'NewStdHash'; - tie %new_extra_hash, 'NewExtraHash', - sub {warn "Doing \U$_[1]\E of $_[2].\n"}; =head1 DESCRIPTION -This module provides some skeletal methods for hash-tying classes. Se +e +This module provides skeletal methods for hash-tying classes. See L<perltie> for a list of the functions required in order to tie a has +h -to a package. The basic B<Tie::Hash> package provides a C<new> method +, as well -as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> an +d -B<Tie::ExtraHash> packages -provide most methods for hashes described in L<perltie> (the exceptio +ns -are C<UNTIE> and C<DESTROY>). They cause tied hashes to behave exact +ly like standard hashes, -and allow for selective overwriting of methods. B<Tie::Hash> grandfa +thers the -C<new> method: it is used if C<TIEHASH> is not defined -in the case a class forgets to include a C<TIEHASH> method. +to a package. The basic B<Tie::Hash> package provides +the method C<CLEAR>. + +L<Tie::StdHash> implements a class that behaves exactly like standard + hashes, +and allows for selective overwriting of methods. For developers wishing to write their own tied hashes, the required m +ethods are briefly defined below. See the L<perltie> section for more detail +ed @@ -116,55 +86,6 @@ =back -=head1 Inheriting from B<Tie::StdHash> - -The accessor methods assume that the actual storage for the data in t +he tied -hash is in the hash referenced by C<tied(%tiedhash)>. Thus overwritt +en -C<TIEHASH> method should return a hash reference, and the remaining m +ethods -should operate on the hash referenced by the first argument: - - package ReportHash; - our @ISA = 'Tie::StdHash'; - - sub TIEHASH { - my $storage = bless {}, shift; - warn "New ReportHash created, stored in $storage.\n"; - $storage - } - sub STORE { - warn "Storing data with key $_[1] at $_[0].\n"; - $_[0]{$_[1]} = $_[2] - } - - -=head1 Inheriting from B<Tie::ExtraHash> - -The accessor methods assume that the actual storage for the data in t +he tied -hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thu +s overwritten -C<TIEHASH> method should return an array reference with the first -element being a hash reference, and the remaining methods should oper +ate on the -hash C<< %{ $_[0]->[0] } >>: - - package ReportHash; - our @ISA = 'Tie::ExtraHash'; - - sub TIEHASH { - my $class = shift; - my $storage = bless [{}, @_], $class; - warn "New ReportHash created, stored in $storage.\n"; - $storage; - } - sub STORE { - warn "Storing data with key $_[1] at $_[0].\n"; - $_[0][0]{$_[1]} = $_[2] - } - -The default C<TIEHASH> method stores "extra" arguments to tie() start +ing -from offset 1 in the array referenced by C<tied(%tiedhash)>; this is +the -same storage algorithm as in TIEHASH subroutine above. Hence, a typi +cal -package inheriting from B<Tie::ExtraHash> does not need to overwrite +this -method. - =head1 C<SCALAR>, C<UNTIE> and C<DESTROY> The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>, @@ -178,6 +99,18 @@ B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. See L<perltie/"S +CALAR"> to find out what happens when C<SCALAR> does not exist. +=head1 CHANGES + +C<Tie::Hash> up to version 1.05 had an unnecessarily complex setup +of C<TIEHASH()> and C<new()>. To inherit from C<Tie::Hash()>, just ad +d +a C<TIEHASH()> constructor to your class. If your code used C<new()>, + just +rename it to C<TIEHASH()>. C<new()> is gone, and so are C<Carp> and +C<warnings::register>. + +C<Tie::StdHash> and C<Tie::ExtraHash> were included in C<Tie::Hash> u +p to +version 1.05. Now, they are properly separated classes. C<Tie::Hash> +still +loads them to avoid breaking code. + =head1 MORE INFORMATION The packages relating to various DBM-related implementations (F<DB_Fi +le>, @@ -187,43 +120,6 @@ =cut -use Carp; -use warnings::register; - -sub new { - my $pkg = shift; - $pkg->TIEHASH(@_); -} - -# Grandfather "new" - -sub TIEHASH { - my $pkg = shift; - my $pkg_new = $pkg -> can ('new'); - - if ($pkg_new and $pkg ne __PACKAGE__) { - my $my_new = __PACKAGE__ -> can ('new'); - if ($pkg_new == $my_new) { - # - # Prevent recursion - # - croak "$pkg must define either a TIEHASH() or a new() met +hod"; - } - - warnings::warnif ("WARNING: calling ${pkg}->new since " . - "${pkg}->TIEHASH is missing"); - $pkg -> new (@_); - } - else { - croak "$pkg doesn't define a TIEHASH method"; - } -} - -sub EXISTS { - my $pkg = ref $_[0]; - croak "$pkg doesn't define an EXISTS method"; -} - sub CLEAR { my $self = shift; my $key = $self->FIRSTKEY(@_); @@ -238,33 +134,4 @@ } } -# The Tie::StdHash package implements standard perl hash behaviour. -# It exists to act as a base class for classes which only wish to -# alter some parts of their behaviour. - -package Tie::StdHash; -# @ISA = qw(Tie::Hash); # would inherit new() only - -sub TIEHASH { bless {}, $_[0] } -sub STORE { $_[0]->{$_[1]} = $_[2] } -sub FETCH { $_[0]->{$_[1]} } -sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } -sub NEXTKEY { each %{$_[0]} } -sub EXISTS { exists $_[0]->{$_[1]} } -sub DELETE { delete $_[0]->{$_[1]} } -sub CLEAR { %{$_[0]} = () } -sub SCALAR { scalar %{$_[0]} } - -package Tie::ExtraHash; - -sub TIEHASH { my $p = shift; bless [{}, @_], $p } -sub STORE { $_[0][0]{$_[1]} = $_[2] } -sub FETCH { $_[0][0]{$_[1]} } -sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } -sub NEXTKEY { each %{$_[0][0]} } -sub EXISTS { exists $_[0][0]->{$_[1]} } -sub DELETE { delete $_[0][0]->{$_[1]} } -sub CLEAR { %{$_[0][0]} = () } -sub SCALAR { scalar %{$_[0][0]} } - 1; diff -Naur perl-5.28.0.orig/lib/Tie/Hash.t perl-5.28.0/lib/Tie/Hash.t --- perl-5.28.0.orig/lib/Tie/Hash.t 2018-03-20 21:06:36.000000000 + +0100 +++ perl-5.28.0/lib/Tie/Hash.t 2018-09-16 19:03:33.032814985 +0200 @@ -9,5 +9,5 @@ # these are "abstract virtual" parent methods for my $method (qw( TIEHASH EXISTS )) { eval { Tie::Hash->$method() }; - like( $@, qr/doesn't define an? $method/, "croaks on inherited $m +ethod()" ); + like( $@, qr/Can't locate object method "$method"/, "dies on inhe +rited $method()" ); } diff -Naur perl-5.28.0.orig/lib/Tie/Scalar.pm perl-5.28.0/lib/Tie/Scal +ar.pm --- perl-5.28.0.orig/lib/Tie/Scalar.pm 2018-05-21 10:41:35.00000000 +0 +0200 +++ perl-5.28.0/lib/Tie/Scalar.pm 2018-09-16 19:05:18.345673461 +02 +00 @@ -1,48 +1,38 @@ package Tie::Scalar; -our $VERSION = '1.04'; +use strict; +use warnings; +use Tie::StdScalar (); # for backwards compatibility -=head1 NAME - -Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars - -=head1 SYNOPSIS +our $VERSION = '1.05'; - package NewScalar; - require Tie::Scalar; +1; - @ISA = qw(Tie::Scalar); +__END__ - sub FETCH { ... } # Provide a needed method - sub TIESCALAR { ... } # Overrides inherited method +=head1 NAME +Tie::Scalar - base class for tied scalars - package NewStdScalar; - require Tie::Scalar; +=head1 SYNOPSIS - @ISA = qw(Tie::StdScalar); + package NewScalar; + use parent 'Tie::Scalar'; - # All methods provided by default, so define - # only what needs be overridden sub FETCH { ... } + sub TIESCALAR { ... } package main; tie $new_scalar, 'NewScalar'; - tie $new_std_scalar, 'NewStdScalar'; =head1 DESCRIPTION -This module provides some skeletal methods for scalar-tying classes. +See +This class provides some skeletal methods for scalar-tying classes. S +ee L<perltie> for a list of the functions required in tying a scalar to +a -package. The basic B<Tie::Scalar> package provides a C<new> method, a +s well -as methods C<TIESCALAR>, C<FETCH> and C<STORE>. The B<Tie::StdScalar> -package provides all the methods specified in L<perltie>. It inherit +s from -B<Tie::Scalar> and causes scalars tied to it to behave exactly like t +he -built-in scalars, allowing for selective overloading of methods. The +C<new> -method is provided as a means of grandfathering, for classes that for +get to -provide their own C<TIESCALAR> method. +package. The basic B<Tie::Scalar> package currently provides no metho +ds, +but may do so in future versions. For developers wishing to write their own tied-scalar classes, the me +thods are summarized below. The L<perltie> section not only documents these +, but @@ -76,16 +66,22 @@ =head2 Tie::Scalar vs Tie::StdScalar -C<< Tie::Scalar >> provides all the necessary methods, but one should + realize -they do not do anything useful. Calling C<< Tie::Scalar::FETCH >> or -C<< Tie::Scalar::STORE >> results in a (trappable) croak. And if you +inherit -from C<< Tie::Scalar >>, you I<must> provide either a C<< new >> or a -C<< TIESCALAR >> method. - If you are looking for a class that does everything for you you don't define yourself, use the C<< Tie::StdScalar >> class, not the C<< Tie::Scalar >> one. +=head1 CHANGES + +C<Tie::Scalar> up to version 1.04 had an unnecessarily complex setup +of C<TIESCALAR()> and C<new()>. To inherit from C<Tie::Scalar>, just +add +a C<TIESCALAR()> constructor to your class. If your code used C<new() +>, just +rename it to C<TIESCALAR()>. C<new()> is gone, and so are C<Carp> and + +C<warnings::register>. + +C<Tie::StdScalar> was included in C<Tie::Scalar> up to version 1.04. +Now, +it is a properly separated classes. C<Tie::Scalar> still loads it to +avoid +breaking code. + =head1 MORE INFORMATION The L<perltie> section uses a good example of tying scalars by associ +ating @@ -93,72 +89,3 @@ =cut -use Carp; -use warnings::register; - -sub new { - my $pkg = shift; - $pkg->TIESCALAR(@_); -} - -# "Grandfather" the new, a la Tie::Hash - -sub TIESCALAR { - my $pkg = shift; - my $pkg_new = $pkg -> can ('new'); - - if ($pkg_new and $pkg ne __PACKAGE__) { - my $my_new = __PACKAGE__ -> can ('new'); - if ($pkg_new == $my_new) { - # - # Prevent recursion - # - croak "$pkg must define either a TIESCALAR() or a new() m +ethod"; - } - - warnings::warnif ("WARNING: calling ${pkg}->new since " . - "${pkg}->TIESCALAR is missing"); - $pkg -> new (@_); - } - else { - croak "$pkg doesn't define a TIESCALAR method"; - } -} - -sub FETCH { - my $pkg = ref $_[0]; - croak "$pkg doesn't define a FETCH method"; -} - -sub STORE { - my $pkg = ref $_[0]; - croak "$pkg doesn't define a STORE method"; -} - -# -# The Tie::StdScalar package provides scalars that behave exactly lik +e -# Perl's built-in scalars. Good base to inherit from, if you're only +going to -# tweak a small bit. -# -package Tie::StdScalar; -@ISA = qw(Tie::Scalar); - -sub TIESCALAR { - my $class = shift; - my $instance = @_ ? shift : undef; - return bless \$instance => $class; -} - -sub FETCH { - return ${$_[0]}; -} - -sub STORE { - ${$_[0]} = $_[1]; -} - -sub DESTROY { - undef ${$_[0]}; -} - -1; diff -Naur perl-5.28.0.orig/lib/Tie/Scalar.t perl-5.28.0/lib/Tie/Scala +r.t --- perl-5.28.0.orig/lib/Tie/Scalar.t 2018-05-21 14:29:23.000000000 + +0200 +++ perl-5.28.0/lib/Tie/Scalar.t 2018-09-16 20:04:04.464035128 +020 +0 @@ -5,35 +5,21 @@ @INC = '../lib'; } -# this must come before main, or tests will fail -package TieTest; - -use Tie::Scalar; -our @ISA = qw( Tie::Scalar ); - -sub new { 'Fooled you.' } - -package main; - our $flag; -use Test::More tests => 16; +use Test::More tests => 11; use_ok( 'Tie::Scalar' ); # these are "abstract virtual" parent methods for my $method (qw( TIESCALAR FETCH STORE )) { eval { Tie::Scalar->$method() }; - like( $@, qr/doesn't define a $method/, "croaks on inherited $met +hod()" ); + like( $@, qr/Can't locate object method "$method"/, "dies on inhe +rited $method()" ); } # the default value is undef my $scalar = Tie::StdScalar->TIESCALAR(); is( $$scalar, undef, 'used TIESCALAR, default value is still undef' ) +; -# Tie::StdScalar redirects to TIESCALAR -$scalar = Tie::StdScalar->new(); -is( $$scalar, undef, 'used new(), default value is still undef' ); - # this approach should work as well tie $scalar, 'Tie::StdScalar'; is( $$scalar, undef, 'tied a scalar, default value is undef' ); @@ -60,10 +46,6 @@ $warn = $_[0]; }; -# Tie::Scalar::TIEHANDLE should find and call TieTest::new and compla +in -is( tie( my $foo, 'TieTest'), 'Fooled you.', 'delegated to new()' ); -like( $warn, qr/WARNING: calling TieTest->new/, 'caught warning fine' + ); - package DestroyAction; sub new { @@ -95,26 +77,7 @@ eval {tie my $foo => "NoMethods";}; like $@ => - qr /\QNoMethods must define either a TIESCALAR() or a new() m +ethod/, - "croaks if both new() and TIESCALAR() are missing"; + qr /Can't locate object method "TIESCALAR"/, + "croaks if TIESCALAR() is missing"; }; -# -# Don't croak on missing new/TIESCALAR if you're inheriting one. -# -my $called1 = 0; -my $called2 = 0; - -sub HasMethod1::new {$called1 ++} - @HasMethod1::ISA = qw [Tie::Scalar]; - @InheritHasMethod1::ISA = qw [HasMethod1]; - -sub HasMethod2::TIESCALAR {$called2 ++} - @HasMethod2::ISA = qw [Tie::Scalar]; - @InheritHasMethod2::ISA = qw [HasMethod2]; - -my $r1 = eval {tie my $foo => "InheritHasMethod1"; 1}; -my $r2 = eval {tie my $foo => "InheritHasMethod2"; 1}; - -ok $r1 && $called1, "inheriting new() does not croak"; -ok $r2 && $called2, "inheriting TIESCALAR() does not croak"; diff -Naur perl-5.28.0.orig/lib/Tie/StdArray.pm perl-5.28.0/lib/Tie/St +dArray.pm --- perl-5.28.0.orig/lib/Tie/StdArray.pm 1970-01-01 01:00:00.000000 +000 +0100 +++ perl-5.28.0/lib/Tie/StdArray.pm 2018-09-16 18:02:03.173763240 + +0200 @@ -0,0 +1,88 @@ +package Tie::StdArray; + +use 5.006_001; +use strict; +use warnings; +use parent 'Tie::Array'; # inherit EXTEND() and future methods + +our $VERSION = '1.08'; + +sub TIEARRAY { bless [], $_[0] } +sub FETCHSIZE { scalar @{$_[0]} } +sub STORESIZE { $#{$_[0]} = $_[1]-1 } +sub STORE { $_[0]->[$_[1]] = $_[2] } +sub FETCH { $_[0]->[$_[1]] } +sub CLEAR { @{$_[0]} = () } +sub POP { pop(@{$_[0]}) } +sub PUSH { my $o = shift; push(@$o,@_) } +sub SHIFT { shift(@{$_[0]}) } +sub UNSHIFT { my $o = shift; unshift(@$o,@_) } +sub EXISTS { exists $_[0]->[$_[1]] } +sub DELETE { delete $_[0]->[$_[1]] } + +sub SPLICE +{ + my $ob = shift; + my $sz = $ob->FETCHSIZE; + my $off = @_ ? shift : 0; + $off += $sz if $off < 0; + my $len = @_ ? shift : $sz-$off; + return splice(@$ob,$off,$len,@_); +} + +1; + +__END__ + +=head1 NAME + +Tie::StdArray - base class for tied arrays + +=head1 SYNOPSIS + + package Tie::NewStdArray; + use parent 'Tie::StdArray'; + + # all methods provided by default + + package main; + + $object = tie @somearray,'Tie::StdArray'; + $object = tie @somearray,'Tie::NewStdArray'; + + + +=head1 DESCRIPTION + +The B<Tie::StdArray> package provides efficient methods required for +tied arrays +which are implemented as blessed references to an "inner" perl array. +It inherits from L<Tie::Array>, and should cause tied arrays to behav +e exactly +like standard arrays, allowing for selective overloading of methods. + +For developers wishing to write their own tied arrays, the required m +ethods +are briefly defined in C<Tie::Array>. See the L<perltie> section for +more detailed +descriptive, as well as example code. + +=head1 CHANGES + +C<Tie::StdArray> prior to version 1.08 was hidden in C<Tie::Array>, a +nd so you +had to manually load C<Tie::Array> and manipulate C<@ISA> like this: + + use Tie::Array; + our @ISA=('Tie::StdArray'); + +And while this still works, new code should do this instead: + + use parent 'Tie::StdArray'; + +=head1 CAVEATS + +There is no support at present for tied @ISA. There is a potential co +nflict +between magic entries needed to notice setting of @ISA, and those nee +ded to +implement 'tie'. + +=head1 AUTHOR + +Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt> + +=cut diff -Naur perl-5.28.0.orig/lib/Tie/StdHandle.pm perl-5.28.0/lib/Tie/S +tdHandle.pm --- perl-5.28.0.orig/lib/Tie/StdHandle.pm 2018-05-21 14:29:23.00000 +0000 +0200 +++ perl-5.28.0/lib/Tie/StdHandle.pm 2018-09-16 18:17:30.411522328 ++0200 @@ -1,10 +1,10 @@ package Tie::StdHandle; use strict; +use warnings; +use parent 'Tie::Handle'; -use Tie::Handle; -our @ISA = 'Tie::Handle'; -our $VERSION = '4.5'; +our $VERSION = '4.6'; =head1 NAME @@ -13,9 +13,7 @@ =head1 SYNOPSIS package NewHandle; - require Tie::Handle; - - @ISA = qw(Tie::Handle); + use parent 'Tie::StdHandle'; sub READ { ... } # Provide a needed method sub TIEHANDLE { ... } # Overrides inherited method diff -Naur perl-5.28.0.orig/lib/Tie/StdHash.pm perl-5.28.0/lib/Tie/Std +Hash.pm --- perl-5.28.0.orig/lib/Tie/StdHash.pm 1970-01-01 01:00:00.0000000 +00 +0100 +++ perl-5.28.0/lib/Tie/StdHash.pm 2018-09-16 18:01:50.442780249 +0 +200 @@ -0,0 +1,85 @@ +package Tie::StdHash; + +use strict; +use warnings; +use parent 'Tie::Hash'; # allow for new methods in future versions of + perl + +our $VERSION = '1.06'; + +=head1 NAME + +Tie::StdHash - base class for tied hashes + +=head1 SYNOPSIS + + package NewStdHash; + + use paremt 'Tie::StdHash'; + + # All methods provided by default, define + # only those needing overrides + # Accessors access the storage in %{$_[0]}; + # TIEHASH should return a reference to the actual storage + sub DELETE { ... } + + package main; + + tie %new_std_hash, 'NewStdHash'; + +=head1 DESCRIPTION + +This module provides some skeletal methods for hash-tying classes, +behaving exactly like standard hashes +and allows for selective overwriting of methods. +See L<perltie> for a list of the functions required in order to tie a + hash +to a package. + +For developers wishing to write their own tied hashes, the required m +ethods +are briefly defined in L<Tie::Hash>. See the L<perltie> section for m +ore detailed +descriptive, as well as example code. + +=head1 Inheriting from B<Tie::StdHash> + +The accessor methods assume that the actual storage for the data in t +he tied +hash is in the hash referenced by C<tied(%tiedhash)>. Thus overwritt +en +C<TIEHASH> method should return a hash reference, and the remaining m +ethods +should operate on the hash referenced by the first argument: + + package ReportHash; + use parent 'Tie::StdHash'; + + sub TIEHASH { + my $sself = bless {}, shift; + warn "New ReportHash created, stored in $sself.\n"; + $self + } + sub STORE { + warn "Storing data with key $_[1] at $_[0].\n"; + $_[0]{$_[1]} = $_[2] + } + +=head1 CHANGES + +C<Tie::StdHash> prior to version 1.06 was hidden in C<Tie::Hash>, and + so you +had to manually load C<Tie::Hash> and manipulate C<@ISA> like this: + + use Tie::Hash; + our @ISA=('Tie::StdHash'); + +And while this still works, new code should do this instead: + + use parent 'Tie::StdHash'; + +=cut + +sub TIEHASH { bless {}, $_[0] } +sub STORE { $_[0]->{$_[1]} = $_[2] } +sub FETCH { $_[0]->{$_[1]} } +sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } +sub NEXTKEY { each %{$_[0]} } +sub EXISTS { exists $_[0]->{$_[1]} } +sub DELETE { delete $_[0]->{$_[1]} } +sub CLEAR { %{$_[0]} = () } +sub SCALAR { scalar %{$_[0]} } + +1; diff -Naur perl-5.28.0.orig/lib/Tie/StdScalar.pm perl-5.28.0/lib/Tie/S +tdScalar.pm --- perl-5.28.0.orig/lib/Tie/StdScalar.pm 1970-01-01 01:00:00.00000 +0000 +0100 +++ perl-5.28.0/lib/Tie/StdScalar.pm 2018-09-16 19:05:06.887688859 ++0200 @@ -0,0 +1,134 @@ +package Tie::StdScalar; + +use strict; +use warnings; +use parent 'Tie::Scalar'; + +our $VERSION = '1.05'; + +sub TIESCALAR { + my $class = shift; + my $instance = @_ ? shift : undef; + return bless \$instance => $class; +} + +sub FETCH { + return ${$_[0]}; +} + +sub STORE { + ${$_[0]} = $_[1]; +} + +sub DESTROY { + undef ${$_[0]}; +} + +1; + +__END__ + +=head1 NAME + +Tie::StdScalar - base class for tied scalars + +=head1 SYNOPSIS + + package NewScalar; + require Tie::Scalar; + + @ISA = qw(Tie::Scalar); + + sub FETCH { ... } # Provide a needed method + sub TIESCALAR { ... } # Overrides inherited method + + + package NewStdScalar; + require Tie::Scalar; + + @ISA = qw(Tie::StdScalar); + + # All methods provided by default, so define + # only what needs be overridden + sub FETCH { ... } + + + package main; + + tie $new_scalar, 'NewScalar'; + tie $new_std_scalar, 'NewStdScalar'; + +=head1 DESCRIPTION + +This module provides some skeletal methods for scalar-tying classes. +See +L<perltie> for a list of the functions required in tying a scalar to +a +package. The basic B<Tie::Scalar> package provides a C<new> method, a +s well +as methods C<TIESCALAR>, C<FETCH> and C<STORE>. The B<Tie::StdScalar> +package provides all the methods specified in L<perltie>. It inherit +s from +B<Tie::Scalar> and causes scalars tied to it to behave exactly like t +he +built-in scalars, allowing for selective overloading of methods. The +C<new> +method is provided as a means of grandfathering, for classes that for +get to +provide their own C<TIESCALAR> method. + +For developers wishing to write their own tied-scalar classes, the me +thods +are summarized below. The L<perltie> section not only documents these +, but +has sample code as well: + +=over 4 + +=item TIESCALAR classname, LIST + +The method invoked by the command C<tie $scalar, classname>. Associat +es a new +scalar instance with the specified class. C<LIST> would represent add +itional +arguments (along the lines of L<AnyDBM_File> and compatriots) needed +to +complete the association. + +=item FETCH this + +Retrieve the value of the tied scalar referenced by I<this>. + +=item STORE this, value + +Store data I<value> in the tied scalar referenced by I<this>. + +=item DESTROY this + +Free the storage associated with the tied scalar referenced by I<this +>. +This is rarely needed, as Perl manages its memory quite well. But the +option exists, should a class wish to perform specific actions upon t +he +destruction of an instance. + +=back + +=head2 Tie::Scalar vs Tie::StdScalar + +C<< Tie::Scalar >> provides all the necessary methods, but one should + realize +they do not do anything useful. Calling C<< Tie::Scalar::FETCH >> or +C<< Tie::Scalar::STORE >> results in a (trappable) croak. And if you +inherit +from C<< Tie::Scalar >>, you I<must> provide either a C<< new >> or a +C<< TIESCALAR >> method. + +If you are looking for a class that does everything for you you don't +define yourself, use the C<< Tie::StdScalar >> class, not the +C<< Tie::Scalar >> one. + +=head1 CHANGES + +C<Tie::StdScalar> prior to version 1.05 was hidden in C<Tie::Scalar>, + and so you +had to manually load C<Tie::Scalar> and manipulate C<@ISA> like this: + + use Tie::Scalar; + our @ISA=('Tie::StdScalar'); + +And while this still works, new code should do this instead: + + use parent 'Tie::StdScalar'; + +=head1 MORE INFORMATION + +The L<perltie> section uses a good example of tying scalars by associ +ating +process IDs with priority. + +=cut + +

    Notes

    (1) Yes, we could make life a little bit easier for people coming from C++, by giving them an additional new constructor faking the C++ new operator. But: tie does not call that constructor, and you don't have a new() constructor in C++ classes. The constructor of a C++ class has the same name as the class. So new() is complete and utter nonsense, even if we want to make Perl look like C++.

    (2) As before, the patch is under the same license as Perl itself. Feel free to test it.

    Alexander

    --
    Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
Re^3: Breaking Tie::Hash into three modules
by Haarg (Priest) on Sep 12, 2018 at 11:10 UTC

    cpan.grep.me is usually better than grep.metacpan.org, although both tend to have issues with downtime.

    There are plenty of modules inheriting from these classes, although I haven't looked at how they are using them.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1222096]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2024-03-28 17:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found