| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Badger; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 70 |  |  | 70 |  | 3948 | use 5.008; | 
|  | 70 |  |  |  |  | 208 |  | 
| 4 | 70 |  |  | 70 |  | 316 | use Carp; | 
|  | 70 |  |  |  |  | 107 |  | 
|  | 70 |  |  |  |  | 3302 |  | 
| 5 | 70 |  |  | 70 |  | 2290 | use lib; | 
|  | 70 |  |  |  |  | 3243 |  | 
|  | 70 |  |  |  |  | 466 |  | 
| 6 | 70 |  |  | 70 |  | 29433 | use Badger::Hub; | 
|  | 70 |  |  |  |  | 164 |  | 
|  | 70 |  |  |  |  | 4915 |  | 
| 7 |  |  |  |  |  |  | use Badger::Class | 
| 8 |  |  |  |  |  |  | debug      => 0, | 
| 9 |  |  |  |  |  |  | base       => 'Badger::Base', | 
| 10 |  |  |  |  |  |  | import     => 'class', | 
| 11 |  |  |  |  |  |  | words      => 'HUB', | 
| 12 |  |  |  |  |  |  | constants  => 'PKG ARRAY DELIMITER', | 
| 13 |  |  |  |  |  |  | filesystem => 'Bin', | 
| 14 |  |  |  |  |  |  | exports    => { | 
| 15 |  |  |  |  |  |  | hooks  => { | 
| 16 | 70 |  |  |  |  | 717 | lib => [ sub { $_[0]->lib($_[3]) }, 1], | 
|  | 4 |  |  |  |  | 26 |  | 
| 17 |  |  |  |  |  |  | }, | 
| 18 |  |  |  |  |  |  | fail   => \&_export_handler, | 
| 19 | 70 |  |  | 70 |  | 393 | }; | 
|  | 70 |  |  |  |  | 101 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | our $VERSION = 0.14; | 
| 22 |  |  |  |  |  |  | our $HUB     = 'Badger::Hub::Badger'; | 
| 23 |  |  |  |  |  |  | our $AUTOLOAD; | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | sub _export_handler { | 
| 27 |  |  |  |  |  |  | # TODO: we should be able to refactor this down, now that Badger::Exporter | 
| 28 |  |  |  |  |  |  | # can handle this argument shifting | 
| 29 | 13 |  |  | 13 |  | 28 | my ($class, $target, $key, $symbols) = @_; | 
| 30 | 13 | 50 |  |  |  | 35 | croak "You didn't specify a value for the '$key' load option." | 
| 31 |  |  |  |  |  |  | unless @$symbols; | 
| 32 | 13 |  |  |  |  | 43 | my $module = join(PKG, $class, $key); | 
| 33 | 13 |  |  |  |  | 20 | my $option = shift @$symbols; | 
| 34 | 13 |  |  |  |  | 33 | class($module)->load; | 
| 35 | 13 |  |  |  |  | 70 | $module->export($target, $option); | 
| 36 | 13 |  |  |  |  | 36 | return 1; | 
| 37 |  |  |  |  |  |  | } | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | sub init { | 
| 41 | 1 |  |  | 1 | 1 | 2 | my ($self, $config) = @_; | 
| 42 | 1 |  | 33 |  |  | 5 | my $hub = $config->{ hub } || $self->class->any_var(HUB); | 
| 43 | 1 | 50 |  |  |  | 3 | unless (ref $hub) { | 
| 44 | 1 |  |  |  |  | 2 | class($hub)->load; | 
| 45 | 1 |  |  |  |  | 7 | $hub = $hub->new($config); | 
| 46 |  |  |  |  |  |  | } | 
| 47 | 1 |  |  |  |  | 3 | $self->{ hub } = $hub; | 
| 48 | 1 |  |  |  |  | 3 | return $self; | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | sub lib { | 
| 52 | 7 |  |  | 7 | 1 | 17 | my ($self, $lib) = @_; | 
| 53 | 7 | 50 |  |  |  | 56 | $lib = [split(DELIMITER, $lib)] | 
| 54 |  |  |  |  |  |  | unless ref $lib eq ARRAY; | 
| 55 | 7 |  |  |  |  | 18 | foreach (@$lib) { | 
| 56 |  |  |  |  |  |  | # resolve directories relative to current working directory so that | 
| 57 |  |  |  |  |  |  | # relative paths Just Work[tm], e.g. ../perl/lib as well as absolute | 
| 58 |  |  |  |  |  |  | # paths. e.g. /full/path/to/perl/lib | 
| 59 | 9 |  |  |  |  | 252 | my $dir = Bin->dir($_)->must_exist; | 
| 60 | 9 |  |  |  |  | 69 | $self->debug("adding lib: $dir") if DEBUG; | 
| 61 | 9 |  |  |  |  | 38 | lib->import($dir->absolute); | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | sub hub { | 
| 66 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 67 |  |  |  |  |  |  |  | 
| 68 | 0 | 0 |  |  |  |  | if (ref $self) { | 
| 69 |  |  |  |  |  |  | return @_ | 
| 70 |  |  |  |  |  |  | ? ($self->{ hub } = shift) | 
| 71 | 0 | 0 |  |  |  |  | :  $self->{ hub }; | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  | else { | 
| 74 |  |  |  |  |  |  | return @_ | 
| 75 | 0 | 0 |  |  |  |  | ? $self->class->var(HUB => shift) | 
| 76 |  |  |  |  |  |  | : $self->class->var(HUB) | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  | } | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | sub codec { | 
| 81 | 0 |  |  | 0 | 1 |  | shift->hub->codec(@_); | 
| 82 |  |  |  |  |  |  | } | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | sub config { | 
| 86 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 87 | 0 |  |  |  |  |  | return $self->hub->config; | 
| 88 |  |  |  |  |  |  | } | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | # TODO: AUTOLOAD method which polls hub to see what it supports | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | 1; | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | __END__ |