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