diff options
| author | Andreas Brachold <vdr07@deltab.de> | 2007-11-10 17:53:53 +0000 |
|---|---|---|
| committer | Andreas Brachold <vdr07@deltab.de> | 2007-11-10 17:53:53 +0000 |
| commit | cfdd733c17cfa4f1a43b827a656e9e53cc2524ac (patch) | |
| tree | b6f659b1281f77628b36768f0888f67b65f9ca48 /lib/Class/MakeMethods/Utility/Inheritable.pm | |
| parent | 9c6c30350161efd74faa3c3705096aecb71c0e81 (diff) | |
| download | xxv-cfdd733c17cfa4f1a43b827a656e9e53cc2524ac.tar.gz xxv-cfdd733c17cfa4f1a43b827a656e9e53cc2524ac.tar.bz2 | |
* Remove unsed packages
* Reorder exit routines
Diffstat (limited to 'lib/Class/MakeMethods/Utility/Inheritable.pm')
| -rw-r--r-- | lib/Class/MakeMethods/Utility/Inheritable.pm | 126 |
1 files changed, 0 insertions, 126 deletions
diff --git a/lib/Class/MakeMethods/Utility/Inheritable.pm b/lib/Class/MakeMethods/Utility/Inheritable.pm deleted file mode 100644 index e1ec9ae..0000000 --- a/lib/Class/MakeMethods/Utility/Inheritable.pm +++ /dev/null @@ -1,126 +0,0 @@ -=head1 NAME - -Class::MakeMethods::Utility::Inheritable - "Inheritable" data - - -=head1 SYNOPSIS - - package MyClass; - sub new { ... } - - package MySubclass; - @ISA = 'MyClass'; - ... - my $obj = MyClass->new(...); - my $subobj = MySubclass->new(...); - - use Class::MakeMethods::Utility::Inheritable qw(get_vvalue set_vvalue ); - - my $dataset = {}; - set_vvalue($dataset, 'MyClass', 'Foobar'); # Set value for class - get_vvalue($dataset, 'MyClass'); # Gets value "Foobar" - - get_vvalue($dataset, $obj); # Objects "inherit" - set_vvalue($dataset, $obj, 'Foible'); # Until you override - get_vvalue($dataset, $obj); # Now finds "Foible" - - get_vvalue($dataset, 'MySubclass'); # Subclass "inherits" - get_vvalue($dataset, $subobj); # As do its objects - set_vvalue($dataset, 'MySubclass', 'Foozle'); # Until we override it - get_vvalue($dataset, 'MySubclass'); # Now finds "Foozle" - - get_vvalue($dataset, $subobj); # Change cascades down - set_vvalue($dataset, $subobj, 'Foolish'); # Until we override again - - get_vvalue($dataset, 'MyClass'); # Superclass is unchanged - -=head1 DESCRIPTION - -This module provides several functions which allow you to store values in a hash corresponding to both objects and classes, and to retrieve those values by searching a object's inheritance tree until it finds a matching entry. - -This functionality is used by Class::MakeMethods::Standard::Inheritable and Class::MakeMethods::Composite::Inheritable to construct methods that can both store class data and be overriden on a per-object level. - -=cut - -######################################################################## - -package Class::MakeMethods::Utility::Inheritable; - -$VERSION = 1.000; - -@EXPORT_OK = qw( get_vvalue set_vvalue find_vself ); -sub import { require Exporter and goto &Exporter::import } # lazy Exporter - -use strict; - -######################################################################## - -=head1 REFERENCE - -=head2 find_vself - - $vself = find_vself( $dataset, $instance ); - -Searches $instance's inheritance tree until it finds a matching entry in the dataset, and returns either the instance, the class that matched, or undef. - -=cut - -sub find_vself { - my $dataset = shift; - my $instance = shift; - - return $instance if ( exists $dataset->{$instance} ); - - my $v_self; - my @isa_search = ( ref($instance) || $instance ); - while ( scalar @isa_search ) { - $v_self = shift @isa_search; - return $v_self if ( exists $dataset->{$v_self} ); - no strict 'refs'; - unshift @isa_search, @{"$v_self\::ISA"}; - } - return; -} - -=head2 get_vvalue - - $value = get_vvalue( $dataset, $instance ); - -Searches $instance's inheritance tree until it finds a matching entry in the dataset, and returns that value - -=cut - -sub get_vvalue { - my $dataset = shift; - my $instance = shift; - my $v_self = find_vself($dataset, $instance); - # warn "Dataset: " . join( ', ', %$dataset ); - # warn "Retrieving $dataset -> $instance ($v_self): '$dataset->{$v_self}'"; - return $v_self ? $dataset->{$v_self} : (); -} - -=head2 set_vvalue - - $value = set_vvalue( $dataset, $instance, $value ); - -Searches $instance's inheritance tree until it finds a matching entry in the dataset, and returns that value - -=cut - -sub set_vvalue { - my $dataset = shift; - my $instance = shift; - my $value = shift; - if ( defined $value ) { - # warn "Setting $dataset -> $instance = $value"; - $dataset->{$instance} = $value; - } else { - # warn "Clearing $dataset -> $instance"; - delete $dataset->{$instance}; - undef; - } -} - -######################################################################## - -1; |
