File: Chain.pm

package info (click to toggle)
libcircle-be-perl 0.173320-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 388 kB
  • sloc: perl: 6,042; makefile: 2; sh: 1
file content (138 lines) | stat: -rw-r--r-- 2,516 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#  You may distribute under the terms of the GNU General Public License
#
#  (C) Paul Evans, 2008-2010 -- leonerd@leonerd.org.uk

package Circle::Rule::Chain;

use strict;
use warnings;

our $VERSION = '0.173320';

use Circle::Rule::Resultset;

sub new
{
   my $class = shift;
   my ( $store ) = @_;

   my $self = bless {
      store => $store,
      rules => [],
   }, $class;

   return $self;
}

sub parse_rule
{
   my $self = shift;
   my ( $spec ) = @_;

   my $store = $self->{store};

   my @conds;

   while( length $spec and $spec !~ m/^:/ ) {
      push @conds, $store->parse_cond( $spec );

      $spec =~ s/^\s+//; # trim ws
   }

   $spec =~ s/^:\s*// or die "Expected ':' to separate condition and action\n";

   my @actions;

   while( length $spec ) {
      push @actions, $store->parse_action( $spec );

      $spec =~ s/^\s+//; # trim ws
   }

   @actions or die "Expected at least one action\n";

   return [ \@conds, \@actions ];
}

sub append_rule
{
   my $self = shift;
   my ( $spec ) = @_;

   push @{ $self->{rules} }, $self->parse_rule( $spec );
}

sub insert_rule
{
   my $self = shift;
   my ( $index, $spec ) = @_;

   # TODO: Consider what happens if index is OOB

   splice @{ $self->{rules} }, $index, 0, $self->parse_rule( $spec );
}

sub delete_rule
{
   my $self = shift;
   my ( $index ) = @_;

   $index < @{ $self->{rules} } or die "No rule at index $index\n";

   splice @{ $self->{rules} }, $index, 1, ();
}

sub clear
{
   my $self = shift;

   @{ $self->{rules} } = ();
}

sub deparse_rules
{
   my $self = shift;

   my $store = $self->{store};

   my @ret;

   foreach my $rule ( @{ $self->{rules} } ) {
      my ( $conds, $actions ) = @$rule;
      push @ret, join( " ", map { $store->deparse_cond( $_ ) } @$conds ) .
                 ": " .
                 join( " ", map { $store->deparse_action( $_ ) } @$actions );
   }

   return @ret;
}

sub run
{
   my $self = shift;
   my ( $event ) = @_;

   my $store = $self->{store};

   RULE: foreach my $rule ( @{ $self->{rules} } ) {
      my ( $conds, $actions ) = @$rule;

      my $results = Circle::Rule::Resultset->new();

      foreach my $cond ( @$conds ) {
         $store->eval_cond( $cond, $event, $results )
            or next RULE;
      }

      # We've got this far - run the actions

      foreach my $action ( @$actions ) {
         # TODO: Consider eval{} wrapping
         $store->eval_action( $action, $event, $results );
      }

      # All rules are independent - for now at least
   }
}

0x55AA;