[libnet-openid-common-perl] 03/07: create URIFetch::Response accessors from list

gregor herrmann gregoa at debian.org
Sun Feb 7 21:50:32 UTC 2016


This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to annotated tag v1.13
in repository libnet-openid-common-perl.

commit 419925b0eca368307895d34d78e4b328381003e8
Author: Roger Crew <crew at cs.stanford.edu>
Date:   Sat Nov 5 18:09:40 2011 -0700

    create URIFetch::Response accessors from list
    
    I'm about this close to dragging in Class::Accessor::Fast
---
 lib/Net/OpenID/URIFetch.pm | 37 +++++++++++++++----------------------
 1 file changed, 15 insertions(+), 22 deletions(-)

diff --git a/lib/Net/OpenID/URIFetch.pm b/lib/Net/OpenID/URIFetch.pm
index 0f171a6..262dae4 100644
--- a/lib/Net/OpenID/URIFetch.pm
+++ b/lib/Net/OpenID/URIFetch.pm
@@ -154,32 +154,25 @@ sub fetch {
 
 package Net::OpenID::URIFetch::Response;
 
+use strict;
+use constant FIELDS => [qw(final_uri status content headers)];
+use fields @{FIELDS()};
+use Carp();
+
 sub new {
     my ($class, %opts) = @_;
-
-    my $self = {};
-    $self->{final_uri} = delete($opts{final_uri});
-    $self->{status} = delete($opts{status});
-    $self->{content} = delete($opts{content});
-    $self->{headers} = delete($opts{headers});
-
-    return bless $self, $class;
-}
-
-sub final_uri {
-    return $_[0]->{final_uri};
+    my $self = fields::new($class);
+    @{$self}{@{FIELDS()}} = delete @opts{@{FIELDS()}};
+    Carp::croak("Unknown option(s): " . join(", ", keys %opts)) if %opts;
+    return $self;
 }
 
-sub status {
-    return $_[0]->{status};
-}
-
-sub content {
-    return $_[0]->{content};
-}
-
-sub headers {
-    return $_[0]->{headers};
+BEGIN {
+    foreach my $field_name (@{FIELDS()}) {
+        no strict 'refs';
+        *{__PACKAGE__ . '::' . $field_name}
+          = sub { return $_[0]->{$field_name}; };
+    }
 }
 
 sub header {

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-openid-common-perl.git



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