initial import of Sub-Name 0.01 from CPAN 0.01
Matthijs van Duin [Wed, 18 Aug 2004 13:35:08 +0000 (05:35 -0800)]
git-cpan-module:   Sub-Name
git-cpan-version:  0.01
git-cpan-authorid: XMATH
git-cpan-file:     authors/id/X/XM/XMATH/Sub-Name-0.01.tar.gz

MANIFEST [new file with mode: 0644]
META.yml [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
Name.xs [new file with mode: 0644]
README [new file with mode: 0644]
lib/Sub/Name.pm [new file with mode: 0644]
t/smoke.t [new file with mode: 0644]

diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..75b2378
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,7 @@
+MANIFEST
+META.yml
+Makefile.PL
+Name.xs
+README
+lib/Sub/Name.pm
+t/smoke.t
diff --git a/META.yml b/META.yml
new file mode 100644 (file)
index 0000000..c961a7d
--- /dev/null
+++ b/META.yml
@@ -0,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.01
+version_from: lib/Sub/Name.pm
+installdirs:  site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..5c8a75f
--- /dev/null
@@ -0,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@cpan.org>'
+);
diff --git a/Name.xs b/Name.xs
new file mode 100644 (file)
index 0000000..a338c3c
--- /dev/null
+++ b/Name.xs
@@ -0,0 +1,63 @@
+/* $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"
+
+#ifdef USE_5005THREADS
+#error "Not compatible with 5.005 threads"
+#endif
+
+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);
+       av_store((AV *) AvARRAY(CvPADLIST(cv))[0], 0, (SV *) gv);
+       CvGV(cv) = gv;
+       PUSHs(sub);
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..3bf1a28
--- /dev/null
+++ b/README
@@ -0,0 +1,48 @@
+$Id: README,v 1.4 2004/08/18 12:03:42 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 two functions to assign a new name to a sub -- in
+    particular an anonymous sub -- which is displayed in tracebacks and
+    such. Both functions are 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 closures (anonymous subs that reference lexicals 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@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.
diff --git a/lib/Sub/Name.pm b/lib/Sub/Name.pm
new file mode 100644 (file)
index 0000000..c881b39
--- /dev/null
@@ -0,0 +1,61 @@
+# $Id: Name.pm,v 1.4 2004/08/18 12:03:42 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 two functions to assign a new name to a sub -- in particular an 
+anonymous sub -- which is displayed in tracebacks and such.  Both functions are 
+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 closures (anonymous subs that reference lexicals 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@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.01';
+
+use base 'Exporter';
+use base 'DynaLoader';
+
+our @EXPORT = qw(subname);
+our @EXPORT_OK = @EXPORT;
+
+bootstrap Sub::Name $VERSION;
+
+1;
diff --git a/t/smoke.t b/t/smoke.t
new file mode 100644 (file)
index 0000000..5c13ecc
--- /dev/null
+++ b/t/smoke.t
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+BEGIN { print "1..3\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";
+
+
+# $Id: smoke.t,v 1.4 2004/08/18 12:03:42 xmath Exp $
+# vim: ft=perl