Bug#821096: (no subject)

[victory <victory.deb@gmail.com>]

> 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