r25209 - in /trunk/libnet-sieve-script-perl: ./ debian/ inc/Module/ inc/Module/Install/ lib/Net/Sieve/ lib/Net/Sieve/Script/ t/

yvesago-guest at users.alioth.debian.org yvesago-guest at users.alioth.debian.org
Tue Sep 16 13:51:13 UTC 2008


Author: yvesago-guest
Date: Tue Sep 16 13:51:09 2008
New Revision: 25209

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25209
Log:
  * New upstream release
  * Standards-Version: 3.8.0 (no changes)
  * copyright: add copyright for Module::Install inc/ files

Modified:
    trunk/libnet-sieve-script-perl/Changes
    trunk/libnet-sieve-script-perl/META.yml
    trunk/libnet-sieve-script-perl/debian/changelog
    trunk/libnet-sieve-script-perl/debian/control
    trunk/libnet-sieve-script-perl/debian/copyright
    trunk/libnet-sieve-script-perl/inc/Module/Install.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/AutoInstall.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/Base.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/Can.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/Fetch.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/Include.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/Makefile.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/Metadata.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/Win32.pm
    trunk/libnet-sieve-script-perl/inc/Module/Install/WriteAll.pm
    trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.pm
    trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Action.pm
    trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Condition.pm
    trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Rule.pm
    trunk/libnet-sieve-script-perl/t/001_load_script.t
    trunk/libnet-sieve-script-perl/t/002_write_script.t

Modified: trunk/libnet-sieve-script-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/Changes?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/Changes (original)
+++ trunk/libnet-sieve-script-perl/Changes Tue Sep 16 13:51:09 2008
@@ -1,4 +1,11 @@
 Revision history for Perl module Net::Sieve::Script
+
+0.08 Mon, 15 Sep 2008 12:48:29 +0200
+   - equals methods on Script, Action, Condition, Rule
+   - test exists
+   thanks to Mark Chappell patch on cpan RT, close RFI 39246
+   - add tests and pod for equals methods
+   - add tests for exists
 
 0.07 Thu, 08 May 2008 09:41:35 +0200
    - pod clean up

Modified: trunk/libnet-sieve-script-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/META.yml?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/META.yml (original)
+++ trunk/libnet-sieve-script-perl/META.yml Tue Sep 16 13:51:09 2008
@@ -1,11 +1,12 @@
 --- 
 abstract: Parse and write sieve scripts
-author: Yves Agostini - Univ Metz - <agostini at univ-metz.fr>
+author: 
+  - Yves Agostini - Univ Metz - <agostini at univ-metz.fr>
 build_requires: 
   Pod::Coverage: 0
   Test::More: 0
 distribution_type: module
-generated_by: Module::Install version 0.67
+generated_by: Module::Install version 0.68
 license: perl
 meta-spec: 
   url: http://module-build.sourceforge.net/META-spec-v1.3.html
@@ -19,4 +20,4 @@
   Class::Accessor::Fast: 0.3
   perl: 5.6.0
 tests: t/*.t
-version: 0.07
+version: 0.08

Modified: trunk/libnet-sieve-script-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/debian/changelog?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/debian/changelog (original)
+++ trunk/libnet-sieve-script-perl/debian/changelog Tue Sep 16 13:51:09 2008
@@ -1,3 +1,11 @@
+libnet-sieve-script-perl (0.08-1) unstable; urgency=low
+
+  * New upstream release
+  * Standards-Version: 3.8.0 (no changes)
+  * copyright: add copyright for Module::Install inc/ files
+
+ -- AGOSTINI Yves <agostini at univ-metz.fr>  Tue, 16 Sep 2008 15:45:05 +0200
+
 libnet-sieve-script-perl (0.07-1) unstable; urgency=low
 
   * Initial Release. (Closes: #479568)

Modified: trunk/libnet-sieve-script-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/debian/control?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/debian/control (original)
+++ trunk/libnet-sieve-script-perl/debian/control Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
  libtest-pod-coverage-perl, libtest-pod-perl
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: AGOSTINI Yves <agostini at univ-metz.fr>
-Standards-Version: 3.7.3
+Standards-Version: 3.8.0
 Homepage: http://search.cpan.org/dist/Net-Sieve-Script/
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libnet-sieve-script-perl/
 Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/

Modified: trunk/libnet-sieve-script-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/debian/copyright?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/debian/copyright (original)
+++ trunk/libnet-sieve-script-perl/debian/copyright Tue Sep 16 13:51:09 2008
@@ -12,6 +12,12 @@
  This program is free software; you can redistribute
  it and/or modify it under the same terms as Perl itself.
 
+Files: inc/*
+Copyright: Copyright 2002 - 2008 by Brian Ingerson, Audrey Tang and Adam Kennedy.
+License: GPL-1+ | Artistic
+ This program is free software; you can redistribute it and/or modify it under
+ the same terms as Perl itself
+
 Files: debian/*
 Copyright: Copyright 2008 Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 License: GPL-1+ | Artistic

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install.pm Tue Sep 16 13:51:09 2008
@@ -28,7 +28,7 @@
     # This is not enforced yet, but will be some time in the next few
     # releases once we can make sure it won't clash with custom
     # Module::Install extensions.
-    $VERSION = '0.67';
+    $VERSION = '0.68';
 }
 
 # Whether or not inc::Module::Install is actually loaded, the

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/AutoInstall.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/AutoInstall.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/AutoInstall.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/AutoInstall.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/Base.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/Base.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/Base.pm Tue Sep 16 13:51:09 2008
@@ -1,7 +1,7 @@
 #line 1
 package Module::Install::Base;
 
-$VERSION = '0.67';
+$VERSION = '0.68';
 
 # Suspend handler for "redefined" warnings
 BEGIN {

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/Can.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/Can.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/Can.pm Tue Sep 16 13:51:09 2008
@@ -11,7 +11,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/Fetch.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/Fetch.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/Fetch.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/Include.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/Include.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/Include.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/Include.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/Makefile.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/Makefile.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/Makefile.pm Tue Sep 16 13:51:09 2008
@@ -7,7 +7,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/Metadata.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/Metadata.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/Metadata.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/Win32.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/Win32.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/Win32.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/inc/Module/Install/WriteAll.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/inc/Module/Install/WriteAll.pm (original)
+++ trunk/libnet-sieve-script-perl/inc/Module/Install/WriteAll.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.67';
+	$VERSION = '0.68';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.pm (original)
+++ trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.pm Tue Sep 16 13:51:09 2008
@@ -5,7 +5,7 @@
 BEGIN {
     use Exporter ();
     use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-    $VERSION     = '0.07';
+    $VERSION     = '0.08';
     @ISA         = qw(Exporter);
     #Give a hoot don't pollute, do not export more than needed by default
     @EXPORT      = qw(_strip);
@@ -171,6 +171,58 @@
 
     return $require_line.$text;
 }
+
+=head2 equals
+
+ $object->equals($test_object): return 1 if $object and $test_object are equals
+
+=cut
+
+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
 

Modified: trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Action.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Action.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Action.pm (original)
+++ trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Action.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw($VERSION);
 
-$VERSION = '0.06';
+$VERSION = '0.08';
 
 __PACKAGE__->mk_accessors(qw(command param));
 
@@ -35,6 +35,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
 
@@ -78,6 +101,10 @@
 
 set param  : C<< $action->param(' :days 3 "I am away this week."') >>
 
+=head2 equals
+
+return 1 if actions are equals
+
 =head1 AUTHOR
 
 Yves Agostini - Univ Metz - <agostini at univ-metz.fr>

Modified: trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Condition.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Condition.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Condition.pm (original)
+++ trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Condition.pm Tue Sep 16 13:51:09 2008
@@ -6,7 +6,7 @@
 
 use vars qw($VERSION);
 
-$VERSION = '0.06';
+$VERSION = '0.08';
 
 __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';
@@ -153,6 +157,63 @@
 
 
     return $self;
+}
+
+# see head2 equals
+
+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); 
+            if ($accessor ne 'key_list') {
+                $theirvalue=~tr/[A-Z]/[a-z]/; 
+                $myvalue=~tr/[A-Z]/[a-z]/;
+            };
+			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
@@ -274,7 +335,7 @@
 
 Condition parts
   not          : 'not' or nothing
-  test         : 'header', 'address', ...
+  test         : 'header', 'address', 'exists', ...
   key_list     : "subject" or ["To", "Cc"]
   header_list  : "text" or ["text1", "text2"]
   address_part : ':all ', ':localpart ', ...
@@ -283,6 +344,11 @@
 
 =head1 METHODS
 
+=head2 equals
+
+ Purpose  : test conditions
+ Return   : 1 on equals conditions
+
 =head2 write
 
  Purpose  : write rule conditions in text format

Modified: trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Rule.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Rule.pm?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Rule.pm (original)
+++ trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script/Rule.pm Tue Sep 16 13:51:09 2008
@@ -5,7 +5,7 @@
 
 use vars qw($VERSION);
 
-$VERSION = '0.06';
+$VERSION = '0.08';
 
 use  Net::Sieve::Script::Action;
 use Net::Sieve::Script::Condition;
@@ -98,6 +98,73 @@
 }
 
 =head1 METHODS
+
+=head2 equals
+
+return 1 if rules are equals
+
+=cut
+
+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 );
+    my @accessors = qw( alternate );
+
+    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;
+}
 
 =head2 write
 

Modified: trunk/libnet-sieve-script-perl/t/001_load_script.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/t/001_load_script.t?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/t/001_load_script.t (original)
+++ trunk/libnet-sieve-script-perl/t/001_load_script.t Tue Sep 16 13:51:09 2008
@@ -51,6 +51,9 @@
 {
   discard;
   stop;
+}
+if not exists ["From","Date"] {
+  discard;
 }';
 
 my $test_script3 = '

Modified: trunk/libnet-sieve-script-perl/t/002_write_script.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/t/002_write_script.t?rev=25209&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/t/002_write_script.t (original)
+++ trunk/libnet-sieve-script-perl/t/002_write_script.t Tue Sep 16 13:51:09 2008
@@ -1,4 +1,4 @@
-use Test::More tests => 46;
+use Test::More tests => 47;
 use strict;
 
 use lib qw(lib);
@@ -127,3 +127,16 @@
 is ($script->reorder_rules("1,2,3"), 0, "wrong list");
 is ($script->reorder_rules("1 2 3"), 0, "missing list element");
 is ($script->reorder_rules("6 5 1 2 3"), 0, "too much list element");
+
+$script = Net::Sieve::Script->new();
+$new_rule = Net::Sieve::Script::Rule->new(
+    test_list => 'not exists ["From","Date"]',
+    block => 'fileinto "Test"'
+    );
+$script->add_rule($new_rule);
+$res_oo='require "fileinto";
+if not exists ["From", "Date"]
+    {
+    fileinto "Test";
+    }';
+is( _strip($script->write_script),_strip($res_oo),'write exists condition');




More information about the Pkg-perl-cvs-commits mailing list