r19682 - in /trunk/libnet-sieve-script-perl: Changes META.yml Todo debian/changelog debian/control lib/Net/Sieve/Script.pm t/001_load_script.t t/002_write_script.t
yvesago-guest at users.alioth.debian.org
yvesago-guest at users.alioth.debian.org
Thu May 8 10:20:56 UTC 2008
Author: yvesago-guest
Date: Thu May 8 10:20:55 2008
New Revision: 19682
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=19682
Log:
* sync with upstream 0.07
* clean debian/control, shorteri, fix typo in relational RFC
Modified:
trunk/libnet-sieve-script-perl/Changes
trunk/libnet-sieve-script-perl/META.yml
trunk/libnet-sieve-script-perl/Todo
trunk/libnet-sieve-script-perl/debian/changelog
trunk/libnet-sieve-script-perl/debian/control
trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.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=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/Changes (original)
+++ trunk/libnet-sieve-script-perl/Changes Thu May 8 10:20:55 2008
@@ -1,4 +1,9 @@
Revision history for Perl module Net::Sieve::Script
+
+0.07 Thu, 08 May 2008 09:41:35 +0200
+ - pod clean up
+ - add script->reorder_rules method and tests
+ - clean bug $object masks earlier declaration in same scope at t/001_load_script.t line 25
0.06 Tue, 6 May 2008 20:20:04 +0200
- add copyright
Modified: trunk/libnet-sieve-script-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/META.yml?rev=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/META.yml (original)
+++ trunk/libnet-sieve-script-perl/META.yml Thu May 8 10:20:55 2008
@@ -19,4 +19,4 @@
Class::Accessor::Fast: 0.3
perl: 5.6.0
tests: t/*.t
-version: 0.06
+version: 0.07
Modified: trunk/libnet-sieve-script-perl/Todo
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/Todo?rev=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/Todo (original)
+++ trunk/libnet-sieve-script-perl/Todo Thu May 8 10:20:55 2008
@@ -14,4 +14,4 @@
* vrfy RFC for match/case order
* more tests case
- manage comment rules
-- add rules_changeorder method
+* add rules_changeorder method
Modified: trunk/libnet-sieve-script-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sieve-script-perl/debian/changelog?rev=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/debian/changelog (original)
+++ trunk/libnet-sieve-script-perl/debian/changelog Thu May 8 10:20:55 2008
@@ -1,4 +1,4 @@
-libnet-sieve-script-perl (0.06-1) unstable; urgency=low
+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=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/debian/control (original)
+++ trunk/libnet-sieve-script-perl/debian/control Thu May 8 10:20:55 2008
@@ -15,10 +15,8 @@
Architecture: all
Depends: ${perl:Depends}, ${misc:Depends}, libclass-accessor-perl (>= 0.3)
Description: Parse and write sieve scripts
- Net::Sieve::Script provides a way to read and parse sieve file script,
+ Net::Sieve::Script provides a way to read, parse and write sieve file script,
with access to Rule, Action and Condition objects.
.
- Write sieve script.
- .
- Support for RFC 5228 - sieve base, RFC 5231 - relationnal, RFC 5230 -
+ Support for RFC 5228 - sieve base, RFC 5231 - relational, RFC 5230 -
vacation, Draft regex.
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=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.pm (original)
+++ trunk/libnet-sieve-script-perl/lib/Net/Sieve/Script.pm Thu May 8 10:20:55 2008
@@ -5,7 +5,7 @@
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
- $VERSION = '0.06';
+ $VERSION = '0.07';
@ISA = qw(Exporter);
#Give a hoot don't pollute, do not export more than needed by default
@EXPORT = qw(_strip);
@@ -23,36 +23,36 @@
=head1 SYNOPSIS
use Net::Sieve::Script;
-
+
my $test_script = 'require "fileinto";
# Place all these in the "Test" folder
if header :contains "Subject" "[Test]" {
fileinto "Test";
}';
-
+
my $script = Net::Sieve::Script->new ($test_script);
-
+
print "OK" if ( $script->parsing_ok ) ;
-
+
print $script->write_script;
or
my $script = Net::Sieve::Script->new();
-
+
my $cond = Net::Sieve::Script::Condition->new('header');
$cond->match_type(':contains');
$cond->header_list('"Subject"');
$cond->key_list('"Re: Test2"');
-
+
my $actions = 'fileinto "INBOX.test"; stop;';
-
+
my $rule = Net::Sieve::Script::Rule->new();
$rule->add_condition($cond);
$rule->add_action($actions);
-
+
$script->add_rule($rule);
-
+
print $script->write_script;
@@ -277,6 +277,45 @@
my $mem_pr2 = $pr2->priority();
$pr2->priority($pr1->priority());
$pr1->priority($mem_pr2);
+
+ return 1;
+}
+
+=head2 reorder_rules
+
+Reorder rules with a list of number, start with 1, and with blanck separator. Usefull for ajax sort functions.
+
+Thank you jeanne for your help in brain storming.
+
+Return 1 on success, 0 on error
+
+=cut
+
+sub reorder_rules
+{
+ my $self = shift;
+ my $list = shift;
+
+ return 0 if ( ! $list );
+
+ my @swap = split ' ',$list;
+
+ return 0 if ( ! scalar @swap );
+ return 0 if ( scalar @swap != $self->max_priority );
+
+ my @new_ordered_rules;
+ foreach my $swap ( @swap ) {
+ if ($swap =~ m/\d+/) {
+ my $rule = $self->find_rule($swap);
+ push @new_ordered_rules, $rule;
+ }
+ }
+
+ my $i=1;
+ foreach my $rule (@new_ordered_rules) {
+ $rule->priority($i);
+ $i++;
+ };
return 1;
}
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=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/t/001_load_script.t (original)
+++ trunk/libnet-sieve-script-perl/t/001_load_script.t Thu May 8 10:20:55 2008
@@ -22,7 +22,7 @@
use_ok( 'Net::Sieve::Script::Condition' );
use_ok( 'Net::Sieve::Script::Action' );
-my $object = Net::Sieve::Script->new ($test_script);
+$object = Net::Sieve::Script->new ($test_script);
isa_ok ($object, 'Net::Sieve::Script');
is ($object->raw, $test_script, "set in raw for simple script");
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=19682&op=diff
==============================================================================
--- trunk/libnet-sieve-script-perl/t/002_write_script.t (original)
+++ trunk/libnet-sieve-script-perl/t/002_write_script.t Thu May 8 10:20:55 2008
@@ -1,4 +1,4 @@
-use Test::More tests => 35;
+use Test::More tests => 46;
use strict;
use lib qw(lib);
@@ -21,6 +21,7 @@
}
#print $script->write_script;
+#exit;
isa_ok($script->find_rule(2),'Net::Sieve::Script::Rule');
ok ($script->swap_rules(3,2),"swap rules 3,2");
@@ -103,3 +104,26 @@
#print $Rules[3]->write."\n";
#print "======\n";
#print $script3->write_script;
+for my $i (1..4) {
+ $Rules[$i] = Net::Sieve::Script::Rule->new(
+ test_list => 'header :contains "Subject" "[Test'.$i.']"' ,
+ block => 'fileinto "Test'.$i.'"'
+ );
+ ok ($script->add_rule($Rules[$i]), "add rule $i");
+};
+
+#print $script->write_script;
+
+my $reorder_list="1 4 2 3";
+ok( $script->reorder_rules($reorder_list), "success on reorder_rules");
+
+my $new_rule = $script->find_rule(2);
+is ($new_rule->write_condition,'header :contains "Subject" "[Test4]"','Rule 4 on priority 2');
+
+ $new_rule = $script->find_rule(3);
+is ($new_rule->write_condition,'header :contains "Subject" "[Test2]"','Rule 2 on priority 3');
+
+is ($script->reorder_rules(), 0, "missing reorder list");
+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");
More information about the Pkg-perl-cvs-commits
mailing list