Acme-Damn

 view release on metacpan or  search on metacpan

Damn.pm  view on Meta::CPAN

    use Acme::Damn  qw( bless );

    my  $obj = ... some blessed reference ...;

    # the following statements are equivalent
    my  $ref = bless $obj , undef;
    my  $ref = damn $obj;

B<NOTE:> The modification of C<bless> is lexically scoped to the current
package, and is I<not> global.


=back


=head2 Method Aliases

Not everyone likes to damn the same way or in the same language, so
B<Acme::Damn> offers the ability to specify any alias on import, provided
that alias is a valid Perl subroutine name (i.e. all characters match C<\w>).

README  view on Meta::CPAN

            use Acme::Damn  qw( bless );

            my  $obj = ... some blessed reference ...;

            # the following statements are equivalent
            my  $ref = bless $obj , undef;
            my  $ref = damn $obj;

        NOTE: The modification of "bless" is lexically scoped to the current
        package, and is *not* global.

  Method Aliases
    Not everyone likes to damn the same way or in the same language, so
    Acme::Damn offers the ability to specify any alias on import, provided
    that alias is a valid Perl subroutine name (i.e. all characters match
    "\w").

      use Acme::Damn qw( unbless );
      use Acme::Damn qw( foo );
      use Acme::Damn qw( unblessthyself );

t/2damn.t  view on Meta::CPAN

# define some argument types for damn
my	@array	= ();
my	%hash	= ();
my	$scalar	= 0;

dies_ok { eval "damn"   or die } "damn() dies with no arguments";
dies_ok { eval "damn()" or die } "damn() dies with no arguments";
dies_ok { damn 1               } "damn() dies with numerical argument";
dies_ok { damn '2'             } "damn() dies with string argument";
dies_ok { damn *STDOUT         } "damn() dies with glob argument";
dies_ok { damn \1              } "damn() dies with scalar reference argument";
dies_ok { damn []              } "damn() dies with array reference argument";
dies_ok { damn {}              } "damn() dies with hash reference argument";
dies_ok { damn sub {}          } "damn() dies with code reference argument";
dies_ok { damn @array          } "damn() dies with array argument";
dies_ok { damn %hash           } "damn() dies with hash argument";
dies_ok { damn $scalar         } "damn() dies with scalar argument";
dies_ok { damn undef           } "damn() dies with undefined argument";
dies_ok { damn \*STDOUT        } "damn() dies with glob reference argument";

#
# make sure damn lives when passed an object
#

# define blessed references for testing
my	$number	= 1;			$number	= bless \$number;
my	$string	= '2';			$string	= bless \$string;
	@array	= ();		my	$array	= bless \@array;
	%hash	= ();		my	$hash	= bless \%hash;
my	$code	= sub {};		$code	= bless $code;
my	$glob	= \*STDOUT;		$glob	= bless $glob;

lives_ok { damn $number } "damn() lives with numerical object argument";
lives_ok { damn $string } "damn() lives with string object argument"   ;
lives_ok { damn $array  } "damn() lives with array object argument"    ;
lives_ok { damn $hash   } "damn() lives with hash object argument"     ;
lives_ok { damn $code   } "damn() lives with code object argument"     ;
lives_ok { damn $glob   } "damn() lives with glob object argument"     ;

#
# make sure damn unblesses the objects
#

# define a routine for performing the comparison
my	$cmp	= sub {
		my	$ref	= shift;
		my	$string	= "$ref";
			damn bless $ref;

		# make sure the stringification is the same
		return $string eq "$ref";
	}; # $cmp()

	$number	= 1;
	$string	= '2';
	$code	= sub {};
	$glob	= \*STDOUT;

ok( $cmp->( \$number ) , "damned numerical references" );
ok( $cmp->( \$string ) , "damned string references"    );
ok( $cmp->( \@array  ) , "damned array references"     );
ok( $cmp->( \%hash   ) , "damned hash references"      );
ok( $cmp->(  $code   ) , "damned code references"      );
ok( $cmp->(  $glob   ) , "damned glob references"      );

t/6bless.t  view on Meta::CPAN

# set the patterns for matching bless exceptions
my  $x      = qr/Can't bless non-reference value/;
my  $c      = qr/Modification of a read-only value attempted/;

# ensure the new bless() exhibits the same live/die behaviour as the
# built-in function
  dies_ok { eval "bless"   or die }      "bless() dies with no arguments";
  dies_ok { eval "bless()" or die }      "bless() dies with no arguments";
throws_ok { bless 1               } $x , "bless() dies with numerical argument";
throws_ok { bless '2'             } $x , "bless() dies with string argument";
throws_ok { bless *STDOUT         } $x , "bless() dies with glob argument";
throws_ok { bless undef           } $x , "bless() dies with undefined argument";
throws_ok { bless \1              } $c , "bless() dies with constant reference";
throws_ok { bless \'2'            } $c , "bless() dies with constant reference";
throws_ok { bless @array          } $x , "bless() dies with array variable";
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'