File Coverage

lib/Object/Disoriented.pm

Criterion	Covered	Total	%
statement	27	29	93.1
branch	3	6	50.0
condition			n/a
subroutine	7	7	100.0
pod	0	1	0.0
total	37	43	86.0

package Object::Disoriented;

use strict;
use warnings;

our $VERSION = '0.02';

use Carp qw;

sub import {
    my (undef, $package, @functions) = @_;

    croak "What functions in $package do you want to disorient?"
        if !@functions;

    if (!eval "CORE::require $package; 1") {
        # Make the error message look like the caller's.
        $@ =~ s/\n* \s+ at \s+ \(eval \s+ \d+\) \s+ line \s+ \d+\.\n*\z//xms;
        croak $@;
    }

    # Create a (presumably spurious) instance
    my $instance = $package->new;

    # Ensure all desired functions exist as methods
    my @missing = grep { !$instance->can($_) } @functions;
    croak "Methods not found in $package: @missing"
        if @missing;

    # Build a sub for each desired function
    my $caller = caller;
    for my $name (@functions) {
        set_symbol($caller, $name, sub { $instance->$name(@_) });
    }

    return;
}

sub set_symbol {
    my ($package, $name, $value) = @_;
    no strict qw;
    *{"$package\::$name"} = $value;
}

1;
__END__