--- /dev/null
+MANIFEST
+META.yml
+Makefile.PL
+Name.xs
+README
+lib/Sub/Name.pm
+t/smoke.t
--- /dev/null
+# 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
--- /dev/null
+# $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>'
+);
--- /dev/null
+/* $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);
--- /dev/null
+$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.
--- /dev/null
+# $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;
--- /dev/null
+#!/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
projects / p5sagit/Sub-Name.git / commitdiff