Re: [devel] l'araignée

[Nicolas Bertolissio <nico.bertol-no-spam@free.fr>]

Le lundi 23 août 2004, Nicolas Bertolissio écrit :
> Bonjour,
> 
> j'ai récupéré l'araignée de Martin avant qu'Alioth ne tombe en carafe,
> je l'ai modifiée et elle semble fonctionner avec les pages du site.
> 
> il faut que je vérifie encore quelques trucs, et que j'en améliore
> d'autres mais c'est en bonne voie.
> 
> ça m'a pris toute la journée, surtout à cause d'erreurs stupides et
> assez difficiles à trouver, cela dit je me suis bien amusé quand même.
> 
> la suite le week-end prochain, avec une version en ligne j'espère.

Bon, j'ai pas pu attendre ;)

Quelqu'un pourrait-il vérifier ça ? c'est pas très propre, mais ça a
l'air de marcher. Le but est de pouvoir supprimer une ligne d'état
lorsuq'il y en a plusieurs. Il faudra ajouter d'autre tests et rendre ça
un peu plus joli.


Nicolas
-- 

--- Db.pm.old	2004-08-24 20:01:41.000000000 +0200
+++ Db.pm	2004-08-24 19:44:02.000000000 +0200
@@ -37,6 +37,7 @@
 use strict;
 use Time::localtime;
 use File::Path;
+use Data::Dumper;
 
 #   Do not use ``our'' to be compatible with Perl 5.005
 use vars (qw($AUTOLOAD));
@@ -58,7 +59,7 @@
 	        #   as fields of a package called '' (that's the same trick than in po files)
 	        
 	        # Language Year Month Message are for the spider
-	        headers => [qw{Date Language Year Month Message}],
+	        headers => [qw{Date Language Year Month Message Page}],
                 #   Fields below are written into file in the same order
                 #   Package must always be the first field
 	    
@@ -332,7 +333,7 @@
 =cut
 
 sub set_status {
-    my ($db,$pkg,$type,$file,$date,$status,$translator,$url,$bug_nb) = @_;
+    my ($db,$pkg,$type,$file,$date,$status,$translator,$list,$url,$bug_nb) = @_;
 
     foreach my $line (@{$db->{data}->{$pkg}->{STATUS}}) {
 	if (${$line}[0] eq $type) {
@@ -340,25 +341,42 @@
 	    ${$line}[2] = $date;
 	    ${$line}[3] = $status;
 	    ${$line}[4] = $translator;
-	    ${$line}[5] = $url;
-	    ${$line}[6] = $bug_nb;
+	    ${$line}[5] = $list;
+	    ${$line}[6] = $url;
+	    ${$line}[7] = $bug_nb;
 	    return
 	}
     }
-    $db->add_status($pkg,$type,$file,$date,$status,$translator,$url,$bug_nb);
+    $db->add_status($pkg,$type,$file,$date,$status,$translator,$list,$url,$bug_nb);
 }
 
 =item del_status
 
 Del the package if there was only one status line. 
+If a reference to a statusline is provided, it removes the first found
 It should remove the right line from the DB, and empty the package if nothing else is left.
 
 =cut
 
 sub del_status {
-    my ($db,$pkg,$type) = @_;
+    my ($db,$pkg,$type,$statusline) = @_;
     if (scalar @{$db->{data}->{$pkg}->{STATUS}} == 1) {
 	$db->clear_pkg($pkg);
+    } elsif ($statusline) {
+	for (my $i=0; $i < @{$db->{data}->{$pkg}->{STATUS}}; $i++) {
+	    my @a = @$statusline;
+	    my @b = @{$db->{data}->{$pkg}->{STATUS}->[$i]};
+	    my $ok = 1;
+	    while (scalar @a) {
+		next if (shift(@a) eq shift(@b));
+		$ok = 0;
+		last;
+	    }
+	    next unless $ok;
+	    splice @{$db->{data}->{$pkg}->{STATUS}}, $i, 1;
+	    last;
+	}
+	print "Cannot del_status, statusline not found\n" unless $ok;
     } else {
 	print "Ups, sorry, cannot del_status when there is more than one status field in the pkg\n";
     }

Attachment: signature.asc
Description: Digital signature