# This file is part of the DEPS/graph-includes package
#
# (c) 2005,2006 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.

package graphincludes::extractor::perl;
use strict;
use warnings;

use File::Spec::Functions qw(catfile);

use base qw(graphincludes::extractor);

use graphincludes::params;

# This is only a preliminary extractor for perl dependencies.  It should
# correctly catch:
# - use <bareword>
# - require <bareword>
# - require "<file>"
# - require '<file>'
# - use base qw(<single-class>)
#
# It misses:
# - all other "use base <whatever>", including qw(several classes)
# - direct uses of "import base"
# - require <expr>
# - do <expr>
# - statements not the 1st of a line
#
# It will be confused by "require <expr>", trying to locate a file
# with a name corresponding to the un-eval'ed expression.

sub get_default_sysincludes {
  # since this program does mess wih @INC, we must ask another perl
  # what it thinks @INC is
  open INC, 'perl -e \'print join "\n", @INC\' |';
  my @incs;
  while (<INC>) {
    chomp;
    push @incs, $_;
  }
  close INC;

  return @incs;
}

sub pattern { '\.(pm|pl)$' }

sub getdeps {
  my $self = shift;
  my ($graph) = @_;

  @ARGV = map {$_->{LABEL}} $graph->get_nodes();
  while (<>) {
    my $dstfile;
    if (m/^\s*require\s*["'](\S+)["']/) {
      print STDERR "Found quoted require: $_" if $graphincludes::params::debug;
      $dstfile = $self->locatefile ($1, '.', @graphincludes::params::inclpath);

    } elsif (m/^\s*use\s+base\s+qw\(\s*([\w:]+)\s*\)/) {
      print STDERR "Found use_base: $_" if $graphincludes::params::debug;
      $dstfile = $1;
      $dstfile =~ s|::|/|g;
      $dstfile = $self->locatefile ($dstfile . '.pm', '.', @graphincludes::params::inclpath);

    } elsif (m/^\s*(?:use|require)\s*([\w:]+)/) {
      print STDERR "Found use/require: $_" if $graphincludes::params::debug;
      $dstfile = $1;
      $dstfile =~ s|::|/|g;
      $dstfile = $self->locatefile ($dstfile . '.pm', '.', @graphincludes::params::inclpath);

    } else {
      next;
    }

    if (defined $dstfile) {
      $graph->record_edge ($ARGV, $dstfile);
    } else {
      $self->record_missed_dep ($ARGV, catfile (split(/::/, $1)) . '.pm');
    }
  }
}

1;
