lib/Object/Remote/ModuleSender.pm

   1 package Object::Remote::ModuleSender;
   2
   3 use Object::Remote::Logging qw( :log :dlog );
   4 use Config;
   5 use File::Spec;
   6 use List::Util qw(first);
   7 use Moo;
   8
   9 has dir_list => (is => 'lazy');
  10
  11 sub _build_dir_list {
  12   my %core = map +($_ => 1), grep $_, @Config{
  13     qw(privlibexp archlibexp vendorarchexp sitearchexp)
  14   };
  15   DlogS_trace { "dir list built in ModuleSender: $_" } [ grep !$core{$_}, @INC ];
  16 }
  17
  18 sub source_for {
  19   my ($self, $module) = @_;
  20   log_debug { "locating source for module '$module'" };
  21   if (my $find = Object::Remote::FromData->can('find_module')) {
  22     if (my $source = $find->($module)) {
  23       Dlog_trace { "source of '$module' was found by Object::Remote::FromData" };
  24       return $source;
  25     }
  26   }
  27   log_trace { "Searching for module in library directories" };
  28
  29   for my $inc (@{$self->dir_list}) {
  30     if (!ref $inc) {
  31       my $full_module = File::Spec->catfile($inc, $module);
  32       next unless -f $full_module;
  33       log_debug { "found '$module' at '$found'" };
  34       open my $fh, '<', $full_module or die "Couldn't open ${full_module} for ${module}: $!";
  35       return do { local $/; <$fh> };
  36     }
  37     else {
  38       my $data = _read_dynamic_inc($inc, $module);
  39       return $data
  40         if defined $data;
  41     }
  42   }
  43   die "Couldn't find ${module} in remote \@INC. dir_list contains:\n"
  44       .join("\n", @{$self->dir_list});
  45 }
  46
  47 sub _read_dynamic_inc {
  48   my ($inc, $module) = @_;
  49
  50   my ($fh, $cb, $state);
  51   if (ref $inc eq 'CODE') {
  52     ($fh, $cb, $state) = $inc->($inc, $module);
  53   }
  54   elsif (ref $inc eq 'ARRAY') {
  55     ($fh, $cb, $state) = $inc->[0]->($inc, $module);
  56   }
  57   elsif ($inc->can('INC')) {
  58     ($fh, $cb, $state) = $inc->INC($module);
  59   }
  60
  61   if ($cb && $fh) {
  62     my $data = '';
  63     while (1) {
  64       local $_ = <$fh>;
  65       last unless defined;
  66       my $res = $cb->($cb, $state);
  67       $data .= $_;
  68       last unless $res;
  69     }
  70     return $data;
  71   }
  72   elsif ($cb) {
  73     my $data = '';
  74     while (1) {
  75       local $_;
  76       my $res = $cb->($cb, $state);
  77       $data .= $_;
  78       last unless $res;
  79     }
  80     return $data;
  81   }
  82   elsif ($fh) {
  83     return do { local $/; <$fh> };
  84   }
  85   return;
  86 }
  87
  88 1;