# Element.pm -- Represents one (persistent) element in the system. # ---------- # September 17, 2000 -- Copyright Sunir Shah. All rights reserved. package Element; use Exporter; use TiedElement; @ISA = qw( Exporter ); @EXPORT = qw(); @EXPORT_OK = qw(); @EXPORT_TAGS = qw(); # AUTOLOAD() # ---------- # The standard autoloader for Element subclasses attempts # to map the function call to a property. It then does # simple assignment and retrieval. You can overload this # behaviour on a per property basis. sub AUTOLOAD { my $self = shift; my $class = ref $self or return; my $property = $AUTOLOAD; $property =~ s/.*:://; return unless $property =~ /[^A-Z]/; if( exists $self->{$property} ) { my $method = "${class}::$property"; *$method = sub { my $self = shift; return $self->{$property} unless @_; $self->{$property} = shift if @_; return $self; }; return $self->$property(@_); } else { my $superior = "SUPER::$property"; return $self->$superior(@_); } } sub new { my ($class, $primary_key) = @_; die "Cannot instantiate $class without a primary key." unless $primary_key; my %hash; tie %hash, TiedElement, $class, $primary_key, \%hash; bless \%hash, $class; return \%hash; } # _initialize( $primary_key ) # --------------------------- # Override in subclass to initialize in constructor. # Be sure to call your super class. ala: # # sub _initialize # { # my ($self, $primary_key) = @_; # $self->SUPER::_initialize($primary_key); # # ... # Do per class initialization here # # } # # You should construct anything that depends on the primary key. sub _initialize( $$ ) { } # getPrimaryKey() # --------------- # Returns a string that will uniquely identify this instance # from other instances of the same class. If the string # is empty, there is no primary key available. # # This is the key passed into new(). sub getPrimaryKey { my $self = shift; return (tied %$self)->{key}; } # save() # ------ # Saves this object (and the object graph flowing from it) # to disk. sub save() { my $self = shift; my $tied = tied %$self; $tied->save(); } # exists() # -------- # Returns true if the object exists for the given class. # # e.g. Element::exists Foo 'bar' would check if a Foo named 'bar' # exists. Alternatively, you can use Foo->exists('bar'). sub exists { return TiedElement::exists @_; } # equals() # -------- # Tests if two elements are equivalent. sub equals( $$ ) { my ($self, $target) = @_; return 1 if !defined($self) && !defined($target); return 0 if !defined($self) && defined($target); return 0 if defined($self) && !defined($target); return 0 if ref($self) ne ref($target); return $self->getPrimaryKey() eq $target->getPrimaryKey(); } 1;