tie OOP perl

gcc · Сообщение **gcc** » 27.02.2009 08:10

можете подсказать зачем использовать в OOP tie?

в книге "рецепты для профессионалов 3 издание" про это не написано было, точнее для бд примеры были и все... но не понятно где именно преимущество...

вот нашел это не плохое
http://search.cpan.org/~milan/OOP-1.01/lib/OOP.pm

мне понравился пример с хэш-хешей-массивов-функций

про tie я не нашел http://www.google.com/search?hl=uk&q=o...D0%BA&meta=

Код:

#Class.pm
package Property;
BEGIN {*UNTIE=*DESTROY}

sub TIESCALAR {
    print "creating layer..\n";
    my$self=\{};
    bless $self, $_[0];
    if(defined $_[1]) {
        $self->STORE($_[1]{-default})             if exists $_[1]{-default};
        $$$self{-getter}=$_[1]{-getter}           if exists $_[1]{-getter};
        $$$self{-setter}=$_[1]{-setter}           if exists $_[1]{-setter};
        $$$self{-destroyer}=$_[1]{-destroyer}     if exists $_[1]{-destroyer};
        $$$self{-aftertie}=$_[1]{-aftertie}       if exists $_[1]{-aftertie};
    }
    $$$self{-aftertie}($self, @_) if exists $$$self{-aftertie};
    +$self
}
sub FETCH     {
    if(exists $${$_[0]}{-getter}) {
        +$${$_[0]}{-getter}(@_)
    } else {
        print "getter called..\n";
        +${+shift}
    }
}
sub STORE     {
    if(exists $${$_[0]}{-setter}) {
        +$${$_[0]}{-setter}(@_)
    } else {
        print "setter called..\n";
        +${+$_[0]}=$_[1]
    }
}
sub DESTROY   {
    if(exists $${$_[0]}{-destroyer}) {
        +$${$_[0]}{-destroyer}(@_)
    } else {
        print "destroyer of worlds..\n";
        +shift
    }
}

package Class;

sub new {
    my($class, $self)=(shift, {@_});
    foreach(keys %{$self->{-properties}||={}}) {
        tie $self->{$_}, Property, $self->{-properties}{$_};
        print $_, "\n";
    }
    delete $self->{-properties};
    +bless $self, $class;
}

+1






package Child;
use base qw(Class);

sub new {
    +shift->SUPER::new(
        -properties=>{
            p1=>{
                -default=>1,
                -getter=>'Child::p1_getter'

            #sub {
                #    print "Your getter\n";
                #    +${+shift}
                #}
            },
            p2=>{
                -default=>3,
                -destroyer=>'Child::p2_destroyer'

            #sub {
                #   print "Your destroyer\n";
                #}
            }
        }
    );
}
sub p1_getter {
   #...
}
sub p2_destroyer {
   #...
}
sub run {
    print "Running...\n";
    +shift
}

+1