/[hyperestraier_wrappers]/trunk/perl/scripts/cpanest
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 /trunk/perl/scripts/cpanest

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

revision 22 by dpavlin, Fri Sep 16 17:29:53 2005 UTC revision 23 by dpavlin, Fri Sep 16 23:29:27 2005 UTC
# Line 97  use File::Find; Line 97  use File::Find;
97  use File::Basename;  use File::Basename;
98  use IO::File;  use IO::File;
99  use IO::Zlib;  use IO::Zlib;
100    use POSIX qw/strftime/;
101    
102  use lib '/data/wait/lib';  use lib '/data/wait/lib';
103    
# Line 421  for my $tar (sort keys %ARCHIVE) { Line 422  for my $tar (sort keys %ARCHIVE) {
422    next if $OPT{match} and $ARCHIVE{$tar} !~ /$OPT{match}/o;    next if $OPT{match} and $ARCHIVE{$tar} !~ /$OPT{match}/o;
423    my $base = (split /\//, $ARCHIVE{$tar})[-1];    my $base = (split /\//, $ARCHIVE{$tar})[-1];
424    my $parent;    my $parent;
425      my $parent_mdate;
426    
427      my %attr;
428    
429    # logging    # logging
430    if ($OPT{trust_mtime}) {    if ($OPT{trust_mtime}) {
431      printf "%-20s %10s %s\t", $tar,      $attr{'@mdate'} = strftime('%Y-%m-%dT%H:%M:%S+00:00', gmtime($VERSION{$tar}));
432          substr(scalar(localtime($VERSION{$tar})),0,10), $base;      $parent_mdate = $attr{'@mdate'};
433        printf "%-20s %10s %s\t", $tar, $attr{'@mdate'}, $base;
434    } else {    } else {
435      printf "%-20s %10.5f %s\t", $tar, $VERSION{$tar}, $base;      $attr{'version'} = $VERSION{$tar};
436        printf "%-20s %10.5f %s\t", $tar, $attr{'version'}, $base;
437    }    }
438    
439    # Remember the archive    # Remember the archive
# Line 437  for my $tar (sort keys %ARCHIVE) { Line 443  for my $tar (sort keys %ARCHIVE) {
443      next ARCHIVE;      next ARCHIVE;
444    } else {    } else {
445      $parent = $tb->insert(docid    => $base,      $parent = $tb->insert(docid    => $base,
446                            headline => $ARCHIVE{$tar}) unless $OPT{test};                            headline => $ARCHIVE{$tar},
447                              %attr
448        ) unless $OPT{test};
449      print "indexing\n";      print "indexing\n";
450    }    }
451    
# Line 549  for my $tar (sort keys %ARCHIVE) { Line 557  for my $tar (sort keys %ARCHIVE) {
557      unless ($OPT{test}) {      unless ($OPT{test}) {
558        $fh->print($val);        $fh->print($val);
559        index_pod(file => $path, parent => $parent,        index_pod(file => $path, parent => $parent,
560                  text => $val,  source => $ARCHIVE{$tar});                  text => $val,  source => $ARCHIVE{$tar},
561                    mdate => $parent_mdate,
562          );
563      }      }
564    }    }
565    
# Line 628  sub index_pod { Line 638  sub index_pod {
638      $did = $abs_did;      $did = $abs_did;
639    }    }
640    if ($did) {                   # have it version    if ($did) {                   # have it version
641      if (!$parm{remove}) {      if (!$parm{remove} and !$OPT{force}) {
642        warn "duplicate: $did\n";        warn "duplicate: $did\n";
643        return;        return;
644      }      }
# Line 657  sub index_pod { Line 667  sub index_pod {
667    $record->{size} =  length($parm{'text'});    $record->{size} =  length($parm{'text'});
668    my $headline    =  $record->{name} || $did;    my $headline    =  $record->{name} || $did;
669    
670      $record->{'@mdate'} = $parm{'mdate'} if ($parm{'mdate'});
671    
672    $headline =~ s/^$DATA//o;     # $did    $headline =~ s/^$DATA//o;     # $did
673    $headline =~ s/\s+/ /g; $headline =~ s/^\s+//;    $headline =~ s/\s+/ /g; $headline =~ s/^\s+//;
674    
# Line 735  sub wanted { Line 747  sub wanted {
747    return if (! $max);    return if (! $max);
748    $max--;    $max--;
749    
750    return unless /^(.*)\.tar(\.gz|\.Z)$/;    return unless /^(.*)\.(tar\.(gz|Z)|tgz)$/;
751    
752    my ($archive, $version) = version($1);    my ($archive, $version) = version($1);
753        
# Line 943  sub insert { Line 955  sub insert {
955          my @invindex = $self->{'invindex'} || die "no invindex in object";          my @invindex = $self->{'invindex'} || die "no invindex in object";
956    
957          foreach my $attr (keys %{$args}) {          foreach my $attr (keys %{$args}) {
958                  if (grep(/^$attr$/, @{ $self->{'attr'} })) {                  if (grep(/^$attr$/, @{ $self->{'attr'} }) or $attr =~ m/^@/o) {
959                          $doc->add_attr($attr, $args->{$attr});                          $doc->add_attr($attr, $args->{$attr});
960                  }                  }
961                  if (grep(/^$attr$/, @{ $self->{'invindex'} })) {                  if (grep(/^$attr$/, @{ $self->{'invindex'} })) {

Legend:
Removed from v.22  
changed lines
  Added in v.23

  ViewVC Help
Powered by ViewVC 1.1.26