#!/usr/bin/perl
#                              -*- Mode: Perl -*- 
# Author          : Ulrich Pfeifer
# Created On      : Wed Jan  7 15:04:13 1998
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Sun Mar 19 10:18:56 2006
# Language        : CPerl
# Update Count    : 59
# Status          : Unknown, Use with caution!
#
# (C) Copyright 1998,2005,2006 Ulrich Pfeifer, all rights reserved.

use strict;
use English qw( -no_match_vars );
use IO::File;
use CPAN::Checksums qw(updatedir);
use File::Find;

my $VERSION = "0.030";

my $CPAN = shift;

die "No such directory '$CPAN'\n" unless -d $CPAN;

mkdir "$CPAN/site", 0755 or die "mkdir $CPAN/site: $!"
  unless -d "$CPAN/site";

unless (-f "$CPAN/site/01mailrc.txt.gz" ) {
  new IO::File "|gzip >$CPAN/site/01mailrc.txt.gz"
    or die "touch $CPAN/site/01mailrc.txt.gz: $!\n";
}

if (-f "$CPAN/site/02packages.details.txt.gz") {
  rename
    "$CPAN/site/02packages.details.txt.gz",
    "$CPAN/site/02packages.details.txt.gz.bak"
      or die "renaming $CPAN/site/02packages.details.txt.gz\n";
}

my $fh = new IO::File "|gzip >$CPAN/site/02packages.details.txt.gz"
  or die "Generating $CPAN/site/02packages.details.txt.gz: $!\n";

my %VERSION;
my %DIRS_TO_CHECKSUM;
my %PATH;
my $DEBUG;
my $TAR_GZ_REGEX = qr/ \. tar \. (gz|Z) $/x;

find(\&wanted, "$CPAN/authors/id");

sub register {
  my ($file, $package, $version, $path) = @_;

  warn "($file, $package, $version, $path)\n" if $DEBUG;
  if ($file =~ /\.pm$/) {
    next if exists $VERSION{$package} and $VERSION{$package} ge $version;
    ($PATH{$package} = $path) =~ s!$CPAN/authors/id/!!;
    $VERSION{$package} =
      (defined $version and $version ne '') ? $version : 'undef';
  }
}

sub wanted {
  return unless -f $_;
  return unless /$TAR_GZ_REGEX/o;
  $DIRS_TO_CHECKSUM{$File::Find::dir}++;

  my $readme_file;
  warn "processing $File::Find::name ...\n";
  $readme_file = $_;
  $readme_file =~ s/\.tar\.(gz|Z)$/\/README/;
  warn "README file $readme_file\n" if $DEBUG;
  my $fh = new IO::File "gzip -cd $_|"
    or die "gzip $File::Find::name: $!\n";
  my ($file, $package, $version);
  my $in_buf  = '';
  my $out_buf = '';

  my $in_readme = 0;
BLOCK:
  while ($fh->sysread($in_buf, 512)) {
    if ($in_buf =~ /^(\S*?)\0/) {
      $file = $1;
      warn "file=$file\n" if $DEBUG and length $file;
      if ($file eq $readme_file) {
          $in_readme = 1;
          my $output_filename = $readme_file;
          $output_filename =~ s/\/README$/\.readme/; # Assumes Unix paths
          open README_FILE, ">$output_filename" ||
             die "Could not open .readme file $output_filename $!";
          warn "Creating README file: $output_filename\n" if $DEBUG;
      } else {
          $in_readme = 0;
          close README_FILE;
      }
      undef $package;
      undef $version;
      $out_buf = '';
      next BLOCK;
    }

    if ($in_readme) {
        print README_FILE substr($in_buf, 0, index($in_buf, "\0"));
    }

    $out_buf .= $in_buf;
    while ($out_buf =~ s/^([^\n]*)\n//) {
      local $_ = $1;
      if (/^\s* package \s* ((\w+::)*\w+) \s* ;/x) {
        $package = $1;
        warn "package=$package\n" if $DEBUG;
      } elsif (/^ \s* (?: \$ (\w+::)* VERSION \s* = \s* )+ (.*) $/x) {
        warn 'package foo; ' . $2 . "\n" if $DEBUG;
        $version = eval 'package foo; ' . $2;
        warn "version=$version\n" if $DEBUG;
        register($file, $package, $version, $File::Find::name)
          if $file and $package;
      }
    }
  }
}
print STDERR "$0 VERSION $VERSION\n";
my $lines = keys %VERSION;
my $date  = gmtime;
$fh->print (<<EOH)
File:         02packages.details.txt
URL:          http://www.perl.com/CPAN/site/02packages.details.txt
Description:  Package names found in directory $CPAN/authors/id/
Columns:      package name, version, path
Intended-For: Automated fetch routines, namespace documentation.
Line-Count:   $lines
Written-By:   $0 $VERSION Ulrich Pfeifer <pfeifer\@wait.de>
Last-Updated: $date GMT

EOH
  ;
for my $pack (sort keys %VERSION) {
  $fh->printf("%-30s\t%s\t%s\n", $pack,  $VERSION{$pack}, $PATH{$pack});
}

#
# part2: generating checksums
#

foreach my $dir (keys %DIRS_TO_CHECKSUM) {
  warn "$dir - Updating CHECKSUMS" if $DEBUG;
  my $success = updatedir($dir); # From CPAN::Checksums
  if ( $success ) {
    warn "$dir - CHECKSUMS updated" if $DEBUG;
  }
}

__END__

=head1 NAME

mkpackages -- generate CPAN.pm conformant 02packages.details.txt.gz

=head1 SYNOPSIS

B<mkpackages> I<pseudo_CPAN_root>

=head1 WARNING

This is not even alpha software and will be made obsolete by CPAN.pm
extensions some day.

=head1 DESCRIPTION

This programs traverses I<pseudo_CPAN_root>F</authors/id> and
generates I<pseudo_CPAN_root>F</site/02packages.details.txt.gz>.

It also will extract a README files from TAR balls in the
F</authors/id> directories.

=head1 FILES

=over

=item I<pseudo_CPAN_root>F</site/02packages.details.txt.gz>

=item I<pseudo_CPAN_root>F</site/01mailrc.txt.gz>

Generated as empty file if missing.

=item I<pseudo_CPAN_root>F</autors/id/**/CHECKSUMS>

F<CHECKSUMS> fiels are generated in all directories below
I<pseudo_CPAN_root>F</autors/id/>.

=back

=head1 SEE ALSO

CPAN::Site(3)

=head1 AUTHOR

Ulrich Pfeifer E<lt>F<pfeifer@wait.de>E<gt>

=cut
