Acme-Damn
view release on metacpan or search on metacpan
0.06 Sun Oct 26 20:50:12 2014
- support for Perl >= v5.18
0.05 Tue Feb 14 12:10:59 2012
- added support for modified bless() behaviour as suggested by
Bo Lindbergh <blgl@cpan.org>
- see https://rt.cpan.org/Ticket/Display.html?id=74899
0.04 Sat May 16 10:42:00 2009
- changed handling of PL_no_modify to comply with GCC's -Wformat and
-Werror=format-security
0.03 Sat Feb 5 00:09:32 2006
- added support for any alias, not just the ones defined in v0.02
0.02 Tue Jun 10 18:13:31 2003
- added support for aliases for damn() as suggested by
Claes Jacobsson <claes@surfar.nu>
0.01 Sun Jun 8 13:40:03 2003
- initial Acme::Damn release
*Acme::Damn::AUTOLOAD = *DynaLoader::AUTOLOAD;
sub import
{
my $class = shift;
# check the unknown symbols to ensure they are 'safe'
my @bad = grep { /\W/o } @_;
if ( @bad ) {
# throw an error message informing the user where the problem is
my ( undef, $file , $line ) = caller 0;
die sprintf( "Bad choice of symbol name%s %s for import at %s line %s\n"
, ( @bad == 1 ) ? '' : 's'
, join( ', ' , map { qq|'$_'| } @bad ) , $file , $line );
}
# remove duplicates from the list of aliases, as well as those symbol
# names listed in @EXPORT
# - we keep @EXPORT_OK in a separate list since they are optionally
my $ref = shift;
my ( undef , $file , $line ) = caller 1;
# call damn() with the location of where this method was
# originally called
&{ __PACKAGE__ . '::damn' }( $ref , $alias , $file , $line );
# NB: wanted to do something like
# goto \&{ __PACKAGE__ . '::damn' };
# having set the @_ array appropriately, but this caused a
# "Attempt to free unrefernced SV" error that I couldn't solve
# - I think it was to do with the @_ array
};
}
# add the known symbols to @_
splice @_ , 0; push @_ , $class , @reserved;
# run the "proper" import() routine
goto \&Exporter::import;
} # import()
namespace. Aliases for B<damn()> (see below) may be imported upon request.
=head2 Methods
=over 4
=item B<damn> I<object>
B<damn()> accepts a single blessed reference as its argument, and returns
that reference unblessed. If I<object> is not a blessed reference, then
B<damn()> will C<die> with an error.
=item B<bless> I<reference>
=item B<bless> I<reference> [ , I<package> ]
=item B<bless> I<reference> [ , undef ]
Optionally, B<Acme::Damn> will modify the behaviour of C<bless> to
allow the passing of an explicit C<undef> as the target package to invoke
SV *
damn( rv , ... )
SV * rv;
PROTOTYPE: $;$$$
PREINIT:
SV * sv;
CODE:
/* if we don't have a blessed reference, then raise an error */
if ( ! sv_isobject( rv ) ) {
/*
** if we have more than one parameter, then pull the name from
** the stack ... otherwise, use the method[] array
*/
if ( items > 1 ) {
char *name = (char *)SvPV_nolen( ST(1) );
char *file = (char *)SvPV_nolen( ST(2) );
int line = (int)SvIV( ST(3) );
reference.
EXPORT
By default, Acme::Damn exports the method damn() into the current
namespace. Aliases for damn() (see below) may be imported upon request.
Methods
damn *object*
damn() accepts a single blessed reference as its argument, and
returns that reference unblessed. If *object* is not a blessed
reference, then damn() will "die" with an error.
bless *reference*
bless *reference* [ , *package* ]
bless *reference* [ , undef ]
Optionally, Acme::Damn will modify the behaviour of "bless" to allow
the passing of an explicit "undef" as the target package to invoke
damn():
use Acme::Damn qw( bless );
t/3aliases.t view on Meta::CPAN
my $ref = [];
my $string = "$ref";
# bless the reference and the "unbless" it
bless $ref;
lives_ok { $alias->( $ref ) } "$alias executes successfully";
# make sure the stringification is correct
ok( $ref eq $string , "$alias executes correctly" );
# make sure the error message correctly reports the alias
throws_ok { $alias->( $ref ) }
"/can only $alias/" ,
"$alias exception thrown successfully";
}
#!/usr/bin/perl -w
# $Id: 4name.t,v 1.2 2003-06-10 18:08:34 ian Exp $
# name.t
#
# Ensure the damn reports the correct alias name in error messages.
use strict;
use Test::More tests => 11;
use Test::Exception;
# load Acme::Damn and the aliases
my @aliases;
BEGIN { @aliases = qw( abjure anathematize condemn curse damn excommunicate
expel proscribe recant renounce unbless ); }
# load Acme::Damn
use Acme::Damn @aliases;
foreach my $alias ( @aliases ) {
no strict 'refs';
# attempt to unbless a normal reference so that we can test the error
# messages
throws_ok { $alias->( [] ) } "/can only $alias/" ,
"$alias exception thrown successfully";
}
throws_ok { bless %hash } $x , "bless() dies with hash variable";
throws_ok { bless $scalar } $x , "bless() dies with scalar variable";
lives_ok { bless [] } "bless() lives with array reference";
lives_ok { bless {} } "bless() lives with hash reference";
lives_ok { bless sub {} } "bless() lives with code reference";
lives_ok { bless qr/./ } "bless() lives with regex reference";
lives_ok { bless \*STDOUT } "bless() lives with glob reference";
# ensure we can't bless into a reference
throws_ok { bless [] , [] } qr/Attempt to bless into a reference/
, "bless() throws correct error with reference argument";
# ensure bless() works with a named package
# - if the package name is '' then we default to 'main'
my %try = ( '' => 'main'
, 'main' => 'main'
, 'foo' => 'foo'
, 'foo::bar' => 'foo::bar'
);
my @try = ( \$scalar
( run in 0.556 second using v1.01-cache-2.11-cpan-74e6d1fb12f )