diff -Nru libnet-sieve-script-perl-0.07/Changes libnet-sieve-script-perl-0.08/Changes --- libnet-sieve-script-perl-0.07/Changes 2008-05-08 09:25:23.000000000 +0100 +++ libnet-sieve-script-perl-0.08/Changes 2008-09-15 21:03:34.000000000 +0100 @@ -1,5 +1,12 @@ 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 - add script->reorder_rules method and tests diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/debian/changelog /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/debian/changelog --- libnet-sieve-script-perl-0.07/debian/changelog 2008-11-05 22:27:02.000000000 +0000 +++ libnet-sieve-script-perl-0.08/debian/changelog 2008-11-05 22:27:03.000000000 +0000 @@ -1,3 +1,17 @@ +libnet-sieve-script-perl (0.08-1) unstable; urgency=low + + [ AGOSTINI Yves ] + * New upstream release + * Standards-Version: 3.8.0 (no changes) + * copyright: add copyright for Module::Install inc/ files + + [ gregor herrmann ] + * Set debhelper compatibility level to 7; adapt + debian/{control,compat,rules}. + * debian/copyright: refresh formatting. + + -- AGOSTINI Yves Tue, 16 Sep 2008 15:45:05 +0200 + libnet-sieve-script-perl (0.07-1) unstable; urgency=low * Initial Release. (Closes: #479568) diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/debian/compat /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/debian/compat --- libnet-sieve-script-perl-0.07/debian/compat 2008-11-05 22:27:02.000000000 +0000 +++ libnet-sieve-script-perl-0.08/debian/compat 2008-11-05 22:27:03.000000000 +0000 @@ -1 +1 @@ -5 +7 diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/debian/control /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/debian/control --- libnet-sieve-script-perl-0.07/debian/control 2008-11-05 22:27:02.000000000 +0000 +++ libnet-sieve-script-perl-0.08/debian/control 2008-11-05 22:27:03.000000000 +0000 @@ -1,12 +1,12 @@ Source: libnet-sieve-script-perl Section: perl Priority: optional -Build-Depends: debhelper (>= 5) +Build-Depends: debhelper (>= 7) Build-Depends-Indep: perl (>= 5.6.0), libclass-accessor-perl (>= 0.3), libtest-pod-coverage-perl, libtest-pod-perl Maintainer: Debian Perl Group Uploaders: AGOSTINI Yves -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/ diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/debian/copyright /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/debian/copyright --- libnet-sieve-script-perl-0.07/debian/copyright 2008-11-05 22:27:02.000000000 +0000 +++ libnet-sieve-script-perl-0.08/debian/copyright 2008-11-05 22:27:03.000000000 +0000 @@ -1,23 +1,34 @@ -X-Format-Specification: http://wiki.debian.org/Proposals/CopyrightFormat -X-Debianized-By: AGOSTINI Yves -X-Debianized-Date: Mon, 05 May 2008 15:40:44 +0200 -X-Source-Downloaded-From: http://search.cpan.org/dist/Net-Sieve-Script/ -X-Upstream-Author: Yves Agostini - +Format-Specification: + http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196 +Upstream-Maintainer: Yves Agostini - +Upstream-Source: http://search.cpan.org/dist/Net-Sieve-Script/ +Upstream-Name: Net-Sieve-Script Files: * Copyright: Copyright 2008 Yves Agostini - +License-Alias: Perl +License: Artistic | GPL-1+ + +Files: inc/* +Copyright: Copyright 2002 - 2008 by Brian Ingerson, Audrey Tang and Adam Kennedy. +License-Alias: Perl License: GPL-1+ | Artistic - Copyright 2008 Yves Agostini - - . - 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 License: GPL-1+ | Artistic The Debian packaging is put under the same terms as the module itself. -Perl is distributed under your choice of the GNU General Public License or -the Artistic License. On Debian GNU/Linux systems, the complete text of the -GNU General Public License can be found in `/usr/share/common-licenses/GPL' -and the Artistic Licence in `/usr/share/common-licenses/Artistic'. +License: Artistic + This program is free software; you can redistribute it and/or modify + it under the terms of the Artistic License, which comes with Perl. + On Debian GNU/Linux systems, the complete text of the Artistic License + can be found in /usr/share/common-licenses/Artistic + +License: GPL-1+ + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + On Debian GNU/Linux systems, the complete text of the GNU General + Public License can be found in `/usr/share/common-licenses/GPL' diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/debian/rules /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/debian/rules --- libnet-sieve-script-perl-0.07/debian/rules 2008-11-05 22:27:02.000000000 +0000 +++ libnet-sieve-script-perl-0.08/debian/rules 2008-11-05 22:27:03.000000000 +0000 @@ -1,60 +1,23 @@ #!/usr/bin/make -f -# This debian/rules file is provided as a template for normal perl -# packages. It was created by Marc Brockschmidt for -# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may -# be used freely wherever it is useful. - -# Uncomment this to turn on verbose mode. -#export DH_VERBOSE=1 - -# If set to a true value then MakeMaker's prompt function will -# always return the default without waiting for user input. -export PERL_MM_USE_DEFAULT=1 - -PERL ?= /usr/bin/perl -PACKAGE = $(shell dh_listpackages) -TMP = $(CURDIR)/debian/$(PACKAGE) build: build-stamp build-stamp: - dh_testdir - $(PERL) Makefile.PL INSTALLDIRS=vendor - $(MAKE) - $(MAKE) test + dh build touch $@ clean: - dh_testdir - dh_testroot - dh_clean build-stamp install-stamp - [ ! -f Makefile ] || $(MAKE) realclean + dh $@ install: install-stamp install-stamp: build-stamp - dh_testdir - dh_testroot - dh_clean -k - $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr - [ ! -d $(TMP)/usr/lib/perl5 ] || \ - rmdir --ignore-fail-on-non-empty --parents --verbose \ - $(TMP)/usr/lib/perl5 + dh install touch $@ binary-arch: -# We have nothing to do here for an architecture-independent package -binary-indep: build install - dh_testdir - dh_testroot - dh_installdocs - dh_installchangelogs Changes - dh_perl - dh_compress - dh_fixperms - dh_installdeb - dh_gencontrol - dh_md5sums - dh_builddeb +binary-indep: install + dh $@ -binary: binary-indep binary-arch -.PHONY: build clean binary-indep binary-arch binary install +binary: binary-arch binary-indep + +.PHONY: binary binary-arch binary-indep install clean build diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/AutoInstall.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/AutoInstall.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/AutoInstall.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/AutoInstall.pm 2008-09-15 21:06:38.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/Base.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/Base.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/Base.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/Base.pm 2008-09-15 21:06:38.000000000 +0100 @@ -1,7 +1,7 @@ #line 1 package Module::Install::Base; -$VERSION = '0.67'; +$VERSION = '0.68'; # Suspend handler for "redefined" warnings BEGIN { diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/Can.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/Can.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/Can.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/Can.pm 2008-09-15 21:06:39.000000000 +0100 @@ -11,7 +11,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/Fetch.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/Fetch.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/Fetch.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/Fetch.pm 2008-09-15 21:06:39.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/Include.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/Include.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/Include.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/Include.pm 2008-09-15 21:06:38.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/Makefile.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/Makefile.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/Makefile.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/Makefile.pm 2008-09-15 21:06:39.000000000 +0100 @@ -7,7 +7,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/Metadata.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/Metadata.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/Metadata.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/Metadata.pm 2008-09-15 21:06:38.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/Win32.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/Win32.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/Win32.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/Win32.pm 2008-09-15 21:06:39.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install/WriteAll.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install/WriteAll.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install/WriteAll.pm 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install/WriteAll.pm 2008-09-15 21:06:39.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw{$VERSION $ISCORE @ISA}; BEGIN { - $VERSION = '0.67'; + $VERSION = '0.68'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/inc/Module/Install.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/inc/Module/Install.pm --- libnet-sieve-script-perl-0.07/inc/Module/Install.pm 2008-05-08 09:40:36.000000000 +0100 +++ libnet-sieve-script-perl-0.08/inc/Module/Install.pm 2008-09-15 21:06:38.000000000 +0100 @@ -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 diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script/Action.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script/Action.pm --- libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script/Action.pm 2008-05-06 20:53:29.000000000 +0100 +++ libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script/Action.pm 2008-09-15 21:03:34.000000000 +0100 @@ -6,7 +6,7 @@ use vars qw($VERSION); -$VERSION = '0.06'; +$VERSION = '0.08'; __PACKAGE__->mk_accessors(qw(command param)); @@ -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 @@ -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 - diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script/Condition.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script/Condition.pm --- libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script/Condition.pm 2008-05-06 21:03:46.000000000 +0100 +++ libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script/Condition.pm 2008-09-15 21:03:34.000000000 +0100 @@ -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 + if ( $test eq 'exists' ) { + ($string) = $args =~ m/@LISTS$/gi; + } # find require if (lc($match) eq ':regex ') { push @{$require}, 'regex'; @@ -155,6 +159,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 sub 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 diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script/Rule.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script/Rule.pm --- libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script/Rule.pm 2008-05-06 21:06:33.000000000 +0100 +++ libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script/Rule.pm 2008-09-15 21:03:34.000000000 +0100 @@ -5,7 +5,7 @@ use vars qw($VERSION); -$VERSION = '0.06'; +$VERSION = '0.08'; use Net::Sieve::Script::Action; use Net::Sieve::Script::Condition; @@ -99,6 +99,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 Return rule in text format diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script.pm /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script.pm --- libnet-sieve-script-perl-0.07/lib/Net/Sieve/Script.pm 2008-05-08 09:33:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/lib/Net/Sieve/Script.pm 2008-09-15 21:03:34.000000000 +0100 @@ -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); @@ -172,6 +172,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 $script->read_rules() : read rules from raw diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/META.yml /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/META.yml --- libnet-sieve-script-perl-0.07/META.yml 2008-05-08 09:40:37.000000000 +0100 +++ libnet-sieve-script-perl-0.08/META.yml 2008-09-15 21:06:39.000000000 +0100 @@ -1,11 +1,12 @@ --- abstract: Parse and write sieve scripts -author: Yves Agostini - Univ Metz - +author: + - Yves Agostini - Univ Metz - 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 diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/t/001_load_script.t /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/t/001_load_script.t --- libnet-sieve-script-perl-0.07/t/001_load_script.t 2008-05-08 09:39:17.000000000 +0100 +++ libnet-sieve-script-perl-0.08/t/001_load_script.t 2008-09-15 21:03:34.000000000 +0100 @@ -51,6 +51,9 @@ { discard; stop; +} +if not exists ["From","Date"] { + discard; }'; my $test_script3 = ' diff -Nru /tmp/50bZn1J8XL/libnet-sieve-script-perl-0.07/t/002_write_script.t /tmp/GM0rc7FyFL/libnet-sieve-script-perl-0.08/t/002_write_script.t --- libnet-sieve-script-perl-0.07/t/002_write_script.t 2008-05-08 09:34:39.000000000 +0100 +++ libnet-sieve-script-perl-0.08/t/002_write_script.t 2008-09-15 21:03:34.000000000 +0100 @@ -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');