r41340 - in /branches/upstream/libnet-managesieve-perl/current: Changes META.yml SIGNATURE lib/Net/ManageSieve.pm
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Aug 5 02:37:42 UTC 2009
Author: jawnsy-guest
Date: Wed Aug 5 02:37:34 2009
New Revision: 41340
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41340
Log:
[svn-upgrade] Integrating new upstream version, libnet-managesieve-perl (0.08)
Modified:
branches/upstream/libnet-managesieve-perl/current/Changes
branches/upstream/libnet-managesieve-perl/current/META.yml
branches/upstream/libnet-managesieve-perl/current/SIGNATURE
branches/upstream/libnet-managesieve-perl/current/lib/Net/ManageSieve.pm
Modified: branches/upstream/libnet-managesieve-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-managesieve-perl/current/Changes?rev=41340&op=diff
==============================================================================
--- branches/upstream/libnet-managesieve-perl/current/Changes (original)
+++ branches/upstream/libnet-managesieve-perl/current/Changes Wed Aug 5 02:37:34 2009
@@ -1,4 +1,14 @@
Revision history for Perl extension Net::ManageSieve.
+
+0.08 Tue Aug 4 13:56:26 CEST 2009
+ - chg: accept ucfirst options on new() constructor for all options
+ CPAN bug #48349 MDOM
+ - fix: documentation bug about to pass "tls" to IO::Socket
+
+0.07 Tue Aug 4 13:56:26 CEST 2009
+ - add: on_fail option for constructor
+ CPAN bug #48286 Mario Domgoergen
+ - fix: missing call to _set_error() when TLS fails
0.06 Wed Oct 29 08:33:41 CET 2008
- fix: empty token is treated as error in _response()
Modified: branches/upstream/libnet-managesieve-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-managesieve-perl/current/META.yml?rev=41340&op=diff
==============================================================================
--- branches/upstream/libnet-managesieve-perl/current/META.yml (original)
+++ branches/upstream/libnet-managesieve-perl/current/META.yml Wed Aug 5 02:37:34 2009
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Net-ManageSieve
-version: 0.06
+version: 0.08
version_from: lib/Net/ManageSieve.pm
installdirs: site
requires:
Modified: branches/upstream/libnet-managesieve-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-managesieve-perl/current/SIGNATURE?rev=41340&op=diff
==============================================================================
--- branches/upstream/libnet-managesieve-perl/current/SIGNATURE (original)
+++ branches/upstream/libnet-managesieve-perl/current/SIGNATURE Wed Aug 5 02:37:34 2009
@@ -15,15 +15,15 @@
Hash: SHA1
SHA1 9b1e6ccab9aae1f3abbc00a8bbc1a948c92d7dca COPYING
-SHA1 aade5e4798781e14fdffdddaadfb0894b8cd7253 Changes
+SHA1 a28bc0e489c4189da665ad846946ba1132cfaf09 Changes
SHA1 dcaa0c0dc2cbd898152fb57a8b3e1747fd857504 LICENSE
SHA1 a2e4e1d7b15aa75d31c28d4dd3721deaacf5215d MANIFEST
SHA1 f6aafb59d1c051fde474599535891fc5e49bc31b MANIFEST.SKIP
-SHA1 03a317d348a19e5ce03418ef9f55e951909f04f0 META.yml
+SHA1 4f7f8b2a9ecbd0d62c5becc542f6e2a46fb4260c META.yml
SHA1 60083cedbf92adea30b31c96c1fa07005f5ca52f Makefile.PL
SHA1 4761910f6e1d95d00a89008dff894a94fc77731a README
SHA1 b810608c247c68111eb2d95d809116e7d6548c92 TODO
-SHA1 11f8265130da9b5e6b57a64adba8951700ec60f0 lib/Net/ManageSieve.pm
+SHA1 7d12e72dd87ad89e20f22f4d2939e45e6834324a lib/Net/ManageSieve.pm
SHA1 e1fd5931b8c313a295550da26b7914f4fd4c05bc managesieve-test-account.sample
SHA1 e84b212ac2a465c56266c9bb2d3b1f8016ac4b21 t/00-signature.t
SHA1 4bd8d2b8ee556deb6c6151bf7108c731e8004919 t/Net-ManageSieve.t
@@ -32,11 +32,11 @@
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.6 (GNU/Linux)
-iQEVAwUBSQgbbzLh+Gx9F1xpAQKoHgf+It1RSOPBDuW1eJaPIW5a8FfSvTCvv3bp
-a4x+DXNhUAxde+47vvujOP8kBKpx9dOgf+ys+p/xLVlMaXhYVcKsHjeLWt8iDXVf
-dzVJkE5ctPcS+0gSQ2VTRb7u3Wk2Y5tDb9ETVLT64aFUR2t/JGueuDHB2T9EezqT
-5iJcV5/75wXFPTG4VWEQ0kwQo5xU6RhEw0Nr3TPreFDKcyLkEaY7hmN2iKj5ynMZ
-ic9DA0Smhs7wO79prjNxRZj0YCus6xQlexvOlITloSWr5lyWEadu7nhBRuEhLms6
-xjro1ORZZ1/w7IbM/34NbY1N5YHlXLBthnq5dlaT1fCfw1QMN6K0OQ==
-=t880
+iQEVAwUBSngsajLh+Gx9F1xpAQJcFQf/UZ6fBIMGSeJwYgeJVbT5eluttMKDo3+c
+eCrxHs9H43FyFndPmZ9StI+m3sHqJwlZ/i0OSuH347GwvcJbovAlQZ8HtAMvarm4
+Fd3YbazLfkblTsefFM78XsPECoH+xykCqoIxBw/Kh6q0WW+PWEQZjeNIFsSp31Uw
+sMQmEAaEQJtZ4k/n0SlMllaXJmyNcFFssqgalG0vB28U9MuirZUM8iU9r+iRwTdJ
+Nhw/uc5RT7XIxhVWx4FG4a4HTW0uQBqStdCQAmaQZC5mHy8AXTD0mqJH5bXO0QL2
+zEcZjQBe1Qq0yNnKog+WrW5mbEPHz8UA5Dm4VOI0Php8QwhyiBAhHA==
+=O20p
-----END PGP SIGNATURE-----
Modified: branches/upstream/libnet-managesieve-perl/current/lib/Net/ManageSieve.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-managesieve-perl/current/lib/Net/ManageSieve.pm?rev=41340&op=diff
==============================================================================
--- branches/upstream/libnet-managesieve-perl/current/lib/Net/ManageSieve.pm (original)
+++ branches/upstream/libnet-managesieve-perl/current/lib/Net/ManageSieve.pm Wed Aug 5 02:37:34 2009
@@ -62,6 +62,48 @@
, "\n";
$sieve->logout;
+=head1 ERROR HANDLING
+
+By default all functions return C<undef> on failure and set an
+error description into C<$@>, which can be retrieved with the
+method C<error()> as well.
+
+The constructor accepts the setting C<on_fail>, which alters this
+behaviour by changing the step to assign C<$@>:
+If its value is:
+
+=over 4
+
+=item C<warn>
+
+the program carps the error description.
+
+If C<debug> is enabled, too, the description is printed twice.
+
+=item C<die>
+
+the program croaks.
+
+=item is a CODE ref
+
+this subroutine is called with the arguments:
+
+ &code_ref ( $object, $error_message )
+
+The return value controls, whether or not the error message will be
+assigned to C<$@>. Private functions may just signal that an error
+occured, but keep C<$@> unchanged. In this case C<$@> remains unchanged,
+if code_ref returns true.
+
+I<Note>: Even if the code ref returns false, C<$@> might bi clobberred
+by called modules. This is especially true in the C<new()> constructor.
+
+=item otherwise
+
+the default behaviour is retained by setting C<$@>.
+
+=back
+
=cut
require 5.001;
@@ -73,7 +115,7 @@
use IO::Socket;
use Encode;
-$VERSION = "0.06";
+$VERSION = "0.08";
@ISA = qw();
@@ -107,14 +149,19 @@
B<Port> - Select a port on the remote host to connect to (default is 2000)
B<Debug> or B<debug> - enable debugging if true (default OFF)
+
+I<Note>: All of the above options are passed through to L<IO::Socket::INET>.
B<tls> - issue STARTTLS right after connect. If B<tls> is a HASH ref,
the mode is in member C<mode>, otherwise C<tls> itself is the mode and
an empty SSL option HASH is passed to L<starttls()>. The C<mode> may be
one of C<require> to fail, if TLS negotiation fails, or C<auto>,
C<on> or C<yes>, if TLS is to attempt, but a failure is ignored.
-
-I<Note>: All options are passed through to L<IO::Socket::INET>.
+(Aliases: B<TLS>, B<Tls>)
+
+B<on_fail> - Changes the error handling of all functions that would
+otherwise return undef and set C<$@>. See section ERROR HANDLING
+(Aliases: B<On_fail>)
Example:
@@ -183,6 +230,8 @@
$self->{_last_error} = '';
$self->{_last_command} = '';
$self->{_debug} = 1 if $arg{Debug} || $arg{debug};
+ $self->{_on_fail} = delete $arg{on_fail} || delete $arg{On_fail};
+ $self->{_tls} = delete $arg{tls} || delete $arg{Tls} || delete $arg{TLS};
foreach my $h (@{ref($host) ? $host : [ $host ]}) {
$arg{PeerAddr} = $h;
@@ -192,7 +241,12 @@
}
}
- return undef unless defined $self->{host};
+ unless(defined $self->{host}) {
+ my $err = $@;
+ $err = 'failed to connect to host(s): '.$! unless defined $err;
+ $self->_set_error($err);
+ return undef;
+ }
$self->{fh}->autoflush(1);
@@ -201,7 +255,7 @@
return undef unless $self->ok($cap);
$self->_decodeCap($cap);
- if(my $mode = $arg{tls}) {
+ if(my $mode = $self->{_tls}) {
my $tls;
if(ref($mode) eq 'HASH') {
$tls = $mode;
@@ -214,11 +268,8 @@
my $rc = $self->starttls(%$tls);
if(!$rc && $mode eq 'require') {
my $err = $@;
- unless($err) {
- $self->_set_error('Failed to enable TLS');
- } else {
- $@ = $err;
- }
+ $err = 'unknown error' unless defined $err;
+ $self->_set_error('failed to enable TLS: '.$err);
return undef;
}
}
@@ -230,10 +281,11 @@
=head1 METHODS
Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, failure will be returned as I<undef> or an
-empty list. The error is specified in C<$@> and can be returned with the
-L</error> method.
+value, with I<true> meaning that the operation was a success. When
+a method states that it returns a value, failure will be returned as
+I<undef> or an empty list. The error is specified in C<$@> and can be
+returned with the L</error> method. Please see section ERROR HANDLING
+for an alternative error handling scheme.
=over 4
@@ -281,9 +333,9 @@
# Initiate TLS
unless(defined &IO::Socket::SSL::new) {
- eval " require IO::Socket::SSL ";
+ eval { require IO::Socket::SSL };
if($@) {
- $self->_set_error('Cannot find module IO::Socket::SSL', 'skipAd');
+ $self->_set_error('cannot find module IO::Socket::SSL', 'skipAd');
return undef;
}
}
@@ -324,11 +376,11 @@
sub _encrypted {
my $fh = $_[0]->{fh};
unless($fh) {
- $_[0]->_set_error('No connection opened');
+ $_[0]->_set_error('no connection opened');
return undef;
}
unless(encrypted($_[0])) {
- $_[0]->_set_error('Connection not encrypted');
+ $_[0]->_set_error('connection not encrypted');
return undef;
}
return $fh;
@@ -369,7 +421,7 @@
unless(defined &MIME::Base64::encode_base64) { # Automatically load it
eval { require MIME::Base64; };
if($@) {
- $self->_set_error('Failed to load MIME::Base64: ' . $@);
+ $self->_set_error('failed to load MIME::Base64: ' . $@);
return undef;
}
}
@@ -388,7 +440,7 @@
unless(defined &Authen::SASL::new) { # Automatically load it
eval { require Authen::SASL; };
if($@) {
- $self->_set_error("Failed to load Authen::SASL: $@\nFallback to PLAIN\n");
+ $self->_set_error("failed to load Authen::SASL: $@\nFallback to PLAIN\n");
$doSASL = undef;
}
}
@@ -399,7 +451,7 @@
# $sasl->mechanism($mech);
} else {
unless(length $username) {
- $self->_set_error("Need username or Authen::SASL object");
+ $self->_set_error("need username or Authen::SASL object");
return undef;
}
# for unknown reason to pass in a space
@@ -460,7 +512,7 @@
$self->_set_error('SASL authentification failed');
return undef;
}
- $self->_set_error("Start of SASL failed");
+ $self->_set_error("start of SASL failed");
# Circumvent SASL problems by falling back to plain PLAIN
}
}
@@ -682,8 +734,10 @@
=begin COMMENT
-arg1 :- error string
+arg1 :- error string, always != undef
arg2 :- if passed, but not true: DO NOT assign $@
+
+See ERROR HANDLING about C<_on_fail>
=end COMMENT
@@ -692,11 +746,19 @@
sub _set_error {
my ($self, $err, $Ad) = @_;
- if($err) {
- dbgPrint('ERROR:', $err) if $self->{_debug};
- $self->{_last_error} = $err;
- $@ = $err if !defined $Ad || $Ad;
- }
+ dbgPrint('ERROR:', $err) if $self->{_debug};
+ $self->{_last_error} = $err;
+ my $assignAd = !defined $Ad || $Ad;
+ my $op = $self->{_on_fail} if exists $self->{_on_fail};
+ if(defined($op) && ref($op) eq 'CODE') {
+ $assignAd &&= $op->($self, $err);
+ } elsif(defined($op) && $op eq 'warn') {
+ Carp::carp $err;
+ } elsif(defined($op) && $op eq 'die') {
+ Carp::croak $err."\n";
+ # } else {
+ }
+ $@ = $err if $assignAd;
return $self;
}
@@ -778,7 +840,7 @@
}
if($name =~ /[\0\r\n]/) {
- $self->_set_error("Invalid character in name");
+ $self->_set_error("invalid character in name");
return undef;
}
@@ -826,7 +888,7 @@
$cmt ||= $c;
unless($c =~ /\A(OK|NO|BYE)\b/i) {
- $self->_set_error("Invalid response: $cmt");
+ $self->_set_error("invalid response: $cmt");
return undef;
}
return $c if uc($1) eq 'OK'
@@ -841,7 +903,7 @@
my $fh = $self->{fh};
unless($fh) {
- $self->_set_error("No connection open");
+ $self->_set_error("no connection open");
return undef;
}
@@ -913,7 +975,7 @@
my $fh = $self->{fh};
unless($fh) {
- $self->_set_error("No connection open");
+ $self->_set_error("no connection open");
return undef;
}
@@ -984,7 +1046,7 @@
# so that a quoted string must not cross line boundaries
# that makes parsing easier
unless($l =~ s/\A((?:[^"\\]|\\.)*)"//) {
- $self->_set_error("Missing final quote on line: $l");
+ $self->_set_error("missing final quote on line: $l");
return undef;
}
$self->_unget($l);
@@ -1013,7 +1075,7 @@
$self->_unget($l) if $l;
$l = [ "\n", $1 ];
} else {
- $self->_set_error("Invalid token: $l");
+ $self->_set_error("invalid token: $l");
return undef;
}
More information about the Pkg-perl-cvs-commits
mailing list