changelog2spec

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # Convert a SUSE or Debian changelog file to rpm format
   5 #
   6
   7 BEGIN {
   8   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
   9 }
  10
  11 use Date::Parse;
  12 use Time::Zone;
  13
  14 use strict;
  15
  16 my @wday = qw{Sun Mon Tue Wed Thu Fri Sat};
  17 my @mon = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
  18
  19 my $ok;
  20 my $zone;
  21 my $test;
  22 my $printtype;
  23 my $input = '';
  24 my $target = 'rpm';
  25
  26 while (@ARGV) {
  27   if ($ARGV[0] eq '--test') {
  28     $test = 1;
  29     shift @ARGV;
  30     next;
  31   }
  32   if ($ARGV[0] eq '--type') {
  33     $printtype = 1;
  34     shift @ARGV;
  35     next;
  36   }
  37   if (@ARGV > 1 && $ARGV[0] eq '--target') {
  38     shift @ARGV;
  39     $target = shift @ARGV;
  40     next;
  41   }
  42   last;
  43 }
  44
  45 if (@ARGV == 2 && $ARGV[0] eq '--file') {
  46   die("bad --file arg\n") unless $ARGV[1] =~ /^(.*)\/([^\/]+)$/;
  47   my ($dir, $file) = ($1, $2);
  48   $file =~ s/\.(?:spec|dsc)$//;
  49   opendir(D, $dir) || die("$dir: $!\n");
  50   my @changes = grep {/\.changes$/} readdir(D);
  51   closedir(D);
  52   @changes = sort {length($a) <=> length($b) || $a cmp $b} @changes;
  53   exit(1) unless @changes;      # nothing to do
  54   if (@changes > 1) {
  55     while ($file ne '') {
  56       my @c = grep {/\Q$file\E/} @changes;
  57       if (@c) {
  58         @changes = @c;
  59         last;
  60       }
  61       last unless $file =~ s/[-.][^-.]*$//;
  62     }
  63   }
  64   @ARGV = ("$dir/$changes[0]");
  65 }
  66
  67 sub parse_suse {
  68   $_ = $_[0];
  69
  70   my $dline;
  71   die("bad changelog heading\n") unless /^(?:\* )?([A-Za-z]+\s+[A-Za-z]+\s+[0-9].*[0-9][0-9][0-9][0-9])(.*\@.*$)/;
  72   my $dt = $1;
  73   my $who = $2;
  74   $dt = lc($dt);
  75   $who =~ s/^\s+//;
  76   $who =~ s/^-\s*//;
  77   $dt =~ /([0-9][0-9][0-9][0-9])/;
  78   $dline = $_;
  79   my $year = $1;
  80   if (!defined($zone) && $dt =~ /\s([a-z]{3,4})(dst)?\s[0-9]{4}/) {
  81     my $dst = $2;
  82     $zone = tz_offset($1);
  83     $zone += 3600 if defined($zone) && $dst;
  84   }
  85   my $tdt = str2time($dt);
  86   $dt =~ /([0-9]+)/;
  87   my $day = $1;
  88   if (!$tdt) {
  89     if ($dt =~ /([a-z]{3})\s+([a-z]{3})/) {
  90       $tdt = str2time("$1 $2 $day $year");
  91     }
  92   }
  93   if (!$tdt) {
  94     if ($dt =~ /([a-z]{3})/) {
  95       $tdt = str2time("$1 $day $year");
  96     }
  97   }
  98   if (!$tdt) {
  99     $tdt = str2time("$year-1-1");
 100   }
 101   $tdt += 12 * 3600 unless $dt =~ /\d:\d/;      # 12:00 if not specified
 102   $tdt += ($zone || 0);
 103   my $ok = 1;
 104   my $change = '';
 105   while(<>) {
 106     chomp;
 107     last if /^(?:\* )?([A-Za-z]+\s+[A-Za-z]+\s+[0-9].*[0-9][0-9][0-9][0-9])(.*\@.*$)/;
 108     next if (/^--------------/);
 109     next if (/^========================/);
 110     s/\s+$//;
 111     next if $_ eq '';
 112     s/^\s*-/-/ if $ok == 1;     # obsolete?
 113     s/^\s*\*\s*/  * /;
 114     if (!/^-/) {
 115       s/^\s+-\s*/  - /;
 116       s/^\s*/  / unless s/^    \s*/    /;
 117     }
 118     $change .= "$_\n";
 119     $ok = 2;
 120   }
 121   return ($_, $tdt, $dline, $who, $change);
 122 }
 123
 124 sub parse_debian {
 125   $_ = $_[0];
 126
 127   die("bad line: $_\n") unless /^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-+0-9a-z.]+)+)\;.*$/;
 128   my $package = $1;
 129   my $version = $2;
 130   my $distribution = $3;
 131   my $who;
 132   my $date;
 133   my $changes = "- version $version\n";
 134   while(<>) {
 135     chomp;
 136     s/\s+$//;
 137     next if $_ eq '';
 138     if (/^ --/) {
 139       die("bad maintainer line\n") unless /^ \-\- (.* <.*>)  (.*)$/;
 140       $who = $1;
 141       $date = $2;
 142       last;
 143     }
 144     die("bad change details line: $_\n") unless s/^  //;
 145     s/^\*/-/;
 146     s/\s*\(closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*\)//i;
 147     s/\s+$//;
 148     next if $_ eq '';
 149     $changes .= "$_\n";
 150   }
 151   die("no maintainer line in last entry\n") unless defined $date;
 152   if (!defined($zone) && ($date =~ /([-+])(\d\d)(\d\d)$/)) {
 153     $zone = 60 * ($3 + 60 * $2);
 154     $zone = -$zone if $1 eq '-';
 155   }
 156   my $tdt = str2time($date);
 157   return ('', $tdt, $_, $who, $changes);
 158 }
 159
 160 my $format;
 161 while (<>) {
 162   chomp;
 163   next if /^\s*$/;
 164   next if (/^--------------/);
 165   next if (/^========================/);
 166   if (/^(?:\* )?([A-Za-z]+\s+[A-Za-z]+\s+[0-9].*[0-9][0-9][0-9][0-9])(.*\@.*$)/) {
 167     $format = 'suse';
 168
 169   } elsif (/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-+0-9a-z.]+)+)\;.*$/) {
 170     $format = 'debian';
 171   } else {
 172     die("unknown changelog format\n");
 173   }
 174   last;
 175 }
 176 exit(0) unless $format;
 177
 178 if ($printtype) {
 179   print "$format\n";
 180   exit(0);
 181 }
 182
 183 if ($target eq $format) {
 184   print "$_\n";
 185   while (<>) {
 186     print $_;
 187   }
 188   exit(0);
 189 }
 190
 191 die("don't know how to convert changelog to format '$target'\n") if $target ne 'rpm';
 192
 193 my ($lastt, $t, $dline, $who, $changes);
 194 while(defined($_)) {
 195   if (/^\s*$/) {
 196     $_ = <>;
 197     last unless $_;
 198     chomp;
 199     next;
 200   }
 201   if ($format eq 'suse') {
 202     ($_, $t, $dline, $who, $changes) = parse_suse($_);
 203   } elsif ($format eq 'debian') {
 204     ($_, $t, $dline, $who, $changes) = parse_debian($_);
 205   }
 206   if (defined($lastt) && $lastt < $t) {
 207     die("changes file not incremental: $dline\n") if $test;
 208     warn("changes file not incremental: $dline\n");
 209   }
 210   $lastt = $t;
 211   my @gm = gmtime($t);
 212   # silly rpm can't hande dates < 1997, so we fold everything to
 213   # Thu Jan 02 1997
 214   @gm = (0, 0, 0, 2, 0, 97, 4) if $gm[5] < 97 || ($gm[5] == 97 && $gm[4] == 0 && $gm[3] <= 1);
 215   printf("* %s %s %2d %4d %s\n", $wday[$gm[6]], $mon[$gm[4]], $gm[3], $gm[5] + 1900, $who);
 216   $changes =~ s/%/%%/g;
 217   $changes =~ s/^(\s*)%%(\S*)/$1\[%%$2\]/;
 218   $changes =~ s/^(\s*)(\#\d*)/$1\[$2\]/mg;
 219   $changes =~ s/^\*/  */mg;
 220   print $changes;
 221 }
 222 exit(0);