[Rt-commit] r18158 - in rt/3.999/branches/lorzy: lib/RT lib/RT/Lorzy

[clkao at bestpractical.com]

Author: clkao
Date: Tue Feb  3 22:35:25 2009
New Revision: 18158

Added:
   rt/3.999/branches/lorzy/lib/RT/Lorzy/
   rt/3.999/branches/lorzy/lib/RT/Lorzy.pm
   rt/3.999/branches/lorzy/lib/RT/Lorzy/Dispatcher.pm
   rt/3.999/branches/lorzy/t/lorzy/
   rt/3.999/branches/lorzy/t/lorzy/basic.t

Log:
basic lorzy glue with RT::Rule.

Added: rt/3.999/branches/lorzy/lib/RT/Lorzy.pm
==============================================================================
--- (empty file)
+++ rt/3.999/branches/lorzy/lib/RT/Lorzy.pm	Tue Feb  3 22:35:25 2009
@@ -0,0 +1,47 @@
+package RT::Lorzy;
+use strict;
+use warnings;
+
+use RT::Ruleset;
+use Lorzy::Evaluator;
+
+RT::Ruleset->add( name => 'Lorzy', rules => ['RT::Lorzy::Dispatcher'] );
+our $EVAL = Lorzy::Evaluator->new();
+$EVAL->load_package($_) for qw(Str Native);
+
+sub evaluate {
+    my ($self, $code, %args) = @_;
+    my $ret = $EVAL->apply_script( $code, \%args );
+    return $ret;
+}
+
+package RT::Lorzy::Rule;
+use base 'Class::Accessor::Fast';
+__PACKAGE__->mk_accessors(qw(condition action));
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+    if (ref($self->action) eq 'CODE') {
+        # XXX: signature compat check
+        $self->action( Lorzy::Lambda::Native->new( body => $self->action,
+                                                   signature => 
+        { ticket => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Ticket' ) }
+
+                                               ) );
+    }
+    return $self;
+}
+
+sub on_condition {
+    my ($self, $ticket_obj, $transaction_obj) = @_;
+    return RT::Lorzy->evaluate( $self->condition, ticket => $ticket_obj);
+}
+
+sub commit {
+    my ($self, $ticket_obj, $transaction_obj) = @_;
+    warn "==> committing action $ticket_obj";
+    return RT::Lorzy->evaluate( $self->action, ticket => $ticket_obj);
+}
+
+1;

Added: rt/3.999/branches/lorzy/lib/RT/Lorzy/Dispatcher.pm
==============================================================================
--- (empty file)
+++ rt/3.999/branches/lorzy/lib/RT/Lorzy/Dispatcher.pm	Tue Feb  3 22:35:25 2009
@@ -0,0 +1,28 @@
+package RT::Lorzy::Dispatcher;
+use base 'RT::Rule';
+use base 'RT::Ruleset';
+
+my $rules;
+
+sub add_rule {
+    my ($self, $rule) = @_;
+    push @$rules, $rule;
+}
+
+sub prepare {
+    my ($self, %args) = @_;
+    for (@$rules) {
+        push @{$self->{prepared}}, $_
+            if $_->on_condition( $self->ticket_obj, $self->transaction_obj );
+    }
+    return scalar @{$self->{prepared}};
+}
+
+sub commit {
+    my ($self, %args) = @_;
+    for ( @{$self->{prepared}} ) {
+        $_->commit( $self->ticket_obj, $self->transaction_obj );
+    }
+}
+
+1;

Added: rt/3.999/branches/lorzy/t/lorzy/basic.t
==============================================================================
--- (empty file)
+++ rt/3.999/branches/lorzy/t/lorzy/basic.t	Tue Feb  3 22:35:25 2009
@@ -0,0 +1,70 @@
+use Test::More tests => 28;
+use RT::Test;
+
+use strict;
+use warnings;
+
+use RT::Model::Queue;
+use RT::Model::User;
+use RT::Model::Group;
+use RT::Model::Ticket;
+use RT::Model::ACE;
+use RT::CurrentUser;
+use Test::Exception;
+
+use_ok('Lorzy');
+
+my $eval = Lorzy::Evaluator->new();
+$eval->load_package($_) for qw(Str Native);
+
+my $tree    = [ { name => 'IfThen',
+                  args => { if_true => { name => 'True' },
+                            if_false => { name => 'False' },
+                            condition => { name => 'Str.Eq',
+                                args => {
+                                    arg1 => "open",
+                                    arg2 => { name => 'Native.Invoke',
+                                              args => { obj => { name => 'Symbol', args => { symbol => 'ticket' }},
+                                                        method => 'status',
+                                                        args => { name => 'List',  nodes => []} },
+                                          },
+                                }
+                  } }} ];
+my $builder = Lorzy::Builder->new();
+my $is_open  = $builder->defun(
+    ops => $tree,
+    signature =>
+        { ticket => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Model::Ticket' ) }
+);
+
+my $queue = RT::Model::Queue->new(current_user => RT->system_user);
+my ($queue_id) = $queue->create( name =>  'lorzy');
+ok( $queue_id, 'queue created' );
+
+my $ticket = RT::Model::Ticket->new(current_user => RT->system_user );
+my ($rv, $msg) = $ticket->create( subject => 'watcher tests', queue => $queue->name );
+
+my $ret;
+lives_ok {
+    $ret = $eval->apply_script( $is_open, { 'ticket' => $ticket } );
+};
+ok(!$ret);
+
+$ticket->set_status('open');
+
+lives_ok {
+    $ret = $eval->apply_script( $is_open, { 'ticket' => $ticket } );
+};
+ok($ret);
+
+use RT::Lorzy;
+
+RT::Lorzy::Dispatcher->add_rule(
+    RT::Lorzy::Rule->new( { condition => $is_open,
+                            action => sub { warn "rahh!"} } )
+);
+
+warn $ticket->comment(content => 'lorzy lorzy in the code');
+
+1;
+