[Rt-commit] rt branch, lcore, created. 840f105b2227defc9a2eca7109bc63e6ba4cdd7d

clkao at bestpractical.com clkao at bestpractical.com
Wed Jul 22 13:11:28 EDT 2009


The branch, lcore has been created
        at  840f105b2227defc9a2eca7109bc63e6ba4cdd7d (commit)

- Log -----------------------------------------------------------------
commit 922811686e82f7769370bd1de0a38a7df2fdb8be
Author: Chia-liang Kao <clkao at clkao.org>
Date:   Sun Jul 19 12:08:16 2009 +0800

    basic reglue for lcore.

diff --git a/lib/RT/Lorzy.pm b/lib/RT/Lorzy.pm
index cd30687..3d477c6 100644
--- a/lib/RT/Lorzy.pm
+++ b/lib/RT/Lorzy.pm
@@ -10,6 +10,10 @@ RT::Ruleset->register( 'RT::Lorzy::Dispatcher' );
 our $EVAL = Lorzy::Evaluator->new();
 $EVAL->load_package($_) for qw(Str Native);
 $EVAL->load_package('RT', 'RT::Lorzy::Package::RT');
+use LCore;
+use LCore::Level2;
+
+our $LCORE = LCore->new( env => LCore::Level2->new );
 
 sub evaluate {
     my ($self, $code, %args) = @_;
@@ -48,8 +52,11 @@ sub create_scripish {
             transaction => { name => 'Symbol', args => { symbol => 'transaction' } }
         } };
 
+    # my $lcore_code = "(RT.Condition.$lorzy_cond ticket transaction)"
+
     if ($queue) {
 
+        # $lcore_code = qq{(and $lcore_code (Str.Eq "$queue" (Native.Invoke ticket "queue")))}
         $tree = { name => 'And',
                   args => { nodes =>
                                 [ { name => 'Str.Eq',
@@ -111,27 +118,7 @@ __PACKAGE__->mk_accessors(qw(description condition action prepare _stage));
 
 sub make_factory {
     my $class = shift;
-    my $self = $class->SUPER::new(@_);
-
-    if (ref($self->condition) eq 'CODE') {
-        # XXX: signature compat check
-        $self->condition( Lorzy::Lambda::Native->new( body => $self->condition,
-                                                   signature => 
-        { ticket => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Model::Ticket' ),
-          transaction => Lorzy::FunctionArgument->new( name => 'transaction', type => 'RT::Model::Transaction' ) }
-        ) );
-    }
-    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::Model::Ticket' ),
-          context => Lorzy::FunctionArgument->new( name => 'context', type => 'RT::Model::Ticket' ),
-          transaction => Lorzy::FunctionArgument->new( name => 'transaction', type => 'RT::Model::Transaction' ) }
-
-                                               ) );
-    }
-    return $self;
+    return $class->SUPER::new(@_);
 }
 
 sub new {
@@ -156,24 +143,21 @@ sub _init {
 
 sub prepare {
     my ( $self, %args ) = @_;
-    my $ret = RT::Lorzy->evaluate( $self->factory->condition,
-                                   ticket      => $self->ticket_obj,
-                                   transaction => $self->transaction );
-    if (my $e = Lorzy::Exception->caught()) {
-        Jifty->log->error("Rule '@{[ $self->description]}' condition error, ignoring: $e");
-    }
-    return unless $ret;
+    warn "===> hi this is prepare for $self ";
+    my $ret = $self->factory->condition->apply($self->ticket_obj, $self->transaction);
+    warn $ret;
+#    if (my $e = Lorzy::Exception->caught()) {
+#        Jifty->log->error("Rule '@{[ $self->description]}' condition error, ignoring: $e");
+#    }
+#    return unless $ret;
 
     return 1 unless $self->factory->prepare;
+    warn "==> hi this is to preprae";
+    $ret = $self->factory->prepare->($self->ticket_obj, $self->transaction, $self->context);
 
-    $ret = RT::Lorzy->evaluate( $self->factory->prepare,
-        context     => $self->context,
-        ticket      => $self->ticket_obj,
-        transaction => $self->transaction );
-
-    if (my $e = Lorzy::Exception->caught()) {
-        Jifty->log->error("Rule '@{[ $self->description]}' prepare error, ignoring: $e");
-    }
+#    if (my $e = Lorzy::Exception->caught()) {
+#        Jifty->log->error("Rule '@{[ $self->description]}' prepare error, ignoring: $e");
+#    }
     return $ret;
 }
 
@@ -186,14 +170,12 @@ sub hints {
 
 sub commit {
     my ($self, %args) = @_;
-    my $ret = RT::Lorzy->evaluate( $self->factory->action,
-                                   context => $self->context,
-                                   ticket => $self->ticket_obj,
-                                   transaction => $self->transaction);
+    warn "==> trying to commit";
+    my $ret = $self->factory->action->apply($self->ticket_obj, $self->transaction, $self->context);
 
-    if (my $e = Lorzy::Exception->caught()) {
-        Jifty->log->error("Rule '@{[ $self->description]}' commit error: $e");
-    }
+#    if (my $e = Lorzy::Exception->caught()) {
+#        Jifty->log->error("Rule '@{[ $self->description]}' commit error: $e");
+#    }
     return $ret;
 }
 
diff --git a/lib/RT/Lorzy/Dispatcher.pm b/lib/RT/Lorzy/Dispatcher.pm
index ebaeae9..510ff2f 100644
--- a/lib/RT/Lorzy/Dispatcher.pm
+++ b/lib/RT/Lorzy/Dispatcher.pm
@@ -14,11 +14,12 @@ sub reset_rules {
 sub rules {
     my $rules = RT::Model::RuleCollection->new( current_user => RT::CurrentUser->superuser);
     $rules->unlimit;
+    my $l = $RT::Lorzy::LCORE;
     return [ map {
         RT::Lorzy::RuleFactory->make_factory(
-            { condition     => Jifty::YAML::Load($_->condition_code),
-              prepare       => Jifty::YAML::Load($_->prepare_code),
-              action        => Jifty::YAML::Load($_->action_code),
+            { condition     => $l->analyze_it($_->condition_code)->($l->env),
+              prepare       => $_->prepare_code ? $l->analyze_it($_->prepare_code)->($l->env) : undef,
+              action        => $l->analyze_it($_->action_code)->($l->env),
               description   => $_->description,
               _stage        => 'transaction_create' })
         } @$rules];
diff --git a/lib/RT/Lorzy/Package/RT.pm b/lib/RT/Lorzy/Package/RT.pm
index beeceb9..b6843e4 100644
--- a/lib/RT/Lorzy/Package/RT.pm
+++ b/lib/RT/Lorzy/Package/RT.pm
@@ -2,6 +2,23 @@ package RT::Lorzy::Package::RT;
 use strict;
 use base 'Lorzy::Package';
 
+=begin comment
+
+sub lcore_defun {
+    my ($env, $name, %args) = @_;
+    $env->set_symbol($name => LCore::Primitive->new(
+        body => sub {
+            my ($ticket, $transaction) = @_;
+            $args->{native}->(
+                { ticket      => $ticket,
+                  transaction => $transaction });
+        },
+        parameters => [ LCore::Parameter->new({ name => 'ticket', type => 'RT::Model::Ticket' }),
+                        LCore::Parameter->new({ name => 'transaction', type => 'RT::Model::Transaction' }) ],
+    ));
+}
+
+=cut
 
 my $sig_ticket_txn = {
         'ticket' => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Model::Ticket' ),
@@ -145,6 +162,7 @@ for my $name ( keys %simple_txn_cond ) {
     __PACKAGE__->defun( "Condition.$name",
         signature => $sig_ticket_txn,
         native => sub {
+return 0;
             my $args = shift;
             return $args->{transaction}->type eq $simple_txn_cond{$name};
         },
diff --git a/t/lorzy/action.t b/t/lorzy/action.t
index f360eee..e22b808 100644
--- a/t/lorzy/action.t
+++ b/t/lorzy/action.t
@@ -15,51 +15,69 @@ use RT::Test::Email;
 
 use_ok('Lorzy');
 use_ok('RT::Lorzy');
+use_ok('LCore');
+use_ok('LCore::Level2');
+my $l = $RT::Lorzy::LCORE;
 
-my $tree    = [ { name => 'IfThen',
-                  args => { if_true => { name => 'True' },
-                            if_false => { name => 'False' },
-                            condition => { name => 'RT.Condition.OnCreate',
-                                args => {
-                                    ticket => { name => 'Symbol', args => { symbol => 'ticket' }},
-                                    transaction => { name => 'Symbol', args => { symbol => 'transaction' }},
-                                    }
-                            }
-                        } } ];
+$l->env->set_symbol('Native.Invoke' => LCore::Primitive->new
+                        ( body => sub {
+                              my ($object, $method, @args) = @_;
+                              return $object->$method(@args);
+                          },
+                          lazy => 0,
+                      ));
 
-my $builder = Lorzy::Builder->new();
-my $on_created  = $builder->defun(
-    ops => $tree,
-    signature =>
-        { ticket => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Model::Ticket' ),
-          transaction => Lorzy::FunctionArgument->new( name => 'transaction', type => 'RT::Model::Transaction' ) }
-);
+$l->env->set_symbol('Str.Eq' => LCore::Primitive->new
+                        ( body => sub {
+                              return $_[0] eq $_[1];
+                          }));
 
-$tree    = [ { name => 'RT.ScripAction.Run',
-               args => {
-                   name => "Autoreply To requestors",
-                   template => "Autoreply",
-                   context => { name => 'Symbol', args => { symbol => 'context' } },
-                   ticket => { name => 'Symbol', args => { symbol => 'ticket' }},
-                   transaction => { name => 'Symbol', args => { symbol => 'transaction' }},
-               } } ];
-my $auto_reply  = $builder->defun(
-    ops => $tree,
-    signature =>
-        { ticket => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Model::Ticket' ),
-          context => Lorzy::FunctionArgument->new( name => 'context', type => 'HASH' ),
-          transaction => Lorzy::FunctionArgument->new( name => 'transaction', type => 'RT::Model::Transaction' ) }
-);
+$l->env->set_symbol('RT.RuleAction.Run' => LCore::Primitive->new
+                        ( body => sub {
+                              warn "run ruleaction! " .join(',', at _);
+                              return;
+                          },
+                          lazy => 0,
+                          parameters => [ LCore::Parameter->new({ name => 'name', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'template', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'context', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'ticket', type => 'RT::Model::Ticket' }),
+                                          LCore::Parameter->new({ name => 'transaction', type => 'RT::Model::Transaction' }) ],
 
-RT::Lorzy::Dispatcher->reset_rules;
+                      ));
+
+
+my $on_created_lcore = q{
+(lambda (ticket transaction)
+  (Str.Eq (Native.Invoke transaction "type") "create"))
+};
+#my $on_created_lcore2 = $l->analze_it("RT.Condition.OnCreate")
+    # my $lcore_code = "(RT.Condition.$lorzy_cond ticket transaction)"
 
+#my $auto_reply_lcore = $l->analyze_it(q{(quote (RT.RuleAction.SendEmail (to . ## $self->ticket_obj->role_group("requestor")->member_emails )))});
+# (lambda (ticket :RT::Model::Ticket transaction :RT::Model::Transaction context :HASH)
+my $auto_reply_lcore = q{
+(lambda (ticket transaction context)
+  (RT.RuleAction.Run
+        (("name"        . "Autoreply To requestors")
+         ("template"    . "Autoreply")
+         ("context"     . context)
+         ("ticket"      . ticket)
+         ("transaction" . transaction))))
+};
+
+RT::Lorzy::Dispatcher->reset_rules;
+#
 my $rule = RT::Model::Rule->new( current_user => RT->system_user );
-$rule->create_from_factory( 
-    RT::Lorzy::RuleFactory->make_factory
-    ( { condition => $on_created,
-        _stage => 'transaction_create',
-        action => $auto_reply } )
-);
+$rule->create( condition_code => $on_created_lcore,
+               action_code    => $auto_reply_lcore );
+
+#$rule->create_from_factory( 
+#    RT::Lorzy::RuleFactory->make_factory
+#    ( { condition => $on_created,
+#        _stage => 'transaction_create',
+#        action => $auto_reply } )
+#);
 
 my $queue = RT::Model::Queue->new(current_user => RT->system_user);
 my ($queue_id) = $queue->create( name =>  'lorzy');

commit e9b8f371dfc9bb2658c826c7858cfa292de31af1
Author: Chia-liang Kao <clkao at clkao.org>
Date:   Sun Jul 19 15:17:09 2009 +0800

    make action.t pass again

diff --git a/t/lorzy/action.t b/t/lorzy/action.t
index e22b808..9f97f34 100644
--- a/t/lorzy/action.t
+++ b/t/lorzy/action.t
@@ -1,4 +1,4 @@
-use Test::More tests => 6;
+use Test::More tests => 7;
 use RT::Test;
 
 use strict;
@@ -13,7 +13,6 @@ use RT::CurrentUser;
 use Test::Exception;
 use RT::Test::Email;
 
-use_ok('Lorzy');
 use_ok('RT::Lorzy');
 use_ok('LCore');
 use_ok('LCore::Level2');
@@ -34,8 +33,16 @@ $l->env->set_symbol('Str.Eq' => LCore::Primitive->new
 
 $l->env->set_symbol('RT.RuleAction.Run' => LCore::Primitive->new
                         ( body => sub {
-                              warn "run ruleaction! " .join(',', at _);
-                              return;
+                              my ($name, $template, $context, $ticket, $transaction) = @_;
+                              my $action = $context->{action};
+                              unless ($action) {
+                                  my $rule = RT::Rule->new( current_user => $ticket->current_user,
+                                                            ticket_obj => $ticket,
+                                                            transaction_obj => $transaction );
+                                  $action = $rule->get_scrip_action($name, $template);
+                                  $action->prepare or return;
+                              }
+                              $action->commit;
                           },
                           lazy => 0,
                           parameters => [ LCore::Parameter->new({ name => 'name', type => 'Str' }),

commit 5774c439f9117c8e8c7c5f45ab4fc685b7dc5d87
Author: Chia-liang Kao <clkao at clkao.org>
Date:   Mon Jul 20 14:35:17 2009 +0800

    translate the verbose lorzy construct into sexpression.

diff --git a/lib/RT/Bootstrap.pm b/lib/RT/Bootstrap.pm
index 9604fbb..605a5e5 100644
--- a/lib/RT/Bootstrap.pm
+++ b/lib/RT/Bootstrap.pm
@@ -449,15 +449,12 @@ sub insert_data {
         require RT::Lorzy;
         require Lorzy::Builder;
         for my $item (sort { $a->{description} cmp $b->{description} } @Scrips) {
-            my $rule_factory = RT::Lorzy->create_scripish(
+            RT::Lorzy->create_scripish(
                 $item->{scrip_condition},
                 $item->{scrip_action},
                 $item->{template},
                 $item->{description},
             );
-
-            my $rule = RT::Model::Rule->new( current_user => RT->system_user );
-            $rule->create_from_factory( $rule_factory );
         }
     }
 
diff --git a/lib/RT/Lorzy.pm b/lib/RT/Lorzy.pm
index 3d477c6..42f8431 100644
--- a/lib/RT/Lorzy.pm
+++ b/lib/RT/Lorzy.pm
@@ -15,6 +15,42 @@ use LCore::Level2;
 
 our $LCORE = LCore->new( env => LCore::Level2->new );
 
+$LCORE->env->set_symbol('Native.Invoke' => LCore::Primitive->new
+                        ( body => sub {
+                              my ($object, $method, @args) = @_;
+                              return $object->$method(@args);
+                          },
+                          lazy => 0,
+                      ));
+
+$LCORE->env->set_symbol('Str.Eq' => LCore::Primitive->new
+                        ( body => sub {
+                              return $_[0] eq $_[1];
+                          }));
+
+$LCORE->env->set_symbol('RT.RuleAction.Run' => LCore::Primitive->new
+                        ( body => sub {
+                              my ($name, $template, $context, $ticket, $transaction) = @_;
+                              my $action = $context->{action};
+                              unless ($action) {
+                                  my $rule = RT::Rule->new( current_user => $ticket->current_user,
+                                                            ticket_obj => $ticket,
+                                                            transaction_obj => $transaction );
+                                  $action = $rule->get_scrip_action($name, $template);
+                                  $action->prepare or return;
+                              }
+                              $action->commit;
+                          },
+                          lazy => 0,
+                          parameters => [ LCore::Parameter->new({ name => 'name', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'template', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'context', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'ticket', type => 'RT::Model::Ticket' }),
+                                          LCore::Parameter->new({ name => 'transaction', type => 'RT::Model::Transaction' }) ],
+
+                      ));
+
+
 sub evaluate {
     my ($self, $code, %args) = @_;
     eval { $EVAL->apply_script( $code, \%args ) };
@@ -39,77 +75,41 @@ my %cond_compat_map = ( 'On Create' => 'OnCreate',
 
 sub create_scripish {
     my ( $class, $scrip_condition, $scrip_action, $template, $description, $queue ) = @_;
-    my $sigs = { ticket => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Model::Ticket' ),
-        transaction => Lorzy::FunctionArgument->new( name => 'transaction', type => 'RT::Model::Transaction' ) };
-    my $builder = Lorzy::Builder->new();
-
     my $lorzy_cond = $cond_compat_map{$scrip_condition}
         or die "unsupported compat condition: $scrip_condition";
-    my $tree = {
-        name => 'RT.Condition.'.$lorzy_cond,
-        args => {
-            ticket => { name => 'Symbol', args => { symbol => 'ticket' } },
-            transaction => { name => 'Symbol', args => { symbol => 'transaction' } }
-        } };
-
-    # my $lcore_code = "(RT.Condition.$lorzy_cond ticket transaction)"
 
+    my $lcore_cond = "(RT.Condition.$lorzy_cond ticket transaction)";
     if ($queue) {
-
-        # $lcore_code = qq{(and $lcore_code (Str.Eq "$queue" (Native.Invoke ticket "queue")))}
-        $tree = { name => 'And',
-                  args => { nodes =>
-                                [ { name => 'Str.Eq',
-                                    args => {
-                                        arg1 => $queue,
-                                        arg2 => { name => 'Native.Invoke',
-                                                  args => { obj => { name => 'Native.Invoke',
-                                                                     args => { obj => { name => 'Symbol', args => { symbol => 'ticket' }},
-                                                                               method => 'queue',
-                                                                               args => { name => 'List',  nodes => []} } },
-                                                            method => 'id',
-                                                            args => { name => 'List',  nodes => []} },
-                                              },
-                                    }},
-                                  $tree ] } };
+        $lcore_cond = qq{(and $lcore_cond (Str.Eq "$queue" (Native.Invoke ticket "queue")))};
     }
-
-    my $condition = $builder->defun(
-        ops => [ $tree ],
-        signature => { %$sigs },
-    );
-
-    $sigs->{context} = Lorzy::FunctionArgument->new( name => 'context', type => 'HASH' );
-
-    my $prepare = $builder->defun(
-        ops => [ { name => 'RT.ScripAction.Prepare',
-                args => {
-                    name     => $scrip_action,
-                    context => { name => 'Symbol', args => { symbol => 'context' } },
-                    template => $template,
-                    ticket => { name => 'Symbol', args => { symbol => 'ticket' } },
-                    transaction => { name => 'Symbol', args => { symbol => 'transaction' } },
-                    } } ],
-        signature => $sigs );
-
-    my $action = $builder->defun(
-        ops => [ { name => 'RT.ScripAction.Run',
-                args => {
-                    name     => $scrip_action,
-                    context => { name => 'Symbol', args => { symbol => 'context' } },
-                    template => $template,
-                    ticket => { name => 'Symbol', args => { symbol => 'ticket' } },
-                    transaction => { name => 'Symbol', args => { symbol => 'transaction' } },
-                    } } ],
-        signature => $sigs );
-
-    RT::Lorzy::RuleFactory->make_factory(
-        { condition     => $condition,
-          prepare       => $prepare,
-          action        => $action,
-          description   => $description,
-          _stage        => 'transaction_create',
-      } )
+    $lcore_cond = qq{(lambda (ticket transaction) $lcore_cond)};
+
+    my $lcore_prepare = qq{
+(lambda (ticket transaction context)
+  (RT.RuleAction.Prepare
+        (("name"        . "$scrip_action")
+         ("template"    . "$template")
+         ("context"     . context)
+         ("ticket"      . ticket)
+         ("transaction" . transaction))))
+};
+
+    my $lcore_action = qq{
+(lambda (ticket transaction context)
+  (RT.RuleAction.Run
+        (("name"        . "$scrip_action")
+         ("template"    . "$template")
+         ("context"     . context)
+         ("ticket"      . ticket)
+         ("transaction" . transaction))))
+};
+
+    my $rule = RT::Model::Rule->new( current_user => RT->system_user );
+    $rule->create( condition_code => $lcore_cond,
+                   prepare_code   => $lcore_prepare,
+                   action_code    => $lcore_action,
+                   description    => $description,
+               );
 }
 
 package RT::Lorzy::RuleFactory;
diff --git a/t/lorzy/action.t b/t/lorzy/action.t
index 9f97f34..8878cc3 100644
--- a/t/lorzy/action.t
+++ b/t/lorzy/action.t
@@ -18,41 +18,6 @@ use_ok('LCore');
 use_ok('LCore::Level2');
 my $l = $RT::Lorzy::LCORE;
 
-$l->env->set_symbol('Native.Invoke' => LCore::Primitive->new
-                        ( body => sub {
-                              my ($object, $method, @args) = @_;
-                              return $object->$method(@args);
-                          },
-                          lazy => 0,
-                      ));
-
-$l->env->set_symbol('Str.Eq' => LCore::Primitive->new
-                        ( body => sub {
-                              return $_[0] eq $_[1];
-                          }));
-
-$l->env->set_symbol('RT.RuleAction.Run' => LCore::Primitive->new
-                        ( body => sub {
-                              my ($name, $template, $context, $ticket, $transaction) = @_;
-                              my $action = $context->{action};
-                              unless ($action) {
-                                  my $rule = RT::Rule->new( current_user => $ticket->current_user,
-                                                            ticket_obj => $ticket,
-                                                            transaction_obj => $transaction );
-                                  $action = $rule->get_scrip_action($name, $template);
-                                  $action->prepare or return;
-                              }
-                              $action->commit;
-                          },
-                          lazy => 0,
-                          parameters => [ LCore::Parameter->new({ name => 'name', type => 'Str' }),
-                                          LCore::Parameter->new({ name => 'template', type => 'Str' }),
-                                          LCore::Parameter->new({ name => 'context', type => 'Str' }),
-                                          LCore::Parameter->new({ name => 'ticket', type => 'RT::Model::Ticket' }),
-                                          LCore::Parameter->new({ name => 'transaction', type => 'RT::Model::Transaction' }) ],
-
-                      ));
-
 
 my $on_created_lcore = q{
 (lambda (ticket transaction)

commit 840f105b2227defc9a2eca7109bc63e6ba4cdd7d
Author: Chia-liang Kao <clkao at clkao.org>
Date:   Mon Jul 20 15:09:15 2009 +0800

    quick hack to use lcore everywhere

diff --git a/lib/RT/Lorzy.pm b/lib/RT/Lorzy.pm
index 42f8431..a183bce 100644
--- a/lib/RT/Lorzy.pm
+++ b/lib/RT/Lorzy.pm
@@ -8,13 +8,13 @@ use RT::Lorzy::Dispatcher;
 
 RT::Ruleset->register( 'RT::Lorzy::Dispatcher' );
 our $EVAL = Lorzy::Evaluator->new();
-$EVAL->load_package($_) for qw(Str Native);
-$EVAL->load_package('RT', 'RT::Lorzy::Package::RT');
+#$EVAL->load_package($_) for qw(Str Native);
+#$EVAL->load_package('RT', 'RT::Lorzy::Package::RT');
 use LCore;
 use LCore::Level2;
 
 our $LCORE = LCore->new( env => LCore::Level2->new );
-
+require RT::Lorzy::Package::RT;
 $LCORE->env->set_symbol('Native.Invoke' => LCore::Primitive->new
                         ( body => sub {
                               my ($object, $method, @args) = @_;
@@ -28,6 +28,27 @@ $LCORE->env->set_symbol('Str.Eq' => LCore::Primitive->new
                               return $_[0] eq $_[1];
                           }));
 
+$LCORE->env->set_symbol('RT.RuleAction.Prepare' => LCore::Primitive->new
+                        ( body => sub {
+                              my ($name, $template, $context, $ticket, $transaction) = @_;
+                              my $rule = RT::Rule->new( current_user => $ticket->current_user,
+                                  ticket_obj => $ticket,
+                                  transaction_obj => $transaction
+                              );
+                              my $action = $rule->get_scrip_action($name, $template);
+                              $action->prepare or return;
+                              $context->{hints} = $action->hints;
+                              $context->{action} = $action;
+                          },
+                          lazy => 0,
+                          parameters => [ LCore::Parameter->new({ name => 'name', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'template', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'context', type => 'Str' }),
+                                          LCore::Parameter->new({ name => 'ticket', type => 'RT::Model::Ticket' }),
+                                          LCore::Parameter->new({ name => 'transaction', type => 'RT::Model::Transaction' }) ],
+
+                      ));
+
 $LCORE->env->set_symbol('RT.RuleAction.Run' => LCore::Primitive->new
                         ( body => sub {
                               my ($name, $template, $context, $ticket, $transaction) = @_;
@@ -149,11 +170,11 @@ sub prepare {
 #    if (my $e = Lorzy::Exception->caught()) {
 #        Jifty->log->error("Rule '@{[ $self->description]}' condition error, ignoring: $e");
 #    }
-#    return unless $ret;
+    return unless $ret;
 
     return 1 unless $self->factory->prepare;
     warn "==> hi this is to preprae";
-    $ret = $self->factory->prepare->($self->ticket_obj, $self->transaction, $self->context);
+    $ret = $self->factory->prepare->apply($self->ticket_obj, $self->transaction, $self->context);
 
 #    if (my $e = Lorzy::Exception->caught()) {
 #        Jifty->log->error("Rule '@{[ $self->description]}' prepare error, ignoring: $e");
@@ -170,7 +191,7 @@ sub hints {
 
 sub commit {
     my ($self, %args) = @_;
-    warn "==> trying to commit";
+    warn "==> trying to commit ".$self->factory->description;
     my $ret = $self->factory->action->apply($self->ticket_obj, $self->transaction, $self->context);
 
 #    if (my $e = Lorzy::Exception->caught()) {
diff --git a/lib/RT/Lorzy/Package/RT.pm b/lib/RT/Lorzy/Package/RT.pm
index b6843e4..88745cd 100644
--- a/lib/RT/Lorzy/Package/RT.pm
+++ b/lib/RT/Lorzy/Package/RT.pm
@@ -2,46 +2,35 @@ package RT::Lorzy::Package::RT;
 use strict;
 use base 'Lorzy::Package';
 
-=begin comment
-
 sub lcore_defun {
     my ($env, $name, %args) = @_;
-    $env->set_symbol($name => LCore::Primitive->new(
+    $RT::Lorzy::LCORE->env->set_symbol('RT.'.$name => LCore::Primitive->new(
         body => sub {
             my ($ticket, $transaction) = @_;
-            $args->{native}->(
+            $args{native}->(
                 { ticket      => $ticket,
                   transaction => $transaction });
         },
+        lazy => 0,
         parameters => [ LCore::Parameter->new({ name => 'ticket', type => 'RT::Model::Ticket' }),
                         LCore::Parameter->new({ name => 'transaction', type => 'RT::Model::Transaction' }) ],
     ));
 }
 
-=cut
-
-my $sig_ticket_txn = {
-        'ticket' => Lorzy::FunctionArgument->new( name => 'ticket', type => 'RT::Model::Ticket' ),
-        'transaction' => Lorzy::FunctionArgument->new( name => 'transaction', type => 'RT::Model::Transaction' ),
-    };
-
-__PACKAGE__->defun( 'Condition.OnTransaction',
-    signature => $sig_ticket_txn,
+__PACKAGE__->lcore_defun( 'Condition.OnTransaction',
     native => sub {
         return 1;
     },
 );
 
-__PACKAGE__->defun( 'Condition.OnOwnerChange',
-    signature => $sig_ticket_txn,
+__PACKAGE__->lcore_defun( 'Condition.OnOwnerChange',
     native => sub {
         my $args = shift;
         return ( $args->{transaction}->field || '' ) eq 'owner';
     },
 );
 
-__PACKAGE__->defun( 'Condition.OnQueueChange',
-    signature => $sig_ticket_txn,
+__PACKAGE__->lcore_defun( 'Condition.OnQueueChange',
     native => sub {
         my $args = shift;
         return $args->{transaction}->type eq 'set'
@@ -49,8 +38,7 @@ __PACKAGE__->defun( 'Condition.OnQueueChange',
     },
 );
 
-__PACKAGE__->defun( 'Condition.OnPriorityChange',
-    signature => $sig_ticket_txn,
+__PACKAGE__->lcore_defun( 'Condition.OnPriorityChange',
     native => sub {
         my $args = shift;
         return $args->{transaction}->type eq 'set'
@@ -58,8 +46,7 @@ __PACKAGE__->defun( 'Condition.OnPriorityChange',
     },
 );
 
-__PACKAGE__->defun( 'Condition.OnResolve',
-    signature => $sig_ticket_txn,
+__PACKAGE__->lcore_defun( 'Condition.OnResolve',
     native => sub {
         my $args = shift;
         return $args->{transaction}->type eq 'status'
@@ -68,8 +55,7 @@ __PACKAGE__->defun( 'Condition.OnResolve',
     },
 );
 
-__PACKAGE__->defun( 'Condition.OnClose',
-    signature => $sig_ticket_txn,
+__PACKAGE__->lcore_defun( 'Condition.OnClose',
     native => sub {
         my $args = shift;
         my $txn = $args->{transaction};
@@ -85,8 +71,7 @@ __PACKAGE__->defun( 'Condition.OnClose',
     },
 );
 
-__PACKAGE__->defun( 'Condition.OnReopen',
-    signature => $sig_ticket_txn,
+__PACKAGE__->lcore_defun( 'Condition.OnReopen',
     native => sub {
         my $args = shift;
         my $txn = $args->{transaction};
@@ -102,6 +87,8 @@ __PACKAGE__->defun( 'Condition.OnReopen',
     },
 );
 
+=begin comment
+
 __PACKAGE__->defun( 'Condition.BeforeDue',
     # format is "1d2h3m4s" for 1 day and 2 hours and 3 minutes and 4 seconds.
     signature => { 'datestring' => Lorzy::FunctionArgument->new( name => 'datestring', type => 'Str' ) },
@@ -152,6 +139,8 @@ __PACKAGE__->defun( 'Condition.Overdue',
     },
 );
 
+=cut
+
 my %simple_txn_cond = ( 'OnCreate' => 'create',
                         'OnCorrespond' => 'correspond',
                         'OnComment' => 'comment',
@@ -159,8 +148,7 @@ my %simple_txn_cond = ( 'OnCreate' => 'create',
                     );
 
 for my $name ( keys %simple_txn_cond ) {
-    __PACKAGE__->defun( "Condition.$name",
-        signature => $sig_ticket_txn,
+    __PACKAGE__->lcore_defun( "Condition.$name",
         native => sub {
 return 0;
             my $args = shift;
@@ -169,6 +157,8 @@ return 0;
     );
 }
 
+=begin comment
+
 __PACKAGE__->defun( 'ScripAction.Prepare',
     signature => {
         'name'     => Lorzy::FunctionArgument->new( name => 'name' ),
@@ -211,5 +201,6 @@ __PACKAGE__->defun( 'ScripAction.Run',
     },
 );
 
+=cut
 
 1;

-----------------------------------------------------------------------


More information about the Rt-commit mailing list