r15624 - in /branches/upstream/libsub-name-perl: ./ current/ current/Changes current/MANIFEST current/META.yml current/Makefile.PL current/Name.xs current/README current/lib/ current/lib/Sub/ current/lib/Sub/Name.pm current/t/ current/t/smoke.t
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Tue Feb 26 09:46:56 UTC 2008
Author: eloy
Date: Tue Feb 26 09:46:53 2008
New Revision: 15624
URL: http://svn.debian.org/wsvn/?sc=1&rev=15624
Log:
[svn-inject] Installing original source of libsub-name-perl
Added:
branches/upstream/libsub-name-perl/
branches/upstream/libsub-name-perl/current/
branches/upstream/libsub-name-perl/current/Changes
branches/upstream/libsub-name-perl/current/MANIFEST
branches/upstream/libsub-name-perl/current/META.yml
branches/upstream/libsub-name-perl/current/Makefile.PL
branches/upstream/libsub-name-perl/current/Name.xs
branches/upstream/libsub-name-perl/current/README
branches/upstream/libsub-name-perl/current/lib/
branches/upstream/libsub-name-perl/current/lib/Sub/
branches/upstream/libsub-name-perl/current/lib/Sub/Name.pm
branches/upstream/libsub-name-perl/current/t/
branches/upstream/libsub-name-perl/current/t/smoke.t
Added: branches/upstream/libsub-name-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/Changes?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/Changes (added)
+++ branches/upstream/libsub-name-perl/current/Changes Tue Feb 26 09:46:53 2008
@@ -1,0 +1,9 @@
+$Id: Changes,v 1.1 2004/08/18 17:53:45 xmath Exp $
+
+0.03 -- Wed Feb 20 20:19 CET 2008
+ * Fixed crash when trying to rename xsubs
+ * As a side-effect, should work with 5.005 threads (untested)
+
+0.02 -- Wed Aug 18 19:51 CEST 2004
+ * Fixed documentation, which erroneously mentioned the existance of
+ two exported functions.
Added: branches/upstream/libsub-name-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/MANIFEST?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/MANIFEST (added)
+++ branches/upstream/libsub-name-perl/current/MANIFEST Tue Feb 26 09:46:53 2008
@@ -1,0 +1,8 @@
+Changes
+MANIFEST
+META.yml
+Makefile.PL
+Name.xs
+README
+lib/Sub/Name.pm
+t/smoke.t
Added: branches/upstream/libsub-name-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/META.yml?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/META.yml (added)
+++ branches/upstream/libsub-name-perl/current/META.yml Tue Feb 26 09:46:53 2008
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Sub-Name
+version: 0.03
+version_from: lib/Sub/Name.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: branches/upstream/libsub-name-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/Makefile.PL?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/Makefile.PL (added)
+++ branches/upstream/libsub-name-perl/current/Makefile.PL Tue Feb 26 09:46:53 2008
@@ -1,0 +1,11 @@
+# $Id: Makefile.PL,v 1.1 2004/08/17 19:23:24 xmath Exp $
+
+use 5.006;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Sub::Name',
+ VERSION_FROM => 'lib/Sub/Name.pm',
+ ABSTRACT_FROM => 'lib/Sub/Name.pm',
+ AUTHOR => 'Matthijs van Duin <xmath at cpan.org>'
+);
Added: branches/upstream/libsub-name-perl/current/Name.xs
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/Name.xs?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/Name.xs (added)
+++ branches/upstream/libsub-name-perl/current/Name.xs Tue Feb 26 09:46:53 2008
@@ -1,0 +1,79 @@
+/* $Id: Name.xs,v 1.5 2004/08/18 13:21:44 xmath Exp $
+ * Copyright (C) 2004 Matthijs van Duin. All rights reserved.
+ * This program is free software; you can redistribute it and/or modify
+ * it under the same terms as Perl itself.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static MGVTBL subname_vtbl;
+
+MODULE = Sub::Name PACKAGE = Sub::Name
+
+PROTOTYPES: DISABLE
+
+void
+subname(name, sub)
+ char *name
+ SV *sub
+ PREINIT:
+ CV *cv = NULL;
+ GV *gv;
+ HV *stash = CopSTASH(PL_curcop);
+ char *s, *end = NULL, saved;
+ PPCODE:
+ if (!SvROK(sub) && SvGMAGICAL(sub))
+ mg_get(sub);
+ if (SvROK(sub))
+ cv = (CV *) SvRV(sub);
+ else if (SvTYPE(sub) == SVt_PVGV)
+ cv = GvCVu(sub);
+ else if (!SvOK(sub))
+ croak(PL_no_usym, "a subroutine");
+ else if (PL_op->op_private & HINT_STRICT_REFS)
+ croak(PL_no_symref, SvPV_nolen(sub), "a subroutine");
+ else if ((gv = gv_fetchpv(SvPV_nolen(sub), FALSE, SVt_PVCV)))
+ cv = GvCVu(gv);
+ if (!cv)
+ croak("Undefined subroutine %s", SvPV_nolen(sub));
+ if (SvTYPE(cv) != SVt_PVCV && SvTYPE(cv) != SVt_PVFM)
+ croak("Not a subroutine reference");
+ for (s = name; *s++; ) {
+ if (*s == ':' && s[-1] == ':')
+ end = ++s;
+ else if (*s && s[-1] == '\'')
+ end = s;
+ }
+ s--;
+ if (end) {
+ saved = *end;
+ *end = 0;
+ stash = GvHV(gv_fetchpv(name, TRUE, SVt_PVHV));
+ *end = saved;
+ name = end;
+ }
+ gv = (GV *) newSV(0);
+ gv_init(gv, stash, name, s - name, TRUE);
+#ifndef USE_5005THREADS
+ if (CvPADLIST(cv)) {
+ /* cheap way to refcount the gv */
+ av_store((AV *) AvARRAY(CvPADLIST(cv))[0], 0, (SV *) gv);
+ }
+#endif
+ else {
+ /* expensive way to refcount the gv */
+ MAGIC *mg = SvMAGIC(cv);
+ while (mg && mg->mg_virtual != &subname_vtbl)
+ mg = mg->mg_moremagic;
+ if (!mg)
+ mg = sv_magicext((SV *) cv, NULL, PERL_MAGIC_ext,
+ &subname_vtbl, NULL, 0);
+ if (mg->mg_flags & MGf_REFCOUNTED)
+ SvREFCNT_dec(mg->mg_obj);
+ mg->mg_flags |= MGf_REFCOUNTED;
+ mg->mg_obj = (SV *) gv;
+ }
+ CvGV(cv) = gv;
+ PUSHs(sub);
Added: branches/upstream/libsub-name-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/README?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/README (added)
+++ branches/upstream/libsub-name-perl/current/README Tue Feb 26 09:46:53 2008
@@ -1,0 +1,46 @@
+$Id: README,v 1.5 2004/08/18 17:53:45 xmath Exp $
+
+Sub::Name 0.01
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+Module documentation:
+
+NAME
+ Sub::Name - (re)name a sub
+
+SYNOPSIS
+ use Sub::Name;
+
+ subname $name, $subref;
+
+ $subref = subname foo => sub { ... };
+
+DESCRIPTION
+ This module has only one function, which is also exported by default:
+
+ subname NAME, CODEREF
+ Assigns a new name to referenced sub. If package specification is
+ omitted in the name, then the current package is used. The return value
+ is the sub.
+
+ The name is only used for informative routines (caller, Carp, etc). You
+ won't be able to actually invoke the sub by the given name. To allow
+ that, you need to do glob-assignment yourself.
+
+ Note that for anonymous closures (subs that reference lexicals declared
+ outside the sub itself) you can name each instance of the closure
+ differently, which can be very useful for debugging.
+
+AUTHOR
+ Matthijs van Duin <xmath at cpan.org>
+
+ Copyright (C) 2004 Matthijs van Duin. All rights reserved. This program
+ is free software; you can redistribute it and/or modify it under the
+ same terms as Perl itself.
Added: branches/upstream/libsub-name-perl/current/lib/Sub/Name.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/lib/Sub/Name.pm?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/lib/Sub/Name.pm (added)
+++ branches/upstream/libsub-name-perl/current/lib/Sub/Name.pm Tue Feb 26 09:46:53 2008
@@ -1,0 +1,59 @@
+# $Id: Name.pm,v 1.5 2004/08/18 17:53:45 xmath Exp $
+
+package Sub::Name;
+
+=head1 NAME
+
+Sub::Name - (re)name a sub
+
+=head1 SYNOPSIS
+
+ use Sub::Name;
+
+ subname $name, $subref;
+
+ $subref = subname foo => sub { ... };
+
+=head1 DESCRIPTION
+
+This module has only one function, which is also exported by default:
+
+=head2 subname NAME, CODEREF
+
+Assigns a new name to referenced sub. If package specification is omitted in
+the name, then the current package is used. The return value is the sub.
+
+The name is only used for informative routines (caller, Carp, etc). You won't
+be able to actually invoke the sub by the given name. To allow that, you need
+to do glob-assignment yourself.
+
+Note that for anonymous closures (subs that reference lexicals declared outside
+the sub itself) you can name each instance of the closure differently, which
+can be very useful for debugging.
+
+=head1 AUTHOR
+
+Matthijs van Duin <xmath at cpan.org>
+
+Copyright (C) 2004 Matthijs van Duin. All rights reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+use 5.006;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.03';
+
+use base 'Exporter';
+use base 'DynaLoader';
+
+our @EXPORT = qw(subname);
+our @EXPORT_OK = @EXPORT;
+
+bootstrap Sub::Name $VERSION;
+
+1;
Added: branches/upstream/libsub-name-perl/current/t/smoke.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-name-perl/current/t/smoke.t?rev=15624&op=file
==============================================================================
--- branches/upstream/libsub-name-perl/current/t/smoke.t (added)
+++ branches/upstream/libsub-name-perl/current/t/smoke.t Tue Feb 26 09:46:53 2008
@@ -1,0 +1,30 @@
+#!/usr/bin/perl
+
+BEGIN { print "1..5\n"; }
+
+
+use Sub::Name;
+
+my $x = subname foo => sub { (caller 0)[3] };
+print $x->() eq "main::foo" ? "ok 1\n" : "not ok 1\n";
+
+
+package Blork;
+
+use Sub::Name;
+
+subname " Bar!", $x;
+print $x->() eq "Blork:: Bar!" ? "ok 2\n" : "not ok 2\n";
+
+subname "Foo::Bar::Baz", $x;
+print $x->() eq "Foo::Bar::Baz" ? "ok 3\n" : "not ok 3\n";
+
+subname "subname (dynamic $_)", \&subname for 1 .. 3;
+
+for (4 .. 5) {
+ subname "Dynamic $_", $x;
+ print $x->() eq "Blork::Dynamic $_" ? "ok $_\n" : "not ok $_\n";
+}
+
+# $Id: smoke.t,v 1.4 2004/08/18 12:03:42 xmath Exp $
+# vim: ft=perl
More information about the Pkg-perl-cvs-commits
mailing list