Changeset 31434

Timestamp:

03/22/09 04:24:59 (4 years ago)

Author:

ktat

Message:

to use Perl6::Export::Attrs

Location:

lang/perl/Util-Any/trunk

Files:

• Changes (modified) (1 diff)
• MANIFEST (modified) (1 diff)
• lib/Util/Any.pm (modified) (5 diffs)
• t/05-util_any_base-prefix.t (added)
• t/05-util_any_base.t (added)
• t/06-perl6-export-attrs-no-args.t (added)
• t/06-perl6-export-attrs.t (added)
• t/06-perl6-export-attrs2.t (added)
• t/07-perl6-export-attrs-no-args.t (added)
• t/07-perl6-export-attrs.t (added)
• t/07-perl6-export-attrs2.t (added)
• t/lib/MyUtilBase.pm (added)
• t/lib/UtilPerl6ExportAttrs.pm (added)
• t/lib/UtilPerl6ExportAttrsBase.pm (added)

lang/perl/Util-Any/trunk/Changes

@@ -1 +1 @@
 Revision history for Util-Any
+
+0.05    2009/03/22 02:35
+        solve the problem using Util::Any with Perl6::Export::Atttrs
+        new feature to inherit Util::Any(-Base and -Perl6ExportAttrs)
 
 0.04    2008/12/14 17:34

lang/perl/Util-Any/trunk/MANIFEST

@@ -24 +24 @@
 t/04-option-select.t
 t/04-option-except.t
+t/05-util_any_base-prefix.t
+t/05-util_any_base.t
+t/06-perl6-export-attrs.t
+t/06-perl6-export-attrs2.t
+t/06-perl6-export-attrs-no-args.t
+t/07-perl6-export-attrs.t
+t/07-perl6-export-attrs2.t
+t/07-perl6-export-attrs-no-args.t
 t/lib/MyUtil.pm
+t/lib/MyUtilBase.pm
+t/lib/UtilPerl6ExportAttrs.pm
+t/lib/UtilPerl6ExportAttrsBase.pm

lang/perl/Util-Any/trunk/lib/Util/Any.pm

@@ -17 +17 @@
 sub import {
   my $pkg = shift;
+  my $caller = (caller)[0];
+
+  return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-\w+$/;
 
   no strict 'refs';
 
   my $config = ${$pkg . '::Utils'};
-  my $caller = (caller)[0];
   my %want;
   my %opt = (prefix => 0, module_prefix => 0, debug => 0);
@@ -94 +96 @@
     }
   }
+  if ($pkg->_use_perl6_export_attrs) {
+    no strict 'refs';
+    no warnings;
+    my $pkg_utils = ${$pkg . '::Utils'};
+    my @arg = defined $pkg_utils ? (grep !exists $pkg_utils->{$_}, @_)
+                                 : (grep !exists $Utils->{$_}, @_);
+    if (@_ and @arg) {
+      eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg);';
+    } elsif (!@_) {
+      eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import;';
+    }
+  }
 }
 
+sub _base_import {
+  my ($pkg, $caller, @flgs) = @_;
+  {
+    no strict 'refs';
+    push @{"${caller}::ISA"}, __PACKAGE__;
+  }
+
+  while (my $flg = shift @flgs) {
+    if (lc($flg) eq '-perl6exportattrs') {
+      eval "use Perl6::Export::Attrs ();";
+      no strict 'refs';
+      *{$caller . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
+      *{$caller . '::_use_perl6_export_attrs'} = sub { 1 };
+    }
+  }
+}
+
+sub _use_perl6_export_attrs { 0 }
+
 =head1 NAME
 
@@ -106 +139 @@
 =cut
 
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 
 =head1 SYNOPSIS
@@ -325 +358 @@
  
  use Clone qw/clone/;
- use base qw/Util::Any/;
+ use Util::Any -Base; # or use base qw/Util::Any/;
  our $Utils = clone $Util::Any::Utils;
  push @{$Utils->{list}}, qw/Your::Favorite::List::Utils/;
@@ -334 +367 @@
 
  use Util::Yours qw/list/;
+
+=head1 USE Perl6::Export::Attrs in YOUR OWN UTIL MODULE
+
+Perl6::Export::Attrs overrides caller package's import method.
+So, when your module use Perl6::Export::Attrs, Util::Any cannot work.
+
+Util::Any provides option to solve this prolblem.
+Write the follwoing instead of "use Util::Any -Base" or "use base qw/Util::Any/".
+
+ use Util::Any -Perl6ExportAttrs;
+
+example;
+
+ package Util::Yours;
+ 
+ use Clone qw/clone/;
+ use Util::Any -Perl6ExportAttrs;
+ our $Utils = clone $Util::Any::Utils;
+ push @{$Utils->{list}}, qw/Your::Favorite::List::Utils/;
+ 
+ sub foo :Export(:DEFAULT) {
+   return "foo!";
+ }
+ 
+ sub bar :Export(:bar) {
+   return "bar!";
+ }
+ 
+ 1;
+
+Or you can write your own import method and BEGIN block like the follwoing.
+
+ package UtilPerl6ExportAttr;
+ 
+ use strict;
+ use base qw/Util::Any/;
+ use Clone qw/clone/;
+ 
+ BEGIN {
+   use Perl6::Export::Attrs ();
+   no strict 'refs';
+   *{__PACKAGE__ . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
+ }
+ 
+ our $Utils = clone $Util::Any::Utils;
+ $Utils->{your_list} = [
+                  ['List::Util', '', [qw(first min sum)]],
+                 ];
+ 
+ sub import {
+   my $pkg = shift;
+   my $caller = (caller)[0];
+ 
+   no strict 'refs';
+   eval "package $caller; $pkg" . '->Util::Any::import(@_);';
+   my @arg = grep !exists $Utils->{$_}, @_;
+   if (@_ and @arg) {
+     eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg)';
+   } elsif (!@_) {
+     eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import';
+   }
+   return;
+ }
+ 
+ sub foo :Export(:DEFAULT) {
+   return "foo!";
+ }
+ 
+ 1;
 
 =head2 $Utils STRUCTURE