view release on metacpan or  search on metacpan

inc/bundle/Module/Metadata.pm  view on Meta::CPAN

      }
    }
  }

  $self->{version} = $self->{versions}{$self->{module}}
    if defined( $self->{module} );

  return $self;
}

# class method
sub _do_find_module {
  my $class   = shift;
  my $module  = shift || croak 'find_module_by_name() requires a package name';
  my $dirs    = shift || \@INC;

  my $file = File::Spec->catfile(split( /::/, $module));
  foreach my $dir ( @$dirs ) {
    my $testfile = File::Spec->catfile($dir, $file);
    return [ File::Spec->rel2abs( $testfile ), $dir ]
      if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
    # CAVEAT (possible TODO): .pmc files are not discoverable here
    $testfile .= '.pm';
    return [ File::Spec->rel2abs( $testfile ), $dir ]
      if -e $testfile;
  }
  return;
}

# class method
sub find_module_by_name {
  my $found = shift()->_do_find_module(@_) or return;
  return $found->[0];
}

# class method
sub find_module_dir_by_name {
  my $found = shift()->_do_find_module(@_) or return;
  return $found->[1];
}


# given a line of perl code, attempt to parse it if it looks like a
# $VERSION assignment, returning sigil, full name, & package name
sub _parse_version_expression {
  my $self = shift;
  my $line = shift;

  my( $sigil, $variable_name, $package);
  if ( $line =~ /$VERS_REGEXP/o ) {
    ( $sigil, $variable_name, $package) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
    if ( $package ) {
      $package = ($package eq '::') ? 'main' : $package;
      $package =~ s/::$//;
    }
  }

  return ( $sigil, $variable_name, $package );
}

# Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
# If there's one, then skip it and set the :encoding layer appropriately.
sub _handle_bom {
  my ($self, $fh, $filename) = @_;

  my $pos = tell $fh;
  return unless defined $pos;

  my $buf = ' ' x 2;
  my $count = read $fh, $buf, length $buf;
  return unless defined $count and $count >= 2;

  my $encoding;
  if ( $buf eq "\x{FE}\x{FF}" ) {
    $encoding = 'UTF-16BE';
  }
  elsif ( $buf eq "\x{FF}\x{FE}" ) {
    $encoding = 'UTF-16LE';
  }
  elsif ( $buf eq "\x{EF}\x{BB}" ) {
    $buf = ' ';
    $count = read $fh, $buf, length $buf;
    if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
      $encoding = 'UTF-8';
    }
  }

  if ( defined $encoding ) {
    if ( "$]" >= 5.008 ) {
      binmode( $fh, ":encoding($encoding)" );
    }
  }
  else {
    seek $fh, $pos, SEEK_SET
      or croak( sprintf "Can't reset position to the top of '$filename'" );
  }

  return $encoding;
}

sub _parse_fh {
  my ($self, $fh) = @_;

  my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
  my( @packages, %vers, %pod, @pod );
  my $package = 'main';
  my $pod_sect = '';
  my $pod_data = '';
  my $in_end = 0;
  my $encoding = '';

  while (defined( my $line = <$fh> )) {
    my $line_num = $.;

    chomp( $line );

    # From toke.c : any line that begins by "=X", where X is an alphabetic
    # character, introduces a POD segment.
    my $is_cut;
    if ( $line =~ /^=([a-zA-Z].*)/ ) {
      my $cmd = $1;