[Jifty-commit] r2887 - in Jifty-DBI/branches/od: . lib/Jifty/DBI
lib/Jifty/DBI/Class
jifty-commit at lists.jifty.org
jifty-commit at lists.jifty.org
Sat Mar 3 11:38:16 EST 2007
Author: jesse
Date: Sat Mar 3 11:38:15 2007
New Revision: 2887
Added:
Jifty-DBI/branches/od/lib/Jifty/DBI/Class/
Jifty-DBI/branches/od/lib/Jifty/DBI/Class/Trigger.pm
Modified:
Jifty-DBI/branches/od/ (props changed)
Jifty-DBI/branches/od/Makefile.PL
Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm
Jifty-DBI/branches/od/lib/Jifty/DBI/Record/Plugin.pm
Log:
r52944 at pinglin: jesse | 2007-03-03 12:26:36 +0000
* Added intial support for plugins to register triggers
r52945 at pinglin: jesse | 2007-03-03 12:29:38 +0000
* can not call a method name as the method. "oops"
r52947 at pinglin: jesse | 2007-03-03 16:21:49 +0000
* canonicalizers work
Modified: Jifty-DBI/branches/od/Makefile.PL
==============================================================================
--- Jifty-DBI/branches/od/Makefile.PL (original)
+++ Jifty-DBI/branches/od/Makefile.PL Sat Mar 3 11:38:15 2007
@@ -20,7 +20,7 @@
requires('Object::Declare' => 0.22);
requires('UNIVERSAL::require');
requires('version');
-requires('Class::Trigger');
+#requires('Class::Trigger');
build_requires('Test::More' => 0.52);
build_requires('DBD::SQLite');
no_index directory => 'ex';
Added: Jifty-DBI/branches/od/lib/Jifty/DBI/Class/Trigger.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/branches/od/lib/Jifty/DBI/Class/Trigger.pm Sat Mar 3 11:38:15 2007
@@ -0,0 +1,365 @@
+package Jifty::DBI::Class::Trigger;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = "0.11_01";
+
+use Carp ();
+
+my (%Triggers, %TriggerPoints);
+
+sub import {
+ my $class = shift;
+ my $pkg = caller(0);
+
+ $TriggerPoints{$pkg} = { map { $_ => 1 } @_ } if @_;
+
+ # export mixin methods
+ no strict 'refs';
+ my @methods = qw(add_trigger call_trigger last_trigger_results);
+ *{"$pkg\::$_"} = \&{$_} for @methods;
+}
+
+sub add_trigger {
+ my $proto = shift;
+
+ my $triggers = __fetch_triggers($proto);
+
+ if (ref($_[1]) eq 'CODE') {
+
+ while (my($when, $code) = splice @_, 0, 2) {
+ __validate_triggerpoint($proto, $when);
+ Carp::croak('add_trigger() needs coderef') unless ref($code) eq 'CODE';
+ push @{$triggers->{$when}}, [$code, undef];
+ }
+ }
+ elsif (grep {'name'} @_) {
+ my %args = ( name => undef, callback => undef, abortable => undef, @_);
+ my $when= $args{'name'};
+ my $code = $args{'callback'};
+ my $abortable = $args{'abortable'};
+ __validate_triggerpoint($proto, $when);
+ Carp::croak('add_trigger() needs coderef') unless ref($code) eq 'CODE';
+ push @{$triggers->{$when}}, [$code, $abortable];
+
+
+ } else {
+ Carp::croak('add_trigger() needs coderef');
+
+ }
+ 1;
+}
+
+
+sub last_trigger_results {
+ my $self = shift;
+ my $result_store = ref($self) ? $self : ${Jifty::DBI::Class::Trigger::_trigger_results}->{$self};
+ return $result_store->{'_class_trigger_results'};
+}
+
+sub call_trigger {
+ my $self = shift;
+ my $when = shift;
+
+ my @return;
+
+ my $result_store = ref($self) ? $self : ${Jifty::DBI::Class::Trigger::_trigger_results}->{$self};
+
+ $result_store->{'_class_trigger_results'} = [];
+
+ if (my @triggers = __fetch_all_triggers($self, $when)) { # any triggers?
+ for (@triggers) {
+ my @return = $_->[0]->($self, @_);
+ push @{$result_store->{'_class_trigger_results'}}, \@return;
+ return undef if ($_->[1] and not $return[0]); # only abort on false values.
+
+ }
+ }
+ else {
+ # if validation is enabled we can only add valid trigger points
+ # so we only need to check in call_trigger() if there's no
+ # trigger with the requested name.
+ __validate_triggerpoint($self, $when);
+ }
+
+ return scalar @{$result_store->{'_class_trigger_results'}};
+}
+
+sub __fetch_all_triggers {
+ my ($obj, $when, $list, $order) = @_;
+ my $class = ref $obj || $obj;
+ my $return;
+ unless ($list) {
+ # Absence of the $list parameter conditions the creation of
+ # the unrolled list of triggers. These keep track of the unique
+ # set of triggers being collected for each class and the order
+ # in which to return them (based on hierarchy; base class
+ # triggers are returned ahead of descendant class triggers).
+ $list = {};
+ $order = [];
+ $return = 1;
+ }
+ no strict 'refs';
+ my @classes = @{$class . '::ISA'};
+ push @classes, $class;
+ foreach my $c (@classes) {
+ next if $list->{$c};
+ if (UNIVERSAL::can($c, 'call_trigger')) {
+ $list->{$c} = [];
+ __fetch_all_triggers($c, $when, $list, $order)
+ unless $c eq $class;
+ if (defined $when && $Triggers{$c}{$when}) {
+ push @$order, $c;
+ $list->{$c} = $Triggers{$c}{$when};
+ }
+ }
+ }
+ if ($return) {
+ my @triggers;
+ foreach my $class (@$order) {
+ push @triggers, @{ $list->{$class} };
+ }
+ if (ref $obj && defined $when) {
+ my $obj_triggers = $obj->{__triggers}{$when};
+ push @triggers, @$obj_triggers if $obj_triggers;
+ }
+ return @triggers;
+ }
+}
+
+sub __validate_triggerpoint {
+ return unless my $points = $TriggerPoints{ref $_[0] || $_[0]};
+ my ($self, $when) = @_;
+ Carp::croak("$when is not valid triggerpoint for ".(ref($self) ? ref($self) : $self))
+ unless $points->{$when};
+}
+
+sub __fetch_triggers {
+ my ($obj, $proto) = @_;
+ # check object based triggers first
+ return ref $obj ? $obj->{__triggers} ||= {} : $Triggers{$obj} ||= {};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Jifty::DBI::Class::Trigger - Mixin to add / call inheritable triggers
+
+=head1 WARNING
+
+This Module is a TEMPORARY FORK of Class::Trigger. It will be replaced
+upon the release of new features in Class::Trigger that we depend on.
+
+ALL BUGS IN THIS MODULE ARE THE FAULT OF Jifty's DEVELOPERS AND NOT
+Class::Trigger's DEVELOPERS. UNDER NO CIRCUMSTANCES SHOULD BUGS
+BE REPORTED TO CLASS::TRIGGER'S DEVELOPERS.
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use Jifty::DBI::Class::Trigger;
+
+ sub foo {
+ my $self = shift;
+ $self->call_trigger('before_foo');
+ # some code ...
+ $self->call_trigger('middle_of_foo');
+ # some code ...
+ $self->call_trigger('after_foo');
+ }
+
+ package main;
+ Foo->add_trigger(before_foo => \&sub1);
+ Foo->add_trigger(after_foo => \&sub2);
+
+ my $foo = Foo->new;
+ $foo->foo; # then sub1, sub2 called
+
+ # triggers are inheritable
+ package Bar;
+ use base qw(Foo);
+
+ Bar->add_trigger(before_foo => \&sub);
+
+ # triggers can be object based
+ $foo->add_trigger(after_foo => \&sub3);
+ $foo->foo; # sub3 would appply only to this object
+
+=head1 DESCRIPTION
+
+Jifty::DBI::Class::Trigger is a mixin class to add / call triggers (or hooks)
+that get called at some points you specify.
+
+=head1 METHODS
+
+By using this module, your class is capable of following methods.
+
+=over 4
+
+=item add_trigger
+
+ Foo->add_trigger($triggerpoint => $sub);
+ $foo->add_trigger($triggerpoint => $sub);
+
+
+ Foo->add_trigger( name => $triggerpoint,
+ callback => sub {return undef},
+ abortable => 1);
+
+ # no further triggers will be called. Undef will be returned.
+
+
+Adds triggers for trigger point. You can have any number of triggers
+for each point. Each coderef will be passed a reference to the calling object,
+as well as arguments passed in via L<call_trigger>. Return values will be
+captured in I<list context>.
+
+If add_trigger is called with named parameters and the C<abortable>
+parameter is passed a true value, a false return value from trigger
+code will stop processing of this trigger point and return a C<false>
+value to the calling code.
+
+If C<add_trigger> is called without the C<abortable> flag, return
+values will be captured by call_trigger, but failures will be ignored.
+
+If C<add_trigger> is called as object method, whole current trigger
+table will be copied onto the object and the new trigger added to
+that. (The object must be implemented as hash.)
+
+ my $foo = Foo->new;
+
+ # this trigger ($sub_foo) would apply only to $foo object
+ $foo->add_trigger($triggerpoint => $sub_foo);
+ $foo->foo;
+
+ # And not to another $bar object
+ my $bar = Foo->new;
+ $bar->foo;
+
+=item call_trigger
+
+ $foo->call_trigger($triggerpoint, @args);
+
+Calls triggers for trigger point, which were added via C<add_trigger>
+method. Each triggers will be passed a copy of the object as the first argument.
+Remaining arguments passed to C<call_trigger> will be passed on to each trigger.
+Triggers are invoked in the same order they were defined.
+
+If there are no C<abortable> triggers or no C<abortable> trigger point returns
+a false value, C<call_trigger> will return the number of triggers processed.
+
+
+If an C<abortable> trigger returns a false value, call trigger will stop execution
+of the trigger point and return undef.
+
+=item last_trigger_results
+
+ my @results = @{ $foo->last_trigger_results };
+
+Returns a reference to an array of the return values of all triggers called
+for the last trigger point. Results are ordered in the same order the triggers
+were run.
+
+
+=back
+
+=head1 TRIGGER POINTS
+
+By default you can make any number of trigger points, but if you want
+to declare names of trigger points explicitly, you can do it via
+C<import>.
+
+ package Foo;
+ use Jifty::DBI::Class::Trigger qw(foo bar baz);
+
+ package main;
+ Foo->add_trigger(foo => \&sub1); # okay
+ Foo->add_trigger(hoge => \&sub2); # exception
+
+=head1 FAQ
+
+B<Acknowledgement:> Thanks to everyone at POOP mailing-list
+(http://poop.sourceforge.net/).
+
+=over 4
+
+=item Q.
+
+This module lets me add subs to be run before/after a specific
+subroutine is run. Yes?
+
+=item A.
+
+You put various call_trigger() method in your class. Then your class
+users can call add_trigger() method to add subs to be run in points
+just you specify (exactly where you put call_trigger()).
+
+=item Q.
+
+Are you aware of the perl-aspects project and the Aspect module? Very
+similar to Jifty::DBI::Class::Trigger by the look of it, but its not nearly as
+explicit. Its not necessary for foo() to actually say "triggers go
+*here*", you just add them.
+
+=item A.
+
+Yep ;)
+
+But the difference with Aspect would be that Jifty::DBI::Class::Trigger is so
+simple that it's easy to learn, and doesn't require 5.6 or over.
+
+=item Q.
+
+How does this compare to Sub::Versive, or Hook::LexWrap?
+
+=item A.
+
+Very similar. But the difference with Jifty::DBI::Class::Trigger would be the
+explicitness of trigger points.
+
+In addition, you can put hooks in any point, rather than pre or post
+of a method.
+
+=item Q.
+
+It looks interesting, but I just can't think of a practical example of
+its use...
+
+=item A.
+
+(by Tony Bowden)
+
+I originally added code like this to Class::DBI to cope with one
+particular case: auto-upkeep of full-text search indices.
+
+So I added functionality in Class::DBI to be able to trigger an
+arbitary subroutine every time something happened - then it was a
+simple matter of setting up triggers on INSERT and UPDATE to reindex
+that row, and on DELETE to remove that index row.
+
+See L<Class::DBI::mysql::FullTextSearch> and its source code to see it
+in action.
+
+=back
+
+=head1 AUTHOR
+
+IMPORTANT: DO NOT REPORT BUGS TO THE AUTHORS MENTIONED BELOW. PLEASE
+REPORT THEM TO JIFTY-DEVEL at LISTS.BESTPRACTICAL.COM. PLEASE SEE THE WARNING
+ABOVE
+
+Original idea by Tony Bowden E<lt>tony at kasei.comE<gt> in Class::DBI.
+
+Code by Tatsuhiko Miyagawa E<lt>miyagawa at bulknews.netE<gt>.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Class::DBI>
+
+=cut
+
Modified: Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm
==============================================================================
--- Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm (original)
+++ Jifty-DBI/branches/od/lib/Jifty/DBI/Record.pm Sat Mar 3 11:38:15 2007
@@ -7,7 +7,7 @@
use Lingua::EN::Inflect ();
use Jifty::DBI::Column ();
use UNIVERSAL::require ();
-use Class::Trigger qw/add_trigger call_trigger/;
+use Jifty::DBI::Class::Trigger; # exports by default
use base qw/
@@ -701,7 +701,7 @@
my $ok = $self->_run_callback( name => "before_set_" . $args{column},
args => \%args);
- return $ok if not ($ok);
+ return $ok if( not defined $ok);
$ok = $self->__set(%args);
return $ok if not $ok;
@@ -1045,15 +1045,14 @@
- my $ok = $self->_run_callback( name => "before_create",
- args => \%attribs);
- return $ok if not ($ok);
+ my $ok = $self->_run_callback( name => "before_create", args => \%attribs);
+ return $ok if ( not defined $ok);
my $ret = $self->__create(%attribs);
$ok = $self->_run_callback( name => "after_create",
args => \$ret);
- return $ok if not ($ok);
+ return $ok if (not defined $ok);
if ($class) {
$self->load_by_cols(id => $ret);
@@ -1149,12 +1148,12 @@
sub delete {
my $self = shift;
my $before_ret = $self->_run_callback( name => 'before_delete' );
- return $before_ret unless ($before_ret);
+ return $before_ret unless (defined $before_ret);
my $ret = $self->__delete;
my $after_ret
= $self->_run_callback( name => 'after_delete', args => \$ret );
- return $after_ret unless ($after_ret);
+ return $after_ret unless (defined $after_ret);
return ($ret);
}
@@ -1352,11 +1351,10 @@
my %args = ( column => undef,
value => undef,
@_);
- my $key = $args{column};
- my $attr = $args{value};
- my $method = "canonicalize_$key";
- my $func = $self->can($method) or return $attr;
- return ($self->$func( $attr));
+
+ my ($ret,$value_ref) = $self->_run_callback ( name => "canonicalize_".$args{'column'}, args => $args{'value'});
+ return unless defined $ret;
+ return ( exists $value_ref->[-1]->[0] ? $value_ref->[-1]->[0] : $args{'value'});
}
sub has_canonicalizer_for_column {
@@ -1377,48 +1375,54 @@
sub run_validation_for_column {
my $self = shift;
- my %args = ( column => undef,
- value => undef,
- @_);
- my $key = $args{'column'};
- my $attr = $args{'value'};
- my $method = "validate_$key";
- if (my $func = $self->can($method)) {
- my ( $val, $msg ) = $func->($self, $attr);
- return ($val,$msg);
- }
+ my %args = (
+ column => undef,
+ value => undef,
+ @_
+ );
+ my $key = $args{'column'};
+ my $attr = $args{'value'};
+
+ my ($ret, $results) = $self->_run_callback( name => "validate_".$key, args => $attr );
+
+ if (defined $ret) {
+ return ( 1, 'Validation ok' );
+ }
else {
- return (1, 'Validation ok');
+ return @{$results->[-1]};
}
+
}
sub has_validator_for_column {
my $self = shift;
- my $key = shift;
- my $method = "validate_$key";
- if( $self->can($method) ) {
- return 1;
- } else {
- return undef;
- }
+ my $key = shift;
+ if ( $self->can( "validate_" . $key ) ) {
+ return 1;
+ } else {
+ return undef;
+ }
}
-
sub _run_callback {
my $self = shift;
- my %args = ( name => undef,
- args => undef,
- @_);
+ my %args = (
+ name => undef,
+ args => undef,
+ @_
+ );
+
+ my $ret;
my $method = $args{'name'};
- if ( $self->can($method) ) {
- return $self->$method( $args{args} );
+ my @results;
+ if ( my $func = $self->can($method) ) {
+ @results = $func->($self, $args{args} );
+ return(wantarray ? (undef, [@results]) : undef) unless $results[0];
}
-
- my @return = $self->call_trigger($args{'name'} => $args{args});
-
- return 1;
+ $ret = $self->call_trigger( $args{'name'} => $args{args} );
+ return (wantarray ? ($ret, [[@results],@{$self->last_trigger_results}]) : $ret);
}
1;
Modified: Jifty-DBI/branches/od/lib/Jifty/DBI/Record/Plugin.pm
==============================================================================
--- Jifty-DBI/branches/od/lib/Jifty/DBI/Record/Plugin.pm (original)
+++ Jifty-DBI/branches/od/lib/Jifty/DBI/Record/Plugin.pm Sat Mar 3 11:38:15 2007
@@ -15,6 +15,10 @@
$caller->_init_methods_for_column($_);
}
$self->export_to_level(1,undef);
+
+ if (my $triggers = $self->can('register_triggers') ) {
+ $triggers->($caller)
+ }
}
More information about the Jifty-commit
mailing list