/usr/local/CPAN/CPANXR/CPANXR/Indexer.pm

• package CPANXR::Indexer
  • index
  • file_path
• EOF

# $Id: Indexer.pm,v 1.20 2003/10/07 19:53:18 clajac Exp $

package CPANXR::Indexer;

use CPANXR::Database;
use CPANXR::Parser;
use CPANXR::Config;
use Carp qw(carp croak);
use File::Find::Rule;
use File::Spec::Functions qw(catdir abs2rel rel2abs splitpath splitdir);

use strict;

use constant VALID_TYPES => qw(*.pm *.xs);

sub index {
  my ($self, $dist, %args) = @_;

  # Don't index development versions
  if($dist =~ /\_[A-Za-z0-9]$/) {
    # Looks like a development version, skip that
    print STDERR "$dist looks like a development release and will be skipped\n";
    return;
  }
  
  # Index distribution
  my $dist_rel_path = (splitdir($dist))[-1];
  
  # Check if distribution is already indexed
  my $dist_id = CPANXR::Database->indexed(distribution => $dist_rel_path);
  return if($dist_id);
  
  # Check version number
  my ($dist_no_version, $version_num) = $dist_rel_path =~ /^(.*)-([0-9\.]+)$/;

  my $pre = CPANXR::Database->indexed(like_distribution => "${dist_no_version}-\%");

  if($pre) {
    my ($pre_dist_id, $pre_dist) = @$pre;
    my ($pre_version_num) = $pre_dist =~ /^.*-([0-9\.]+)$/;
    if($version_num > $pre_version_num) {
      CPANXR::Database->delete_distribution(dist_id => $pre_dist_id);
    } else {
      print STDERR "$dist is older than the one that is already indexed\n";
      return;
    }
  }

  # Insert distribution
  $dist_id = CPANXR::Database->insert_path(distribution => $dist_rel_path);

  # Find files
  my @files = File::Find::Rule->file()->name(VALID_TYPES)->in($dist);

  for my $file_abs_path (@files) {
    my $file_rel_path = $self->file_path($file_abs_path);
    my $file_id = CPANXR::Database->indexed(file => $file_rel_path);
    next if($file_id);

    my $type = CPANXR::Parser->understands($file_rel_path);
    if ($type) {
      my $file = (splitpath($file_rel_path))[-1];
      my $sym_id = CPANXR::Database->insert_symbol($file);
      $file_id = CPANXR::Database->insert_path(file => $file_rel_path, $dist_id, $sym_id, $type);
      my $lines = CPANXR::Parser->parse($file_abs_path, dist_id => $dist_id, file_id => $file_id);
      CPANXR::Database->set_loc($file_id, $lines);
    }
  }
}

my $base_path = catdir(CPANXR::Config->get("XrRoot"));

sub file_path {
  my ($pkg, $file) = @_;
  $file = abs2rel($file, $base_path);
  return $file;
}

1;