Sub-Name-0.05/0000711000175000017500000000000011441541453011471 5ustar raflraflSub-Name-0.05/MANIFEST.SKIP0000644000175000017500000000012211441254253013371 0ustar raflrafl^\. build\b blib\b \.(?:bak|o|c|bs)$ ^Makefile$ ^Makefile.old$ ^Debian ^Sub-Name- Sub-Name-0.05/Makefile.PL0000644000175000017500000000031011441253532013443 0ustar raflrafluse 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 ' ); Sub-Name-0.05/Changes0000644000175000017500000000141211441541327012772 0ustar raflrafl0.05 -- Wed Sep 8 00:51 CEST 2010 * Stop using the padlist to refcount GVs. Instead use regular magic. This allows various modules, including B::Deparse, to safely peek into pads of (re)named subs (Closes RT#42725) (Goro Fuji). * Support perl >= 5.13.3 by using the new CvGV_set interface there (Closes RT#59558). * Stop using the deprecated PL_no_symref (Closes RT#57843). 0.04 -- Fri Jul 18 15:23 CEST 2008 * Fixed for perl 5.6 and 5.005 threads (tested) 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. Sub-Name-0.05/README0000644000175000017500000000226411441253532012363 0ustar raflraflSub::Name 0.04 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 Copyright (C) 2004, 2008 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. Sub-Name-0.05/lib/0000711000175000017500000000000011441541453012237 5ustar raflraflSub-Name-0.05/lib/Sub/0000711000175000017500000000000011441541453012770 5ustar raflraflSub-Name-0.05/lib/Sub/Name.pm0000644000175000017500000000235711441541430014220 0ustar raflraflpackage 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 Copyright (C) 2004, 2008 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.05'; use base 'Exporter'; use base 'DynaLoader'; our @EXPORT = qw(subname); our @EXPORT_OK = @EXPORT; bootstrap Sub::Name $VERSION; 1; Sub-Name-0.05/MANIFEST0000644000175000017500000000031411441541453012630 0ustar raflraflChanges lib/Sub/Name.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP Name.xs README t/RT42725_deparse.t t/smoke.t META.yml Module meta-data (added by MakeMaker) Sub-Name-0.05/t/0000711000175000017500000000000011441541453011734 5ustar raflraflSub-Name-0.05/t/RT42725_deparse.t0000644000175000017500000000031211441541327014561 0ustar raflrafluse strict; use warnings; use Test::More tests => 2; use Sub::Name; use B::Deparse; my $source = eval { B::Deparse->new->coderef2text(subname foo => sub{ @_ }); }; ok !$@; like $source, qr/\@\_/; Sub-Name-0.05/t/smoke.t0000644000175000017500000000104311441253532013243 0ustar raflrafl#!/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"; } # vim: ft=perl Sub-Name-0.05/Name.xs0000644000175000017500000000402711441541327012740 0ustar raflrafl/* Copyright (C) 2004, 2008 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; #ifndef PERL_MAGIC_ext # define PERL_MAGIC_ext '~' #endif #ifndef SvMAGIC_set #define SvMAGIC_set(sv, val) (SvMAGIC(sv) = (val)) #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; MAGIC *mg; 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("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use", 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); mg = SvMAGIC(cv); while (mg && mg->mg_virtual != &subname_vtbl) mg = mg->mg_moremagic; if (!mg) { Newz(702, mg, 1, MAGIC); mg->mg_moremagic = SvMAGIC(cv); mg->mg_type = PERL_MAGIC_ext; mg->mg_virtual = &subname_vtbl; SvMAGIC_set(cv, mg); } if (mg->mg_flags & MGf_REFCOUNTED) SvREFCNT_dec(mg->mg_obj); mg->mg_flags |= MGf_REFCOUNTED; mg->mg_obj = (SV *) gv; SvRMAGICAL_on(cv); CvANON_off(cv); #ifndef CvGV_set CvGV(cv) = gv; #else CvGV_set(cv, gv); #endif PUSHs(sub); Sub-Name-0.05/META.yml0000600000175000017500000000100411441541453012735 0ustar raflrafl--- #YAML:1.0 name: Sub-Name version: 0.05 abstract: (re)name a sub author: - Matthijs van Duin license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4