Parsing 02packages.details.txt with a git repository

gistfile1.pl

cp /home/ftp/CPAN/modules/02packages.details.txt .
git diff 02packages.details.txt | $PERL parsediffpackages.pl
git commit -m 'packages' 02packages.details.txt

====parsediffpackages.pl

use strict;
use warnings;
use DBI;
use CPAN::DistnameInfo;
use Text::Diff::Parser;

use Data::Dumper;
local $Data::Dumper::Indent=1;

use constant MODULE       => 0;
use constant VERSION      => 1;
use constant PACKAGE_PATH => 2;
use constant DIST_NAME    => 3;
use constant CPAN_ID      => 4;
use constant DIST_FILE    => 5;
use constant DIST_VERS    => 6;

$|=1;

my %dist_cache;

my %actions = ( 'ADD' => \&add_mod, 'MODIFY' => \&mod_mod, 'REMOVE' => \&del_mod, );

unshift @ARGV, '-' unless @ARGV;
open my $handle, shift @ARGV or die "$!\n";
my $parser = Text::Diff::Parser->new( $handle ) or die "$!\n";
$parser->simplify;

my $dsn = 'DBI:mysql:database=********';
my $user = '********';
my $pass = '*******';

my $dbh = DBI->connect($dsn,$user,$pass);

foreach my $change ( $parser->changes('b/02packages.details.txt') ) {
  for ( 0 .. ($change->size-1) ) {
    my $line = $change->text( $_ );
    next if $line =~ /^L[a-z\-]+:\s+/i;
    $actions{ $change->type }->( $change->text( $_ ) );
  }
}

# remove orphaned dists
{
  my $sth = $dbh->prepare_cached(qq{DELETE FROM dists WHERE NOT EXISTS (SELECT * FROM mods WHERE mods.dist_name = dists.dist_name AND mods.dist_vers = dists.dist_vers)})
    or die $dbh->errstr;
  $sth->execute();
}
# remove orphaned mods

exit 0;

sub add_mod {
  my @data =  _parse_line( shift @_ );
  return unless @data;
  unless ( _dist_exists( $data[DIST_FILE] ) ) {
    my $sth = $dbh->prepare_cached(qq{INSERT INTO dists values (?,?,?,?)}) or die $dbh->errstr;
    $sth->execute( @data[DIST_NAME,CPAN_ID,DIST_FILE,DIST_VERS] );
  }
  {
    my $sth = $dbh->prepare_cached(qq{INSERT INTO mods values (?,?,?,?,?)}) or die $dbh->errstr;
    $sth->execute( @data[MODULE,DIST_NAME,DIST_VERS,CPAN_ID,VERSION] );
  }
}

sub mod_mod {
  my @data =  _parse_line( shift @_ );
  return unless @data;
  unless ( _dist_exists( $data[DIST_FILE] ) ) {
    my $sth = $dbh->prepare_cached(qq{INSERT INTO dists values (?,?,?,?)}) or die $dbh->errstr;
    $sth->execute( @data[DIST_NAME,CPAN_ID,DIST_FILE,DIST_VERS] );
  }
  {
    my $sth = $dbh->prepare_cached(qq{UPDATE mods SET mod_name = ?, dist_name = ?, dist_vers = ?, cpan_id = ?, mod_vers = ? WHERE mod_name = ?}) or die $dbh->errstr;
    $sth->execute( @data[MODULE,DIST_NAME,DIST_VERS,CPAN_ID,VERSION,MODULE] );
  }
}

sub del_mod {
  my @data =  _parse_line( shift @_ );
  return unless @data;
  my $sth = $dbh->prepare_cached(qq{DELETE FROM mods where mod_name = ? and mod_vers = ?}) or $dbh->errstr;
  $sth->execute( @data[MODULE,VERSION] );
}

sub _dist_exists {
  my $path = shift;
  return 1 if defined $dist_cache{ $path };
  my $sth = $dbh->prepare_cached( qq{SELECT * FROM dists where dist_file = ?} ) or die $dbh->errstr;
  $sth->execute( $path );
  if ( scalar @{ $sth->fetchall_arrayref() } ) {
    return $dist_cache{ $path } = 1;
  }
  my @data =  _parse_line( shift @_ );
  return unless @data;
  my $sth = $dbh->prepare_cached(qq{DELETE FROM mods where mod_name = ? and mod_vers = ?}) or $dbh->errstr;
  $sth->execute( @data[MODULE,VERSION] );
}

sub _dist_exists {
  my $path = shift;
  return 1 if defined $dist_cache{ $path };
  my $sth = $dbh->prepare_cached( qq{SELECT * FROM dists where dist_file = ?} ) or die $dbh->errstr;
  $sth->execute( $path );
  if ( scalar @{ $sth->fetchall_arrayref() } ) {
    return $dist_cache{ $path } = 1;
  }
  return;
}

sub _mod_exists {
  my $mod = shift;
  my $sth = $dbh->prepare_cached( qq{SELECT * FROM mods where mod_name = ?} ) or die $dbh->errstr;
  $sth->execute( $mod );
  return @{ $sth->fetchall_arrayref() };
}

sub _parse_line {
  my $line = shift || return;
  my ($module,$version,$package_path) = split ' ', $line;
  my $d = CPAN::DistnameInfo->new( $package_path );
  return unless $d;
  return unless $d->extension;
  return ( $module, $version, $package_path, $d->dist, $d->cpanid, $d->pathname, $d->version );
}