X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FStatus.pm;h=e70643fbe6244f86c799b9149e4fc44e51a653bf;hb=cb2d3bceada187525f182c9ea7c7d4f5e93fefce;hp=8b4b9b045164363d14371e5336223ac20f373663;hpb=db5e575472230b597ceb8c1017ffcf0ad73ca539;p=debbugs.git

diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index 8b4b9b0..e70643f 100644
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -44,6 +44,7 @@ use Debbugs::Packages qw(makesourceversions make_source_versions getversions get
 use Debbugs::Versions;
 use Debbugs::Versions::Dpkg;
 use POSIX qw(ceil);
+use File::Copy qw(copy);
 
 use Storable qw(dclone);
 use List::Util qw(min max);
@@ -62,6 +63,7 @@ BEGIN{
 				qw(lock_read_all_merged_bugs),
 			       ],
 		     write  => [qw(writebug makestatus unlockwritebug)],
+		     new => [qw(new_bug)],
 		     versions => [qw(addfoundversions addfixedversions),
 				  qw(removefoundversions removefixedversions)
 				 ],
@@ -69,7 +71,7 @@ BEGIN{
 		     fields   => [qw(%fields)],
 		    );
      @EXPORT_OK = ();
-     Exporter::export_ok_tags(qw(status read write versions hook fields));
+     Exporter::export_ok_tags(keys %EXPORT_TAGS);
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
@@ -143,6 +145,10 @@ path to the summary file instead of the bug number and/or location.
 something modifying it while the bug has been read. You B<must> call
 C<unfilelock();> if something not undef is returned from read_bug.
 
+=item locks -- hashref of already obtained locks; incremented as new
+locks are needed, and decremented as locks are released on particular
+files.
+
 =back
 
 One of C<bug> or C<summary> must be passed. This function will return
@@ -171,6 +177,9 @@ sub read_bug{
 					 lock     => {type => BOOLEAN,
 						      optional => 1,
 						     },
+					 locks    => {type => HASHREF,
+						      optional => 1,
+						     },
 					},
 			     );
     die "One of bug or summary must be passed to read_bug"
@@ -197,13 +206,13 @@ sub read_bug{
 	 ($location) = $status =~ m/(db-h|db|archive)/;
     }
     if ($param{lock}) {
-	filelock("$config{spool_dir}/lock/$param{bug}");
+	filelock("$config{spool_dir}/lock/$param{bug}",exists $param{locks}?$param{locks}:());
     }
     my $status_fh = IO::File->new($status, 'r');
     if (not defined $status_fh) {
 	warn "Unable to open $status for reading: $!";
 	if ($param{lock}) {
-	    unfilelock();
+		unfilelock(exists $param{locks}?$param{locks}:());
 	}
 	return undef;
     }
@@ -223,7 +232,7 @@ sub read_bug{
     if ($version > 3) {
 	 warn "Unsupported status version '$version'";
 	 if ($param{lock}) {
-	     unfilelock();
+	     unfilelock(exists $param{locks}?$param{locks}:());
 	 }
 	 return undef;
     }
@@ -435,9 +444,24 @@ even if all of the others were read properly.
 =cut
 
 sub lock_read_all_merged_bugs {
-    my ($bug_num,$location) = @_;
+    my %param = validate_with(params => \@_,
+			      spec   => {bug => {type => SCALAR,
+						 regex => qr/^\d+$/,
+						},
+					 location => {type => SCALAR,
+						      optional => 1,
+						     },
+					 locks    => {type => HASHREF,
+						      optional => 1,
+						     },
+					},
+			     );
     my $locks = 0;
-    my @data = (lockreadbug(@_));
+    my @data = read_bug(bug => $param{bug},
+			lock => 1,
+			exists $param{location} ? (location => $param{location}):(),
+			exists $param{locks} ? (locks => $param{locks}):(),
+		       );
     if (not @data or not defined $data[0]) {
 	return ($locks,());
     }
@@ -445,46 +469,111 @@ sub lock_read_all_merged_bugs {
     if (not length $data[0]->{mergedwith}) {
 	return ($locks,@data);
     }
-    unfilelock();
+    unfilelock(exists $param{locks}?$param{locks}:());
     $locks--;
-    filelock("$config{spool_dir}/lock/merge");
+    filelock("$config{spool_dir}/lock/merge",exists $param{locks}?$param{locks}:());
     $locks++;
-    @data = (lockreadbug(@_));
+    @data = read_bug(bug => $param{bug},
+		     lock => 1,
+		     exists $param{location} ? (location => $param{location}):(),
+		     exists $param{locks} ? (locks => $param{locks}):(),
+		    );
     if (not @data or not defined $data[0]) {
-	unfilelock(); #for merge lock above
+	unfilelock(exists $param{locks}?$param{locks}:()); #for merge lock above
 	$locks--;
 	return ($locks,());
     }
     $locks++;
     my @bugs = split / /, $data[0]->{mergedwith};
+    push @bugs, $param{bug};
     for my $bug (@bugs) {
 	my $newdata = undef;
-	if ($bug ne $bug_num) {
-	    $newdata = lockreadbug($bug,$location);
+	if ($bug != $param{bug}) {
+	    $newdata =
+		read_bug(bug => $bug,
+			 lock => 1,
+			 exists $param{location} ? (location => $param{location}):(),
+			 exists $param{locks} ? (locks => $param{locks}):(),
+			);
 	    if (not defined $newdata) {
 		for (1..$locks) {
-		    unfilelock();
+		    unfilelock(exists $param{locks}?$param{locks}:());
 		}
 		$locks = 0;
-		warn "Unable to read bug: $bug while handling merged bug: $bug_num";
+		warn "Unable to read bug: $bug while handling merged bug: $param{bug}";
 		return ($locks,());
 	    }
 	    $locks++;
 	    push @data,$newdata;
-	}
-	# perform a sanity check to make sure that the merged bugs are
-	# all merged with eachother
-	my $expectmerge= join(' ',grep {$_ != $bug } sort { $a <=> $b } (@bugs,$bug_num));
-	if ($newdata->{mergedwith} ne $expectmerge) {
-	    for (1..$locks) {
-		unfilelock();
+	    # perform a sanity check to make sure that the merged bugs
+	    # are all merged with eachother
+	    my $expectmerge= join(' ',grep {$_ != $bug } sort { $a <=> $b } @bugs);
+	    if ($newdata->{mergedwith} ne $expectmerge) {
+		for (1..$locks) {
+		    unfilelock(exists $param{locks}?$param{locks}:());
+		}
+		die "Bug $param{bug} differs from bug $bug: ($newdata->{bug_num}: '$newdata->{mergedwith}') vs. ('$expectmerge') (".join(' ',@bugs).")";
 	    }
-	    die "Bug $bug_num differs from bug $bug: ($newdata->{bug_num}: $newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")";
 	}
     }
     return ($locks,@data);
 }
 
+=head2 new_bug
+
+	my $new_bug_num = new_bug(copy => $data->{bug_num});
+
+Creates a new bug and returns the new bug number upon success.
+
+Dies upon failures.
+
+=cut
+
+sub new_bug {
+    my %param =
+	validate_with(params => \@_,
+		      spec => {copy => {type => SCALAR,
+				        regex => qr/^\d+/,
+				        optional => 1,
+				       },
+			      },
+		     );
+    filelock("nextnumber.lock");
+    my $nn_fh = IO::File->new("nextnumber",'r') or
+	die "Unable to open nextnuber for reading: $!";
+    local $\;
+    my $nn = <$nn_fh>;
+    ($nn) = $nn =~ m/^(\d+)\n$/ or die "Bad format of nextnumber; is not exactly ".'^\d+\n$';
+    close $nn_fh;
+    overwritefile("nextnumber",
+		  ($nn+1)."\n");
+    my $nn_hash = get_hashname($nn);
+    use IO::File;
+    my $t_fh = IO::File->new("/home/don/temp.txt",'a') or die "Unable to open ~don/temp.txt for writing: $!";
+    use Data::Dumper;
+    print {$t_fh} Dumper({%param,nn => $nn, nn_hash => $nn_hash, nextnumber => qx(cat nextnumber)});
+    close $t_fh;
+    if ($param{copy}) {
+	my $c_hash = get_hashname($param{copy});
+	for my $file (qw(log status summary report)) {
+	    copy("db-h/$c_hash/$param{copy}.$file",
+		 "db-h/$nn_hash/${nn}.$file")
+	}
+    }
+    else {
+	for my $file (qw(log status summary report)) {
+	    overwritefile("db-h/$nn_hash/${nn}.$file",
+			   "");
+	}
+    }
+
+    # this probably needs to be munged to do something more elegant
+#    &bughook('new', $clone, $data);
+
+    return($nn);
+}
+
+
 
 my @v1fieldorder = qw(originator date subject msgid package
                       keywords done forwarded mergedwith severity);
@@ -608,7 +697,7 @@ options mean.
 
 sub unlockwritebug {
     writebug(@_);
-    &unfilelock;
+    unfilelock();
 }
 
 =head1 VERSIONS
@@ -845,7 +934,7 @@ sub bug_archiveable{
      }
      # Check to make sure that the bug has none of the unremovable tags set
      if (@{$config{removal_unremovable_tags}}) {
-	  for my $tag (split ' ', ($status->{tags}||'')) {
+	  for my $tag (split ' ', ($status->{keywords}||'')) {
 	       if (grep {$tag eq $_} @{$config{removal_unremovable_tags}}) {
 		    print STDERR "Cannot archive $param{bug} because it has an unremovable tag '$tag'\n" if $DEBUG;
 		    return $cannot_archive;
@@ -890,7 +979,7 @@ sub bug_archiveable{
 	  @dist_tags{@{$config{removal_distribution_tags}}} =
 	       (1) x @{$config{removal_distribution_tags}};
 	  my %dists;
-	  for my $tag (split ' ', ($status->{tags}||'')) {
+	  for my $tag (split ' ', ($status->{keywords}||'')) {
 	       next unless exists $config{distribution_aliases}{$tag};
 	       next unless $dist_tags{$config{distribution_aliases}{$tag}};
 	       $dists{$config{distribution_aliases}{$tag}} = 1;
@@ -1198,7 +1287,7 @@ sub bug_presence {
 		    (1) x @{$config{affects_distribution_tags}};
 	       my $some_distributions_disallowed = 0;
 	       my %allowed_distributions;
-	       for my $tag (split ' ', ($status{tags}||'')) {
+	       for my $tag (split ' ', ($status{keywords}||'')) {
 		   if (exists $config{distribution_aliases}{$tag} and
 			exists $affects_distribution_tags{$config{distribution_aliases}{$tag}}) {
 		       $some_distributions_disallowed = 1;
@@ -1506,23 +1595,23 @@ sub update_realtime {
 
 sub bughook_archive {
 	my @refs = @_;
-	&filelock("$config{spool_dir}/debbugs.trace.lock");
-	&appendfile("debbugs.trace","archive ".join(',',@refs)."\n");
+	filelock("$config{spool_dir}/debbugs.trace.lock");
+	appendfile("$config{spool_dir}/debbugs.trace","archive ".join(',',@refs)."\n");
 	my %bugs = update_realtime("$config{spool_dir}/index.db.realtime",
 				   map{($_,'REMOVE')} @refs);
 	update_realtime("$config{spool_dir}/index.archive.realtime",
 			%bugs);
-	&unfilelock;
+	unfilelock();
 }
 
 sub bughook {
 	my ( $type, %bugs_temp ) = @_;
-	&filelock("$config{spool_dir}/debbugs.trace.lock");
+	filelock("$config{spool_dir}/debbugs.trace.lock");
 
 	my %bugs;
 	for my $bug (keys %bugs_temp) {
 	     my $data = $bugs_temp{$bug};
-	     &appendfile("debbugs.trace","$type $bug\n",makestatus($data, 1));
+	     appendfile("$config{spool_dir}/debbugs.trace","$type $bug\n",makestatus($data, 1));
 
 	     my $whendone = "open";
 	     my $severity = $config{default_severity};
@@ -1540,7 +1629,7 @@ sub bughook {
 	}
 	update_realtime("$config{spool_dir}/index.db.realtime", %bugs);
 
-	&unfilelock;
+	unfilelock();
 }