/[wait]/cvs-head/script/cpanwait
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /cvs-head/script/cpanwait

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 85 by ulpfr, Fri Apr 28 15:40:52 2000 UTC revision 86 by dpavlin, Mon May 24 13:41:28 2004 UTC
# Line 1  Line 1 
1  #!/usr/local/perl5.005_56.Mar06/bin/perl -w  #!/usr/bin/perl -w
2  ######################### -*- Mode: Perl -*- #########################  ######################### -*- Mode: Perl -*- #########################
3  ##  ##
4  ## $Basename: cpanwait $  ## $Basename: cpanwait $
# Line 15  Line 15 
15  ##  ##
16  ######################################################################  ######################################################################
17    
 eval 'exec perl -S $0 "$@"'  
   if 0;  
   
   
18  use strict;  use strict;
19    
20  use File::Path;  use File::Path;
# Line 28  use File::Find; Line 24  use File::Find;
24  use File::Basename;  use File::Basename;
25  use IO::File;  use IO::File;
26    
27    use lib '/data/wait/lib';
28    
29  require WAIT::Config;  require WAIT::Config;
30  require WAIT::Database;  require WAIT::Database;
31  require WAIT::Parse::Pod;  require WAIT::Parse::Pod;
32  require WAIT::Document::Tar;  require WAIT::Document::Tar;
33    
34    sub fname($);
35    
36    # maximum number of archives to index (set to -1 for unlimited)
37    my $max = -1;
38    
39  my %OPT = (database    => 'DB',  my %OPT = (database    => 'DB',
40             dir         => $WAIT::Config->{WAIT_home} || '/tmp',             dir         => $WAIT::Config->{WAIT_home} || '/tmp',
# Line 40  my %OPT = (database    => 'DB', Line 42  my %OPT = (database    => 'DB',
42             clean       => 0,             clean       => 0,
43             remove      => [],             remove      => [],
44             force       => 0,             force       => 0,
45             cpan        => '/usr/src/perl/CPAN/sources',  #           cpan        => '/usr/src/perl/CPAN/sources',
46               cpan        => '/rest/cpan/CPAN/',
47             trust_mtime => 1,             trust_mtime => 1,
48             match       => 'authors/id/',             match       => 'authors/id/',
49             test        => 0,             test        => 0,
50  #            cpan        => 'ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN',  #            cpan        => 'ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN',
51             cpan        => 'ftp://ftp.uni-hamburg.de:/pub/soft/lang/perl/CPAN',  #           cpan        => 'ftp://ftp.uni-hamburg.de:/pub/soft/lang/perl/CPAN',
52             keep        => '/app/unido-i06/src/share/lang/perl/96a/CPAN/sources',             keep        => '/tmp/CPAN/',
53            );            );
54    
55  GetOptions(\%OPT,  GetOptions(\%OPT,
# Line 64  GetOptions(\%OPT, Line 67  GetOptions(\%OPT,
67             'remove=s@',             'remove=s@',
68             'force!',            # force indexing even if seen             'force!',            # force indexing even if seen
69             'trust_mtime!',      # use mtime instead of version number             'trust_mtime!',      # use mtime instead of version number
70               'max=i',
71               'reorg!',
72            ) || die "Usage: ...\n";            ) || die "Usage: ...\n";
73    
74    $max ||= $OPT{max};
75    
76  clean_database(  clean_database(
77                 database => $OPT{database},                 database => $OPT{database},
# Line 228  for my $tar (sort keys %ARCHIVE) { Line 234  for my $tar (sort keys %ARCHIVE) {
234    my %tar;    my %tar;
235    tie (%tar,    tie (%tar,
236         'WAIT::Document::Tar',         'WAIT::Document::Tar',
237         sub { $_[0] =~ /\.(pm|pod|PL)$/ or $_[0] =~ /readme/i},         sub { $_[0] =~ /\.(pm|pod|PL)$/i or $_[0] =~ /readme/i},
238         #sub { $_[0] !~ m:/$: },         #sub { $_[0] !~ m:/$: },
239         $TAR)         $TAR)
240      or warn "Could not tie '$TAR'\n";      or warn "Could not tie '$TAR'\n";
# Line 344  if (%NEW_ALIAS) { Line 350  if (%NEW_ALIAS) {
350    print "\t);\n";    print "\t);\n";
351  }  }
352    
353    if ($OPT{reorg}) {
354            my $now = time;
355            warn "Starting reorg\n";
356            $tb->set(top=>1);
357            warn sprintf "Finished reorg %d seconds\n", time - $now;
358    }
359    
360  # we are done  # we are done
361  $db->close();  $db->close();
362  exit;  exit;
# Line 382  sub myget { Line 395  sub myget {
395          return;          return;
396        }        }
397      }      }
398      } else {
399            $TAR = $ARCHIVE{$tar};
400    }    }
401    $TAR;    $TAR;
402  }  }
# Line 425  sub index_pod { Line 440  sub index_pod {
440    }    }
441    
442    my $record      =  $layout->split($parm{'text'});    my $record      =  $layout->split($parm{'text'});
443    
444      if (! $record) {
445            print "empty pod: $did\n";
446            return;
447      }
448    
449    $record->{size} =  length($parm{'text'});    $record->{size} =  length($parm{'text'});
450    my $headline    =  $record->{name} || $did;    my $headline    =  $record->{name} || $did;
451    
# Line 504  sub wanted { Line 525  sub wanted {
525    my $mtime = shift;            # called by parse_file_ls();    my $mtime = shift;            # called by parse_file_ls();
526    
527    return unless /^(.*)\.tar(\.gz|\.Z)$/;    return unless /^(.*)\.tar(\.gz|\.Z)$/;
528    
529      return if (! $max);
530      $max--;
531    
532    my ($archive, $version) = version($1);    my ($archive, $version) = version($1);
533        
534    unless (defined $version) {    unless (defined $version) {
# Line 630  __END__ Line 655  __END__
655    
656  =head1 NAME  =head1 NAME
657    
658  cpan - generate an WAIT index for CPAN  cpanwait - generate an WAIT index for CPAN
659    
660  =head1 SYNOPSIS  =head1 SYNOPSIS
661    
662  B<cpan>  B<cpanwait>
663  [B<-clean>] [B<-noclean>]  [B<-clean>] [B<-noclean>]
664  [B<-cpan> I<url or directory>]  [B<-cpan> I<url or directory>]
665  [B<-database> I<dbname>]  [B<-database> I<dbname>]
Legend:
Removed from v.85  
changed lines
  Added in v.86
  ViewVC Help
Powered by ViewVC 1.1.26