File Coverage

blib/lib/Bot/Cobalt/Core/Loader.pm

Criterion	Covered	Total	%
statement	29	51	56.8
branch	4	16	25.0
condition	1	6	16.6
subroutine	9	13	69.2
pod	3	5	60.0
total	46	91	50.5

package Bot::Cobalt::Core::Loader;
$Bot::Cobalt::Core::Loader::VERSION = '0.021001';
use strictures 2;
use Carp;
use Scalar::Util 'blessed';

use Try::Tiny;

sub new { bless [], shift }

sub is_reloadable {
  my ($class, $obj) = @_;

  confess "is_reloadable() needs a plugin object"
    unless $obj and blessed $obj;

  $obj->can('NON_RELOADABLE') && $obj->NON_RELOADABLE ?
    undef : 1
}

sub module_path {
  my ($class, $module) = @_;

  confess "module_path() needs a module name" unless defined $module;

  join('/', split /::/, $module).".pm";
}

sub load {
  my ($class, $module, @newargs) = @_;

  confess "load() needs a module name" unless defined $module;

  my $modpath = $class->module_path($module);

  my $orig_err;
  unless (try { require $modpath;1 } catch { $orig_err = $_;0 }) {
    ## die informatively
    croak "Could not load $module: $orig_err";
    ## Okay, so we require 5.12.1+ and this only happens on <=5.8 ...
    ## ... but it's worth noting in case this code is ported to older
    ## perls. $INC{$modpath} is set even if we died, so long as the file
    ## exists in our INC path.
    delete $INC{$modpath};
  }

  my $obj;
  my $err; try {
    $obj = $module->new(@newargs)
  } catch {
    $err = "new() failed for $module: $_";
    undef
  } or confess $err;

  $obj
}

sub unload {
  my ($class, $module) = @_;

  confess "unload() needs a module name" unless defined $module;

  my $modpath = $class->module_path($module);

  delete $INC{$modpath};

  {
    no strict 'refs';
    @{$module.'::ISA'} = ();

    my $s_table = $module.'::';
    for my $symbol (keys %$s_table) {
      next if $symbol =~ /^[^:]+::$/;
      delete $s_table->{$symbol}
    }
  }

  ## Pretty much always returns success, on the theory that
  ## we did all we could from here.
  1
}

1;
__END__