summaryrefslogtreecommitdiff
path: root/lib/Class/MakeMethods/Utility/Inheritable.pm
diff options
context:
space:
mode:
authorAndreas Brachold <vdr07@deltab.de>2007-11-10 17:53:53 +0000
committerAndreas Brachold <vdr07@deltab.de>2007-11-10 17:53:53 +0000
commitcfdd733c17cfa4f1a43b827a656e9e53cc2524ac (patch)
treeb6f659b1281f77628b36768f0888f67b65f9ca48 /lib/Class/MakeMethods/Utility/Inheritable.pm
parent9c6c30350161efd74faa3c3705096aecb71c0e81 (diff)
downloadxxv-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.pm126
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;