File Coverage

blib/lib/ex/override.pm

Criterion	Covered	Total	%
statement	37	38	97.3
branch	7	8	87.5
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	51	53	96.2

package ex::override;
# $Id: override.pm,v 1.1 2003/03/14 14:58:53 cwest Exp $
use strict;
use warnings;
use Carp;

use vars qw[$VERSION @ISA];
$VERSION = (qw$Revision: 1.1 $)[1];

@ISA = qw[ex::override::functions];

sub import {
  my $self = shift;

  return unless @_;

  my %functions = @_;

  my $caller  = caller(0);

  foreach ( keys %functions ) {
    if ( s/^GLOBAL_// ) {
      $caller  = 'CORE::GLOBAL';
      $functions{$_} = $functions{'GLOBAL_'.$_};
    }
    unless ( prototype "CORE::$_" ) {
      croak "$_ cannot be overriden because it doesn't have a prototype";
    }
    no strict 'refs';
    *{'ex::override::functions::'.$_} = \&{$functions{$_}};
    *{$caller.'::'.$_} = \&{'ex::override::functions::'.$_};
  }
}

sub unimport {
  my $self = shift;

  my @remove = ( @_ ? @_ : keys %ex::override::functions:: );

  my $caller = caller(0);

  foreach ( @remove ) {
    s/^GLOBAL_//;
    delete $CORE::GLOBAL{$_};
    eval 'delete $'.$caller."::{$_}";
  }
}

1;
__END__