PROXY  WHOIS  RQUOTE  TEXTS  SOFT  FOREX  BBOARD
 Music  Philosophy  Code  Literature  Russian

= ROOT|Technical|Code_Examples|Perl|lib|DBM_Filter.pm =

page 2 of 7



        no strict 'refs';
        my $fetch  = *{ "${class}::Fetch"  }{CODE};
        my $store  = *{ "${class}::Store"  }{CODE};
        my $filter = *{ "${class}::Filter" }{CODE};
        use strict 'refs';

        my $count = defined($filter) + defined($store) + defined($fetch) ;

        if ( $count == 0 )
          { croak "$caller: No methods (Filter, Fetch or Store) found in class '$class'" }
        elsif ( $count == 1 && ! defined $filter) {
           my $need = defined($fetch) ? 'Store' : 'Fetch';
           croak "$caller: Missing method '$need' in class '$class'" ;
        }
        elsif ( $count >= 2 && defined $filter)
          { croak "$caller: Can't mix Filter with Store and Fetch in class '$class'" }

        if (defined $filter) {
            my $callbacks = &{ $filter }(@params);
            croak "$caller: '${class}::Filter' did not return a hash reference" 
                unless ref $callbacks && ref $callbacks eq 'HASH';
            %callbacks = %{ $callbacks } ;
        }
        else {
            $callbacks{Fetch} = $fetch;
            $callbacks{Store} = $store;
        }
    }
    else {
        croak "$caller: not even params" unless @_ % 2 == 0;
        %callbacks = @_;
    }
    
    my %filters = %Filters ;
    my @got = ();
    while (my ($k, $v) = each %callbacks )
    {
        my $key = $k;
        $k = lc $k;
        if ($k eq 'fetch') {
            push @got, 'Fetch';
            if ($caller eq 'Filter_Push')
              { $filters{Fetch_Key} = $filters{Fetch_Value} = $v }
            elsif ($caller eq 'Filter_Key_Push')
              { $filters{Fetch_Key} = $v }
            elsif ($caller eq 'Filter_Value_Push')
              { $filters{Fetch_Value} = $v }
        }
        elsif ($k eq 'store') {
            push @got, 'Store';
            if ($caller eq 'Filter_Push')
              { $filters{Store_Key} = $filters{Store_Value} = $v }
            elsif ($caller eq 'Filter_Key_Push')
              { $filters{Store_Key} = $v }
            elsif ($caller eq 'Filter_Value_Push')
              { $filters{Store_Value} = $v }
        }
        else
          { croak "$caller: Unknown key '$key'" }

        croak "$caller: value associated with key '$key' is not a code reference"
            unless ref $v && ref $v eq 'CODE';
    }

    if ( @got != 2 ) {
        push @got, 'neither' if @got == 0 ;
        croak "$caller: expected both Store & Fetch - got @got";
    }

    # remember the class
    push @{ $LayerStack{$this} }, \%filters ;

    my $str_this = "$this" ; # Avoid a closure with $this in the subs below

    $this->filter_store_key  ( sub { store_hook($str_this, 'Store_Key')   });
    $this->filter_store_value( sub { store_hook($str_this, 'Store_Value') });
    $this->filter_fetch_key  ( sub { fetch_hook($str_this, 'Fetch_Key')   });
    $this->filter_fetch_value( sub { fetch_hook($str_this, 'Fetch_Value') });

    # Hijack the callers DESTROY method
    $this =~ /^(.*)=/;
    my $type = $1 ;
    no strict 'refs';
    if ( *{ "${type}::DESTROY" }{CODE} ne \&MyDESTROY )
    {
        $origDESTROY{$type} = *{ "${type}::DESTROY" }{CODE};
        no warnings 'redefine';
        *{ "${type}::DESTROY" } = \&MyDESTROY ;
    }
}

sub store_hook
{
    my $this = shift ;
    my $type = shift ;
    foreach my $layer (@{ $LayerStack{$this} })
    {
        &{ $layer->{$type} }() if defined $layer->{$type} ;
    }
}
=2=

1| < PREV = PAGE 2 = NEXT > |3|4|5|6|7

UP TO ROOT | UP TO DIR | TO FIRST PAGE

Google
 


E-mail Facebook Google Digg del.icio.us BlinkList Fark Furl Ma.gnolia Netscape NewsVine Reddit Slashdot Spurl StumbleUpon Technorati YahooMyWeb LiveJournal Blogmarks TwitThis Live News2.ru BobrDobr.ru Memori.ru MoeMesto.ru

0.00528884 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)