--- trunk/perl/scripts/cpanest	2005/09/16 17:26:03	21
+++ trunk/perl/scripts/cpanest	2005/09/17 00:48:32	24
@@ -97,6 +97,7 @@
 use File::Basename;
 use IO::File;
 use IO::Zlib;
+use POSIX qw/strftime/;
 
 use lib '/data/wait/lib';
 
@@ -421,13 +422,18 @@
   next if $OPT{match} and $ARCHIVE{$tar} !~ /$OPT{match}/o;
   my $base = (split /\//, $ARCHIVE{$tar})[-1];
   my $parent;
+  my $parent_mdate;
+
+  my %attr;
 
   # logging
   if ($OPT{trust_mtime}) {
-    printf "%-20s %10s %s\t", $tar,
-        substr(scalar(localtime($VERSION{$tar})),0,10), $base;
+    $attr{'@mdate'} = strftime('%Y-%m-%dT%H:%M:%S+00:00', gmtime($VERSION{$tar}));
+    $parent_mdate = $attr{'@mdate'};
+    printf "%-20s %10s %s\t", $tar, $attr{'@mdate'}, $base;
   } else {
-    printf "%-20s %10.5f %s\t", $tar, $VERSION{$tar}, $base;
+    $attr{'version'} = $VERSION{$tar};
+    printf "%-20s %10.5f %s\t", $tar, $attr{'version'}, $base;
   }
 
   # Remember the archive
@@ -437,7 +443,9 @@
     next ARCHIVE;
   } else {
     $parent = $tb->insert(docid    => $base,
-                          headline => $ARCHIVE{$tar}) unless $OPT{test};
+                          headline => $ARCHIVE{$tar},
+			  %attr
+    ) unless $OPT{test};
     print "indexing\n";
   }
 
@@ -549,7 +557,9 @@
     unless ($OPT{test}) {
       $fh->print($val);
       index_pod(file => $path, parent => $parent,
-                text => $val,  source => $ARCHIVE{$tar});
+                text => $val,  source => $ARCHIVE{$tar},
+		mdate => $parent_mdate,
+      );
     }
   }
 
@@ -628,7 +638,7 @@
     $did = $abs_did;
   }
   if ($did) {                   # have it version
-    if (!$parm{remove}) {
+    if (!$parm{remove} and !$OPT{force}) {
       warn "duplicate: $did\n";
       return;
     }
@@ -657,6 +667,8 @@
   $record->{size} =  length($parm{'text'});
   my $headline    =  $record->{name} || $did;
 
+  $record->{'@mdate'} = $parm{'mdate'} if ($parm{'mdate'});
+
   $headline =~ s/^$DATA//o;     # $did
   $headline =~ s/\s+/ /g; $headline =~ s/^\s+//;
 
@@ -735,7 +747,7 @@
   return if (! $max);
   $max--;
 
-  return unless /^(.*)\.tar(\.gz|\.Z)$/;
+  return unless /^(.*)\.(tar\.(gz|Z)|tgz)$/;
 
   my ($archive, $version) = version($1);
   
@@ -943,7 +955,7 @@
 	my @invindex = $self->{'invindex'} || die "no invindex in object";
 
 	foreach my $attr (keys %{$args}) {
-		if (grep(/^$attr$/, @{ $self->{'attr'} })) {
+		if (grep(/^$attr$/, @{ $self->{'attr'} }) or $attr =~ m/^@/o) {
 			$doc->add_attr($attr, $args->{$attr});
 		}
 		if (grep(/^$attr$/, @{ $self->{'invindex'} })) {
@@ -954,10 +966,15 @@
 	print STDERR $doc->dump_draft if ($self->{'debug'});
 
 	my $id;
-	unless ($id = $self->{'node'}->put_doc($doc)) {
+	unless ($self->{'node'}->put_doc($doc)) {
 		printf STDERR "ERROR: %d\n", $self->{'node'}->status;
-	#} else {
-	#	print STDERR "id: $id\n";
+	} else {
+		$id = $self->{'node'}->uri_to_id( $uri );
+		if ($id != -1) {
+			print STDERR "id: $id\n" if ($self->{'debug'})
+		} else {
+			print STDERR "ERROR: can't find id for newly insrted document $uri\n";
+		}
 	}
 
 	return $id;
@@ -973,15 +990,8 @@
 	my $self = shift;
 	my $key_v = shift || die "no key?";
 
-	my $id = $self->{'node'}->uri_to_id( 'file://' . $key_v );
-
-	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";
+	unless ($self->{'node'}->out_doc_by_uri( 'file://' . $key_v )) {
+		print STDERR "WARNING: can't delete document $key_v\n";
 	}
 }