Show
Ignore:
Timestamp:
01/17/08 18:08:38 (7 years ago)
Author:
yappo
Message:

lang/perl/Class-Accessor-Lvalue-Trigger: wrot POD

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/Class-Accessor-Lvalue-Trigger/trunk/lib/Class/Accessor/Lvalue/Trigger.pm

    r4716 r4794  
    8787=head1 NAME 
    8888 
    89 Class::Accessor::Lvalue::Trigger - 
     89Class::Accessor::Lvalue::Trigger - not used tie lvalue accessor / you can injection set get trigger  
    9090 
    9191=head1 SYNOPSIS 
    9292 
    93   use Class::Accessor::Lvalue::Trigger; 
     93  package Foo; 
     94  use base qw( Class::Accessor::Lvalue::Trigger ); 
     95  __PACKAGE__->mk_accessors(qw/ bar /) 
     96 
     97  my $foo = Foo->new; 
     98  $foo->bar = 42; 
     99  print $foo->bar; # prints 42 
    94100 
    95101=head1 DESCRIPTION 
    96102 
    97 Class::Accessor::Lvalue::Trigger is 
     103This module subclasses Class::Accessor in order to provide lvalue accessor makers. 
     104This module is Class::Accessor::Lvalue like but not used tie. 
     105It becomes like the Class::Accessor::Lvalue by using callback method. 
     106 
     107=head1 CALLBACK METHOD 
     108 
     109It is possible to enhance it by doing get/set method in overwrite by using default callback method. 
     110 
     111  package Register; 
     112  use base qw( Class::Accessor::Lvalue::Trigger ); 
     113  __PACKAGE__->mk_accessors(qw/ ax ah al /); 
     114 
     115  sub get { 
     116      my $self = shift; 
     117      printf "get: %s\n", $_[0]; 
     118      $self->SUPER::get(@_); 
     119  } 
     120  sub set { 
     121      my $self = shift; 
     122      printf "set: %s => %s\n", $_[0], $_[1]; 
     123      $self->SUPER::set(@_); 
     124  } 
     125  1; 
     126 
     127  my $r = Register->new; 
     128  $r->ax = 0; 
     129  # get: ax 
     130 
     131  $r->ax++; 
     132  # set: ax => 0 
     133  # get: ax 
     134 
     135  $r->ah = 0; 
     136  # set: ax => 1 
     137  # get: ah 
     138 
     139  $r->ax++; 
     140  # set: ah => 0 
     141  # get: ax 
     142 
     143  $r->ah++; 
     144  # set: ax => 2 
     145  # get: ah 
     146 
     147if you use original callback method, please do overwrite to $Class::Accessor::Lvalue::Trigger::TRIGGER_METHOD. 
     148 
     149  package MyApp; 
     150  use base qw( Class::Accessor::Lvalue::Trigger ); 
     151  local $Class::Accessor::Lvalue::Trigger::TRIGGER_METHOD = sub { 
     152      my($self, $name, $rw) = @_; 
     153      printf "trigger: %s => %s (%s)\n", $name, $self->{$name}, $rw; 
     154  }; 
     155  __PACKAGE__->mk_accessors(qw/ foo /); 
     156  my $c = MyApp->new; 
     157  $c->foo = 'bar';# trigger: foo =>  (rw) 
     158  $c->foo;        # trigger: foo => bar (rw) 
     159 
     160or 
     161 
     162  package MyApp; 
     163  use base qw( Class::Accessor::Lvalue::Trigger ); 
     164  local $Class::Accessor::Lvalue::Trigger::TRIGGER_METHOD = 'trigger'; 
     165  __PACKAGE__->mk_accessors(qw/ foo /); 
     166  sub trigger { 
     167      my($self, $name, $rw) = @_; 
     168      printf "trigger: %s => %s (%s)\n", $name, $self->{$name}, $rw; 
     169  }; 
     170  1; 
     171 
     172  my $c = MyApp->new; 
     173  $c->foo = 'bar';# trigger: foo =>  (rw) 
     174  $c->foo;        # trigger: foo => bar (rw) 
     175 
     176As for timing from which set and get method is executed, it is necessary to note a thing different from Class::Accessor::Lvalue. 
     177 
     178Two or more trigger method can be used at the same time.  
     179 
     180  package MyApp; 
     181  use base qw( Class::Accessor::Lvalue::Trigger ); 
     182  local $Class::Accessor::Lvalue::Trigger::TRIGGER_METHOD = 'trigger_foo'; 
     183  __PACKAGE__->mk_accessors(qw/ foo /); 
     184  local $Class::Accessor::Lvalue::Trigger::TRIGGER_METHOD = 'trigger_baz'; 
     185  __PACKAGE__->mk_accessors(qw/ baz /); 
     186 
     187  sub trigger_foo { 
     188      my($self, $name, $rw) = @_; 
     189      printf "trigger: %s => %s (%s)\n", $name, $self->{$name}, $rw; 
     190  }; 
     191  sub trigger_baz { 
     192      my($self, $name, $rw) = @_; 
     193      printf "trigger2: %s => %s (%s)\n", $name, $self->{$name}, $rw; 
     194  }; 
     195  1; 
     196 
     197  my $c = MyApp->new; 
     198  $c->foo = 'bar';   # trigger: foo =>  (rw)  
     199  $c->baz = 'barbar';# trigger2: baz =>  (rw) 
     200  $c->foo;           # trigger: foo => bar (rw) 
     201  $c->baz;           # trigger2: baz => barbar (rw) 
     202 
     203 
     204=head1 BENCHMARK 
    98205 
    99206=head1 AUTHOR