r45478 - in /trunk/libauthen-radius-perl: Changes Radius.pm debian/changelog

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Thu Oct 8 13:47:43 UTC 2009


Author: jawnsy-guest
Date: Thu Oct  8 13:47:38 2009
New Revision: 45478

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45478
Log:
New upstream release

Modified:
    trunk/libauthen-radius-perl/Changes
    trunk/libauthen-radius-perl/Radius.pm
    trunk/libauthen-radius-perl/debian/changelog

Modified: trunk/libauthen-radius-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libauthen-radius-perl/Changes?rev=45478&op=diff
==============================================================================
--- trunk/libauthen-radius-perl/Changes (original)
+++ trunk/libauthen-radius-perl/Changes Thu Oct  8 13:47:38 2009
@@ -1,4 +1,7 @@
 Revision history for Perl extension Radius.
+
+0.15 Mon Oct 05 12:00:00 2009
+	- Bugfixes in error handling
 
 0.14 Mon Aug 17 15:00:00 2009
 	- Authen::Radius is now distributed under the Perl Artistic
@@ -15,8 +18,8 @@
 
 0.12 Fri Dec 17 19:00:00 2004
     - Include the default set of radius dictionaries with the module,
-		so it can be used on the generic system without having to install
-		extra components from the RADIUS server.
+		so it can be used on the generic system without having to
+		install extra components from the RADIUS server.
 
 0.11 Mon Mar 22 22:51:00 2004
 	- Fixed incorrect constant definition for ACCESS_REJECT 

Modified: trunk/libauthen-radius-perl/Radius.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libauthen-radius-perl/Radius.pm?rev=45478&op=diff
==============================================================================
--- trunk/libauthen-radius-perl/Radius.pm (original)
+++ trunk/libauthen-radius-perl/Radius.pm Thu Oct  8 13:47:38 2009
@@ -12,7 +12,7 @@
 # See the file 'Changes' in the distrution archive.                         #
 #                                                                           #
 #############################################################################
-# 	$Id: Radius.pm,v 1.20 2009/07/23 12:27:46 psv Exp $
+# 	$Id: Radius.pm,v 1.21 2009/09/02 11:27:29 psv Exp $
 
 package Authen::Radius;
 
@@ -32,11 +32,11 @@
 @EXPORT = qw(ACCESS_REQUEST ACCESS_ACCEPT ACCESS_REJECT
 			 ACCOUNTING_REQUEST ACCOUNTING_RESPONSE ACCOUNTING_STATUS
 			DISCONNECT_REQUEST);
-$VERSION = '0.14';
+$VERSION = '0.15';
 
 my (%dict_id, %dict_name, %dict_val, %dict_vendor_id, %dict_vendor_name );
 my ($request_id) = $$ & 0xff;	# probably better than starting from 0
-my ($radius_error) = 'ENONE';
+my ($radius_error, $error_comment) = ('ENONE', '');
 my $debug = 0;
 
 #
@@ -93,7 +93,7 @@
 				Type => SOCK_DGRAM,
 				Proto => 'udp',
 				TimeOut => $self->{'timeout'}
-	) or return $self->set_error('ESOCKETFAIL');
+	) or return $self->set_error('ESOCKETFAIL', $@);
 
 	$self;
 }
@@ -120,7 +120,7 @@
 		print STDERR "Sending request:\n";
 		print STDERR HexDump($data);
 	}
-	$self->{'sock'}->send($data) || $self->set_error('ESENDFAIL');
+	$self->{'sock'}->send($data) || $self->set_error('ESENDFAIL', $!);
 }
 
 sub recv_packet {
@@ -130,9 +130,9 @@
 	$self->set_error;
 
 	$sh = new IO::Select($self->{'sock'}) or return $self->set_error('ESELECTFAIL');
-	$sh->can_read($self->{'timeout'}) or return $self->set_error('ETIMEOUT');
-
-	$self->{'sock'}->recv ($data, 65536) or return $self->set_error('ERECVFAIL');
+	$sh->can_read($self->{'timeout'}) or return $self->set_error('ETIMEOUT', $!);
+
+	$self->{'sock'}->recv ($data, 65536) or return $self->set_error('ERECVFAIL', $!);
 	if ($debug) {
 		print STDERR "Received response:\n";
 		print STDERR HexDump($data);
@@ -397,17 +397,21 @@
 }
 
 sub set_error {
-	my ($self, $error) = @_;
-
-	$radius_error = $self->{'error'} = defined $error ? $error : 'ENONE';
-
+	my ($self, $error, $comment) = @_;
+    $@ = undef;
+	$radius_error = $self->{'error'} = (defined($error) ? $error : 'ENONE');
+    $error_comment = $self->{'error_comment'} = (defined($comment) ? $comment : '');
 	undef;
 }
 
 sub get_error {
 	my ($self) = @_;
 
-	$self->{'error'};
+    if (!ref($self)) {
+	    return $radius_error;
+    } else {
+    	return $self->{'error'};
+    }
 }
 
 sub strerror {
@@ -426,10 +430,21 @@
 		'EBADID',	'response to unknown request'
 	);
 
-	return $errors{$radius_error} unless ref($self);
-	$errors{defined $error ? $error : $self->{'error'}};
-}
-
+    if (!ref($self)) {
+	    return $errors{$radius_error};
+    }
+	return $errors{ (defined($error) ? $error : $self->{'error'} ) };
+}
+
+sub error_comment {
+	my ($self) = @_;
+
+    if (!ref($self)) {
+	    return $error_comment;
+    } else {
+    	return $self->{'error_comment'};
+    }
+}
 
 1;
 __END__
@@ -569,6 +584,11 @@
 Returns a verbose error string for the last error for the current object, or
 for the specified C<ERRORCODE>.
 
+=item error_comment
+
+Returns the last error explanation for the current object. Error explanation 
+is generated by system call.
+
 =back
 
 =head1 AUTHOR

Modified: trunk/libauthen-radius-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libauthen-radius-perl/debian/changelog?rev=45478&op=diff
==============================================================================
--- trunk/libauthen-radius-perl/debian/changelog (original)
+++ trunk/libauthen-radius-perl/debian/changelog Thu Oct  8 13:47:38 2009
@@ -1,3 +1,9 @@
+libauthen-radius-perl (0.15-1) UNRELEASED; urgency=low
+
+  * New upstream release
+
+ -- Jonathan Yu <jawnsy at cpan.org>  Thu, 08 Oct 2009 06:08:10 -0400
+
 libauthen-radius-perl (0.14-1) unstable; urgency=low
 
   [ gregor herrmann ]




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