[libio-all-perl] 07/14: export chain and option accessors

[Axel Beckert]

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

abe pushed a commit to tag alt-io-all-new-0.00
in repository libio-all-perl.

commit a923b961d513738c621a19b7c6b7429ab8f08c7f
Author: Ingy döt Net <ingy at ingy.net>
Date:   Mon Jul 16 00:50:20 2012 -0700

    export chain and option accessors
---
 lib/IO/All/OO.pm | 30 +++++++++++++++++++++++++++++-
 1 file changed, 29 insertions(+), 1 deletion(-)

diff --git a/lib/IO/All/OO.pm b/lib/IO/All/OO.pm
index fdcd1e9..fb87831 100644
--- a/lib/IO/All/OO.pm
+++ b/lib/IO/All/OO.pm
@@ -12,8 +12,36 @@ package IO::All::OO;
 #   Mo::Inline version 0.31
 no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{bless{@_[1..$#_]},$_[0]};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for at _;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};$m=$o{$_}->($m,$n, at _)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($ [...]
 
+our @EXPORT = qw(chain option);
+
+sub option {
+    my $package = caller;
+    my ($field, $default) = @_;
+    $default ||= 0;
+    field("_$field", $default);
+    no strict 'refs';
+    *{"${package}::$field"} =
+      sub {
+          my $self = shift;
+          *$self->{"_$field"} = @_ ? shift(@_) : 1;
+          return $self;
+      };
+}
+
 sub chain {
-    die 42;
+    my $package = caller;
+    my ($field, $default) = @_;
+    no strict 'refs';
+    *{"${package}::$field"} =
+      sub {
+          my $self = shift;
+          if (@_) {
+              *$self->{$field} = shift;
+              return $self;
+          }
+          return $default unless exists *$self->{$field};
+          return *$self->{$field};
+      };
 }
 
 1;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libio-all-perl.git