> I believe that it is not good, we should keep all revisions.
I do not think so (so = should keep all),
so no more suggestions will be followed from me :)
> By the way, the same problem holds for parse-dla.pl and DLAs.
as everyone know, most of the same code can be used
when the one for dsa completed
Q. who will do it?
A. of course the one who needs it :)
attached script is an appendix from me :)
--
victory
no need to CC me :-)
#!/usr/bin/perl
use strict;
use File::Basename;
=head1 map-dsa-dla: maps dsa*** <=> dla***
replicates relation data for consistency.
This script is intended to use on the commiter's local machine,
not on a server as changes for vcs managed file without manual
involvement may rise issues.
NOTE:
As how the script works, if wrong data was written
you will need to remove from both data files.
=head2 sub routines:
=over
=cut
my $tn = "reladv"; # name of the tag
my $bd = dirname($0);
$bd .= "/test";
my $mapfile = "$bd/map-dsa-dla.txt";
# %s_y: key=dsa#,val=its year; %dsa: key=dsa#,val=its rel adv
# %l_y: key=dla#,val=its year; %dla: key=dsa#,val=its rel adv
# %mod: key=d[sl]a-#,val=its rel adv;
# %mod collects only advs that will be updated from reverse ref
my (%s_y, %l_y, %dsa, %dla, %mod);
# collect data
&ay;
# collects relative dsa/dlas from *.data files
my $c;
$c .= "dsa:\n";
foreach my $d(sort{$a<=>$b} keys %s_y){
my $f = "$bd/$s_y{$d}/dsa-$d.data";
next unless (-f $f);
$c .= " $s_y{$d}/dsa-$d: ";
my $r = r($f);
$dsa{$d} = $r if ($r);
$c .= $r if ($r);
$c .= "\n";
}
$c .= "dla:\n";
foreach my $d(sort{$a<=>$b} keys %l_y){
my $f = "$bd/$l_y{$d}/dla-$d.data";
next unless (-f $f);
$c .= " $l_y{$d}/dla-$d: ";
my $r = r($f);
$dla{$d} = $r if ($r);
$c .= $r if ($r);
$c .= "\n";
}
# checks if updates needed
foreach my $d(sort{$dsa{$a}<=>$dsa{$b}} keys %dsa){
rev("s", $d, $dsa{$d}) if ($dsa{$d});
}
foreach my $d(sort{$dla{$a}<=>$dla{$b}} keys %dla){
rev("l", $d, $dla{$d}) if ($dla{$d});
}
# apply needed updated
foreach my $d(sort keys %mod){
$c .= "added: [$d -> $mod{$d}]\n";
my $n = $d =~ s/\D//gr;
my $f;
$f = "$bd/$s_y{$n}/$d.data" if (substr($d,0,3) eq "dsa");
$f = "$bd/$l_y{$n}/$d.data" if (substr($d,0,3) eq "dla");
w($f, rd($f, $mod{$d}));
}
w($mapfile, $c);
exit;
=item ay:
maps a year to advisories#
=cut
sub ay{
my $t = (-f $mapfile && stat($mapfile) && (stat($mapfile))[9]) ? (stat($mapfile))[9] : 0;
print $t;
for (2014 .. 2099){
my $y = $_;
opendir(my $dh, "$bd/$y") or next;
while (readdir $dh) {
chomp;
next if /^\.wml$/;
next if /^Makefile$/;
next unless(-f "$bd/$y/$_");
$s_y{substr($_,4,-5)} = $y if(/^dsa-\d+.data$/);
$l_y{substr($_,4,-5)} = $y if(/^dla-\d+.data$/);
}
close($dh);
}
}
=item r(file):
read a *.data file and returns reladv content
=cut
sub r{
my $f = shift;
open(my $d, "<", $f);
my $r;
while (<$d>) {
$r = e($_);
last if $r;
}
close $d;
return $r;
}
=item e(data):
extract and returns reladv content
=cut
sub e{
my $d = shift;
return unless(substr($d,0,(length($tn)+13)) eq "<define-tag $tn>");
chomp $d;
$d = substr($d,(length($tn)+13),-13);
return lc($d);
}
=item rev([sl],d[sl]a,rel):
extract reladv content and make reverse rels
=cut
sub rev{
my $c = shift;
my $d = shift;
my $r = shift;
$c = "d${c}a";
foreach(split(/[, ]+/),$r){
s/[, ]//g;
next if (/bug/i);
add("s", $_, "$c-$d") if(substr($_,0,3) eq "dsa");
add("l", $_, "$c-$d") if(substr($_,0,3) eq "dla");
}
}
=item add("[sl]",d[sl]a,rel):
check whether a reladv exists in the reffered adv, and add if not exist
%mod keeps modified data
=cut
sub add{
my $c = shift;
my $d = shift;
my $r = shift;
my $n = $d =~ s/\D//gr;
return if($c eq "s" && $dsa{$n} =~ /$r\b/i);
return if($c eq "s" && $dsa{$n} =~ /$r$/i);
return if($c eq "l" && $dla{$n} =~ /$r\b/i);
return if($c eq "l" && $dla{$n} =~ /$r$/i);
$mod{$d} = $dsa{$n} if(!$mod{$d} && $c eq "s");
$mod{$d} = $dla{$n} if(!$mod{$d} && $c eq "l");
print "[n $n dsa $dsa{$n} dla $dla{$n} r $r]\n";
my @l;
@l = split(/[, ]+/, $mod{$d});
push (@l, uc $r);
$mod{$d} = join (" ", sort @l);
print "[add $s_y{$n}/$d -> $mod{$d}]\n";
}
=item rd(file,d[sl]a,rel):
read a *.data file and integrates new refs
=cut
sub rd{
my $f = shift;
my $d = shift;
open(my $t, "<", $f);
my $r;
my $n = 0;
while (my $l = <$t>) {
if (!$n && $l eq "\n"){
$l = "<define-tag $tn>$d</define-tag>\n\n";
$n = 1;
}
if (!$n && substr($l,0,(length($tn)+13)) eq "<define-tag $tn>"){
$l = "<define-tag $tn>$d</define-tag>\n";
$n = 1;
}
$r .= $l;
}
close $t;
return $r;
}
=item w(file,content):
write content into a file
=cut
sub w{
my $f = shift;
my $c = shift;
open(my $l, ">", $f);
print $l $c;
close $l;
}
=back
