r2799 - in /packages/libsub-install-perl/branches/upstream/current:
Changes MANIFEST META.yml lib/Sub/Install.pm t/export.t
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Tue May 23 14:31:16 UTC 2006
Author: eloy
Date: Tue May 23 14:31:15 2006
New Revision: 2799
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2799
Log:
Load /tmp/tmp.RpwkM20576/libsub-install-perl-0.92 into
packages/libsub-install-perl/branches/upstream/current.
Added:
packages/libsub-install-perl/branches/upstream/current/t/export.t
Modified:
packages/libsub-install-perl/branches/upstream/current/Changes
packages/libsub-install-perl/branches/upstream/current/MANIFEST
packages/libsub-install-perl/branches/upstream/current/META.yml
packages/libsub-install-perl/branches/upstream/current/lib/Sub/Install.pm
Modified: packages/libsub-install-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-install-perl/branches/upstream/current/Changes?rev=2799&op=diff
==============================================================================
--- packages/libsub-install-perl/branches/upstream/current/Changes (original)
+++ packages/libsub-install-perl/branches/upstream/current/Changes Tue May 23 14:31:15 2006
@@ -1,4 +1,8 @@
Revision history for Sub-Install
+
+0.92 2006-05-11
+ allow other users to build exporters like our tiny one (&exporter)
+ rename _CALLABLE to _CODELIKE to keep up with Params::Util
0.91 2006-04-30
use _CALLABLE to determine callability of code, not ref
Modified: packages/libsub-install-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-install-perl/branches/upstream/current/MANIFEST?rev=2799&op=diff
==============================================================================
--- packages/libsub-install-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libsub-install-perl/branches/upstream/current/MANIFEST Tue May 23 14:31:15 2006
@@ -5,6 +5,7 @@
README
t/00-load.t
t/auto_as.t
+t/export.t
t/install.t
t/inst-blessed.t
t/misc_errors.t
Modified: packages/libsub-install-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-install-perl/branches/upstream/current/META.yml?rev=2799&op=diff
==============================================================================
--- packages/libsub-install-perl/branches/upstream/current/META.yml (original)
+++ packages/libsub-install-perl/branches/upstream/current/META.yml Tue May 23 14:31:15 2006
@@ -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: Sub-Install
-version: 0.91
+version: 0.92
version_from: lib/Sub/Install.pm
installdirs: site
requires:
Modified: packages/libsub-install-perl/branches/upstream/current/lib/Sub/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-install-perl/branches/upstream/current/lib/Sub/Install.pm?rev=2799&op=diff
==============================================================================
--- packages/libsub-install-perl/branches/upstream/current/lib/Sub/Install.pm (original)
+++ packages/libsub-install-perl/branches/upstream/current/lib/Sub/Install.pm Tue May 23 14:31:15 2006
@@ -3,7 +3,7 @@
use warnings;
use strict;
-use Carp qw(croak);
+use Carp;
use Scalar::Util ();
=head1 NAME
@@ -12,13 +12,13 @@
=head1 VERSION
-version 0.91
+version 0.92
$Id: /my/rjbs/subinst/trunk/lib/Sub/Install.pm 16622 2005-11-23T00:17:55.304991Z rjbs $
=cut
-our $VERSION = '0.91';
+our $VERSION = '0.92';
=head1 SYNOPSIS
@@ -38,7 +38,7 @@
=head1 FUNCTIONS
-=head2 C< install_sub >
+=head2 install_sub
Sub::Install::install_sub({
code => \&subroutine,
@@ -80,7 +80,7 @@
as => 'dance',
});
-=head2 C< reinstall_sub >
+=head2 reinstall_sub
This routine behaves exactly like C<L</install_sub>>, but does not emit a
warning if warnings are on and the destination is already defined.
@@ -95,7 +95,8 @@
return;
}
-sub _CALLABLE {
+# See also Params::Util, to which this code was donated.
+sub _CODELIKE {
(Scalar::Util::reftype($_[0])||'') eq 'CODE' or Scalar::Util::blessed($_[0])
and overload::Method($_[0],'&{}') ? $_[0] : undef;
}
@@ -112,12 +113,12 @@
for (qw(into from)) { $arg->{$_} = $calling_pkg unless $arg->{$_} }
# This is the only absolutely required argument, in many cases.
- croak "named argument 'code' is not optional" unless $arg->{code};
-
- if (_CALLABLE($arg->{code})) {
+ Carp::croak "named argument 'code' is not optional" unless $arg->{code};
+
+ if (_CODELIKE($arg->{code})) {
$arg->{as} ||= _name_of_code($arg->{code});
} else {
- croak
+ Carp::croak
"couldn't find subroutine named $arg->{code} in package $arg->{from}"
unless my $code = $arg->{from}->can($arg->{code});
@@ -125,7 +126,7 @@
$arg->{code} = $code;
}
- croak "couldn't determine name under which to install subroutine"
+ Carp::croak "couldn't determine name under which to install subroutine"
unless $arg->{as};
$installer->(@$arg{qw(into as code) });
@@ -208,7 +209,7 @@
});
}
-=head2 C< install_installers >
+=head2 install_installers
This routine is provided to allow Sub::Install compatibility with
Sub::Installer. It installs C<install_sub> and C<reinstall_sub> methods into
@@ -258,19 +259,34 @@
Sub::Install exports C<install_sub> and C<reinstall_sub> only if they are
requested.
-=cut
-
-my @EXPORT_OK;
-BEGIN { @EXPORT_OK = qw(install_sub reinstall_sub); }
-
-sub import {
- my $class = shift;
- my %todo = map { $_ => 1 } @_;
- my ($target) = caller(0);
-
- # eating my own dogfood
- install_sub({ code => $_, into => $target }) for grep {$todo{$_}} @EXPORT_OK;
-}
+=head2 exporter
+
+Sub::Install has a never-exported subroutine called C<exporter>, which is used
+to implement its C<import> routine. It takes a hashref of named arguments,
+only one of which is currently recognize: C<exports>. This must be an arrayref
+of subroutines to offer for export.
+
+This routine is mainly for Sub::Install's own consumption. Instead, consider
+L<Sub::Exporter>.
+
+=cut
+
+sub exporter {
+ my ($arg) = @_;
+
+ my %is_exported = map { $_ => undef } @{ $arg->{exports} };
+
+ sub {
+ my $class = shift;
+ my $target = caller;
+ for (@_) {
+ Carp::croak "'$_' is not exported by $class" if !exists $is_exported{$_};
+ install_sub({ code => $_, from => $class, into => $target });
+ }
+ }
+}
+
+BEGIN { *import = exporter({ exports => [ qw(install_sub reinstall_sub) ] }); }
=head1 SEE ALSO
Added: packages/libsub-install-perl/branches/upstream/current/t/export.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-install-perl/branches/upstream/current/t/export.t?rev=2799&op=file
==============================================================================
--- packages/libsub-install-perl/branches/upstream/current/t/export.t (added)
+++ packages/libsub-install-perl/branches/upstream/current/t/export.t Tue May 23 14:31:15 2006
@@ -1,0 +1,24 @@
+use Sub::Install;
+use Test::More tests => 4;
+
+use strict;
+use warnings;
+
+BEGIN { use_ok('Sub::Install'); }
+
+package Bar;
+{ no warnings 'once';
+ *import = Sub::Install::exporter { exports => [ qw(foo) ] };
+}
+sub foo { return 10; }
+
+package main;
+
+eval { Bar->import('bar'); };
+like($@, qr/'bar' is not exported/, "exception on bad import");
+
+eval { foo(); };
+like($@, qr/Undefined subroutine/, "foo isn't imported yet");
+
+Bar->import(qw(foo));
+is(foo(), 10, "foo imported from Bar OK");
More information about the Pkg-perl-cvs-commits
mailing list