| Subject: | RFI: Equals methods and exists syntax (patch attached |
Request for Improvement:
"Exists" syntax as a condition
+ # RFC Syntax : exists <header-names: string-list>
+ if ( $test eq 'exists' ) {
+ ($string) = $args =~ m/@LISTS$/gi;
+ }
Equals methods on the objects. Specifically Action, Condition and Rule
Patch attached.
Mark
| Subject: | equals-exists.diff |
Index: Sieve/Script.pm
===================================================================
--- Sieve/Script.pm (revision 40)
+++ Sieve/Script.pm (revision 50)
@@ -172,6 +172,52 @@
return $require_line.$text;
}
+sub equals {
+ my $self = shift;
+ my $object = shift;
+
+ return 0 unless (defined $object);
+ return 0 unless ($object->isa('Net::Sieve::Script'));
+
+ my @accessors = qw( require );
+
+ foreach my $accessor ( @accessors ) {
+ my $myvalue = $self->$accessor;
+ my $theirvalue = $object->$accessor;
+ if (defined $myvalue) {
+ return 0 unless (defined $theirvalue);
+ return 0 unless ($myvalue eq $theirvalue);
+ } else {
+ return 0 if (defined $theirvalue);
+ }
+ }
+
+ if (defined $self->rules) {
+ my @myrules = sort { $a->priority() <=> $b->priority() } @{$self->rules()};
+ my @theirrules = sort { $a->priority() <=> $b->priority() } @{$object->rules()} ;
+ return 0 unless ($#myrules == $#theirrules);
+
+ unless ($#myrules == -1) {
+ foreach my $index (0..$#myrules) {
+ my $myrule = $myrules[$index];
+ my $theirrule = $theirrules[$index];
+ if (defined ($myrule)) {
+ return 0 unless ($myrule->isa(
+ 'Net::Sieve::Script::Rule'));
+ return 0 unless ($myrule->equals($theirrule));
+ } else {
+ return 0 if (defined ($theirrule));
+ }
+ }
+ }
+
+ } else {
+ return 0 if (defined ($object->rules));
+ }
+ return 1;
+}
+
+
=head2 read_rules
$script->read_rules() : read rules from raw
Index: Sieve/Script/Condition.pm
===================================================================
--- Sieve/Script/Condition.pm (revision 40)
+++ Sieve/Script/Condition.pm (revision 50)
@@ -6,7 +6,7 @@
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
__PACKAGE__->mk_accessors(qw(test not id condition parent AllConds key_list header_list address_part match_type comparator require));
@@ -138,6 +138,10 @@
if ( $test eq 'size' ) {
($match,$string) = $args =~ m/@MATCH_SIZE(.*)$/gi;
};
+ # RFC Syntax : exists <header-names: string-list>
+ if ( $test eq 'exists' ) {
+ ($string) = $args =~ m/@LISTS$/gi;
+ }
# find require
if (lc($match) eq ':regex ') {
push @{$require}, 'regex';
@@ -155,6 +159,57 @@
return $self;
}
+sub equals {
+ my $self = shift;
+ my $object = shift;
+
+ return 0 unless (defined $object);
+ return 0 unless ($object->isa('Net::Sieve::Script::Condition'));
+
+ # Should we test "id" ? Probably not it's internal to the
+ # representaion of this object, and not a part of what actually makes
+ # it a sieve "condition"
+
+ my @accessors = qw( test not address_part match_type comparator require key_list header_list address_part );
+
+ foreach my $accessor ( @accessors ) {
+ my $myvalue = $self->$accessor;
+ my $theirvalue = $object->$accessor;
+ if (defined $myvalue) {
+ return 0 unless (defined $theirvalue);
+ return 0 unless ($myvalue eq $theirvalue);
+ } else {
+ return 0 if (defined $theirvalue);
+ }
+ }
+
+ if (defined $self->condition) {
+ my $tmp = $self->condition;
+ my @myconds = @$tmp;
+ $tmp = $object->condition;
+ my @theirconds = @$tmp;
+ return 0 unless ($#myconds == $#theirconds);
+
+ unless ($#myconds == -1) {
+ foreach my $index (0..$#myconds) {
+ my $mycond = $myconds[$index];
+ my $theircond = $theirconds[$index];
+ if (defined ($mycond)) {
+ return 0 unless ($mycond->isa(
+ 'Net::Sieve::Script::Condition'));
+ return 0 unless ($mycond->equals($theircond));
+ } else {
+ return 0 if (defined ($theircond));
+ }
+ }
+ }
+
+ } else {
+ return 0 if (defined ($object->condition));
+ }
+ return 1;
+}
+
# see head2 write
sub write {
Index: Sieve/Script/Rule.pm
===================================================================
--- Sieve/Script/Rule.pm (revision 40)
+++ Sieve/Script/Rule.pm (revision 50)
@@ -97,6 +97,66 @@
return $self;
}
+sub equals {
+ my $self = shift;
+ my $object = shift;
+
+ return 0 unless (defined $object);
+ return 0 unless ($object->isa('Net::Sieve::Script::Rule'));
+
+ # Should we test "id" ? Probably not it's internal to the
+ # representaion of this object, and not a part of what actually makes
+ # it a sieve "condition"
+
+ my @accessors = qw( alternate require );
+
+ foreach my $accessor ( @accessors ) {
+ my $myvalue = $self->$accessor;
+ my $theirvalue = $object->$accessor;
+ if (defined $myvalue) {
+ return 0 unless (defined $theirvalue);
+ return 0 unless ($myvalue eq $theirvalue);
+ } else {
+ return 0 if (defined $theirvalue);
+ }
+ }
+
+ if ( defined $self->conditions ) {
+ return 0 unless ($self->conditions->isa(
+ 'Net::Sieve::Script::Condition'));
+ return 0 unless ($self->conditions->equals($object->conditions));
+ } else {
+ return 0 if (defined $object->conditions ) ;
+ }
+
+ if (defined $self->actions) {
+ my $tmp = $self->actions;
+ my @myactions = @$tmp;
+ $tmp = $object->actions;
+ my @theiractions = @$tmp;
+ return 0 unless ($#myactions == $#theiractions);
+
+ unless ($#myactions == -1) {
+ foreach my $index (0..$#myactions) {
+ my $myaction = $myactions[$index];
+ my $theiraction = $theiractions[$index];
+ if (defined ($myaction)) {
+ return 0 unless ($myaction->isa(
+ 'Net::Sieve::Script::Action'));
+ return 0 unless ($myaction->equals($theiraction));
+ } else {
+ return 0 if (defined ($theiraction));
+ }
+ }
+ }
+
+ } else {
+ return 0 if (defined ($object->actions));
+ }
+
+ return 1;
+}
+
=head1 METHODS
=head2 write
Index: Sieve/Script/Action.pm
===================================================================
--- Sieve/Script/Action.pm (revision 40)
+++ Sieve/Script/Action.pm (revision 50)
@@ -36,6 +36,29 @@
return $self;
}
+sub equals {
+ my $self = shift;
+ my $object = shift;
+
+ return 0 unless (defined $object);
+ return 0 unless ($object->isa('Net::Sieve::Script::Action'));
+
+ my @accessors = qw( param command );
+
+ foreach my $accessor ( @accessors ) {
+ my $myvalue = $self->$accessor;
+ my $theirvalue = $object->$accessor;
+ if (defined $myvalue) {
+ return 0 unless (defined $theirvalue);
+ return 0 unless ($myvalue eq $theirvalue);
+ } else {
+ return 0 if (defined $theirvalue);
+ }
+ }
+ return 1;
+}
+
+
=head1 NAME
Net::Sieve::Script::Action - parse and write actions in sieve scripts