/[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 21 by dpavlin, Fri Sep 16 17:26:03 2005 UTC revision 24 by dpavlin, Sat Sep 17 00:48:32 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'} })) {
# Line 954  sub insert { Line 966  sub insert {
966          print STDERR $doc->dump_draft if ($self->{'debug'});          print STDERR $doc->dump_draft if ($self->{'debug'});
967    
968          my $id;          my $id;
969          unless ($id = $self->{'node'}->put_doc($doc)) {          unless ($self->{'node'}->put_doc($doc)) {
970                  printf STDERR "ERROR: %d\n", $self->{'node'}->status;                  printf STDERR "ERROR: %d\n", $self->{'node'}->status;
971          #} else {          } else {
972          #       print STDERR "id: $id\n";                  $id = $self->{'node'}->uri_to_id( $uri );
973                    if ($id != -1) {
974                            print STDERR "id: $id\n" if ($self->{'debug'})
975                    } else {
976                            print STDERR "ERROR: can't find id for newly insrted document $uri\n";
977                    }
978          }          }
979    
980          return $id;          return $id;
# Line 973  sub delete_by_key { Line 990  sub delete_by_key {
990          my $self = shift;          my $self = shift;
991          my $key_v = shift || die "no key?";          my $key_v = shift || die "no key?";
992    
993          my $id = $self->{'node'}->uri_to_id( 'file://' . $key_v );          unless ($self->{'node'}->out_doc_by_uri( 'file://' . $key_v )) {
994                    print STDERR "WARNING: can't delete document $key_v\n";
         if ($id == -1) {  
                 print STDERR "WARNING: can't delete document uri file://$key_v\n";  
                 return;  
         }  
   
         unless ($self->{'node'}->out_doc($id)) {  
                 print STDERR "WARNING: can't out_doc($id)\n";  
995          }          }
996  }  }
997    

Legend:
Removed from v.21  
changed lines
  Added in v.24

  ViewVC Help
Powered by ViewVC 1.1.26