changelog2spec

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # Convert a SUSE or Debian changelog file to rpm format
   5 #
   6
   7 ################################################################
   8 #
   9 # Copyright (c) 1995-2014 SUSE Linux Products GmbH
  10 #
  11 # This program is free software; you can redistribute it and/or modify
  12 # it under the terms of the GNU General Public License version 2 or 3 as
  13 # published by the Free Software Foundation.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program (see the file COPYING); if not, write to the
  22 # Free Software Foundation, Inc.,
  23 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  24 #
  25 ################################################################
  26
  27 BEGIN {
  28   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
  29 }
  30
  31 use Date::Parse;
  32 use Time::Zone;
  33
  34 use strict;
  35
  36 my @wday = qw{Sun Mon Tue Wed Thu Fri Sat};
  37 my @mon = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
  38
  39 my $ok;
  40 my $zone;
  41 my $test;
  42 my $printtype;
  43 my $input = '';
  44 my $target = 'rpm';
  45
  46 while (@ARGV) {
  47   if ($ARGV[0] eq '--test') {
  48     $test = 1;
  49     shift @ARGV;
  50     next;
  51   }
  52   if ($ARGV[0] eq '--type') {
  53     $printtype = 1;
  54     shift @ARGV;
  55     next;
  56   }
  57   if (@ARGV > 1 && $ARGV[0] eq '--target') {
  58     shift @ARGV;
  59     $target = shift @ARGV;
  60     next;
  61   }
  62   last;
  63 }
  64
  65 if (@ARGV == 2 && $ARGV[0] eq '--file') {
  66   die("bad --file arg\n") unless $ARGV[1] =~ /^(.*)\/([^\/]+)$/;
  67   my ($dir, $file) = ($1, $2);
  68   $file =~ s/\.(?:spec|dsc)$//;
  69   opendir(D, $dir) || die("$dir: $!\n");
  70   my @changes = grep {/\.changes$/} readdir(D);
  71   closedir(D);
  72   # support _service: prefixes, they need to be stripped
  73   $file =~ s/^_service:.*://;
  74   my %changes = map {/^((?:_service:.*:)?(.*?))$/ ? ($2, $1) : ($_, $_)} @changes;
  75   @changes = keys %changes;
  76   @changes = sort {length($a) <=> length($b) || $a cmp $b} @changes;
  77   exit(1) unless @changes;      # nothing to do
  78   if (@changes > 1) {
  79     while ($file ne '') {
  80       my @c = grep {/\Q$file\E/} @changes;
  81       if (@c) {
  82         @changes = @c;
  83         last;
  84       }
  85       last unless $file =~ s/[-.][^-.]*$//;
  86     }
  87   }
  88   @ARGV = ("$dir/$changes{$changes[0]}");
  89 }
  90
  91 sub parse_suse {
  92   $_ = $_[0];
  93
  94   my $dline;
  95   die("bad changelog heading\n") unless /^(?:\* )?([A-Za-z]+\s+[A-Za-z]+\s+[0-9][^-]*?[0-9][0-9][0-9][0-9])(.*\@.*$)/;
  96   my $dt = $1;
  97   my $who = $2;
  98   $dt = lc($dt);
  99   $who =~ s/^\s+//;
 100   $who =~ s/^-\s*//;
 101   $dt =~ /([0-9][0-9][0-9][0-9])/;
 102   $dline = $_;
 103   my $year = $1;
 104   if (!defined($zone) && $dt =~ /\s([a-z]{3,4})(dst)?\s[0-9]{4}/) {
 105     my $dst = $2;
 106     $zone = tz_offset($1);
 107     $zone += 3600 if defined($zone) && $dst;
 108   }
 109   my $tdt = str2time($dt);
 110   $dt =~ /([0-9]+)/;
 111   my $day = $1;
 112   if (!$tdt) {
 113     if ($dt =~ /([a-z]{3})\s+([a-z]{3})/) {
 114       $tdt = str2time("$1 $2 $day $year");
 115     }
 116   }
 117   if (!$tdt) {
 118     if ($dt =~ /([a-z]{3})/) {
 119       $tdt = str2time("$1 $day $year");
 120     }
 121   }
 122   if (!$tdt) {
 123     $tdt = str2time("$year-1-1");
 124   }
 125   $tdt += 12 * 3600 unless $dt =~ /\d:\d/;      # 12:00 if not specified
 126   $tdt += ($zone || 0);
 127   my $ok = 1;
 128   my $change = '';
 129   while(<>) {
 130     chomp;
 131     last if /^(?:\* )?([A-Za-z]+\s+[A-Za-z]+\s+[0-9][^-]*?[0-9][0-9][0-9][0-9])(.*\@.*$)/;
 132     next if (/^--------------/);
 133     next if (/^========================/);
 134     s/\s+$//;
 135     next if $_ eq '';
 136     s/^\s*-/-/ if $ok == 1;     # obsolete?
 137     s/^\s*\*\s*/  * /;
 138     if (!/^-/) {
 139       s/^\s+-\s*/  - /;
 140       s/^\s*/  / unless s/^    \s*/    /;
 141     }
 142     $change .= "$_\n";
 143     $ok = 2;
 144   }
 145   return ($_, $tdt, $dline, $who, $change);
 146 }
 147
 148 sub parse_debian {
 149   $_ = $_[0];
 150
 151   die("bad line: $_\n") unless /^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-+0-9a-z.]+)+)\;.*$/;
 152   my $package = $1;
 153   my $version = $2;
 154   my $distribution = $3;
 155   my $who;
 156   my $date;
 157   my $changes = "- version $version\n";
 158   while(<>) {
 159     chomp;
 160     s/\s+$//;
 161     next if $_ eq '';
 162     if (/^ --/) {
 163       die("bad maintainer line\n") unless /^ \-\- (.* <.*>)  (.*)$/;
 164       $who = $1;
 165       $date = $2;
 166       last;
 167     }
 168     die("bad change details line: $_\n") unless s/^  //;
 169     s/^\*/-/;
 170     s/\s*\(closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*\)//i;
 171     s/\s+$//;
 172     next if $_ eq '';
 173     $changes .= "$_\n";
 174   }
 175   die("no maintainer line in last entry\n") unless defined $date;
 176   if (!defined($zone) && ($date =~ /([-+])(\d\d)(\d\d)$/)) {
 177     $zone = 60 * ($3 + 60 * $2);
 178     $zone = -$zone if $1 eq '-';
 179   }
 180   my $tdt = str2time($date);
 181   return ('', $tdt, $_, $who, $changes);
 182 }
 183
 184 my $format;
 185 while (<>) {
 186   chomp;
 187   next if /^\s*$/;
 188   next if (/^--------------/);
 189   next if (/^========================/);
 190   if (/^(?:\* )?([A-Za-z]+\s+[A-Za-z]+\s+[0-9][^-]*?[0-9][0-9][0-9][0-9])(.*\@.*$)/) {
 191     # suse :    * Fri Jun 07 2013 First Last <first.last@example.com>
 192     # tizen:    * Fri Jun 07 2013 First Last <first.last@example.com> tagname@commitid
 193     $format = 'suse';
 194   } elsif (/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-+0-9a-z.]+)+)\;.*$/) {
 195     $format = 'debian';
 196   } else {
 197     die("unknown changelog format\n");
 198   }
 199   last;
 200 }
 201 exit(0) unless $format;
 202
 203 if ($printtype) {
 204   print "$format\n";
 205   exit(0);
 206 }
 207
 208 if ($target eq $format) {
 209   print "$_\n";
 210   while (<>) {
 211     print $_;
 212   }
 213   exit(0);
 214 }
 215
 216 die("don't know how to convert changelog to format '$target'\n") if $target ne 'rpm';
 217
 218 my ($lastt, $t, $dline, $who, $changes);
 219 while(defined($_)) {
 220   if (/^\s*$/) {
 221     $_ = <>;
 222     last unless $_;
 223     chomp;
 224     next;
 225   }
 226   if ($format eq 'suse') {
 227     ($_, $t, $dline, $who, $changes) = parse_suse($_);
 228   } elsif ($format eq 'debian') {
 229     ($_, $t, $dline, $who, $changes) = parse_debian($_);
 230   }
 231   if (defined($lastt) && $lastt < $t) {
 232     die("changes file not incremental: $dline\n") if $test;
 233     warn("changes file not incremental: $dline\n");
 234   }
 235   $lastt = $t;
 236   my @gm = gmtime($t);
 237   # silly rpm can't hande dates < 1997, so we fold everything to
 238   # Thu Jan 02 1997
 239   @gm = (0, 0, 0, 2, 0, 97, 4) if $gm[5] < 97 || ($gm[5] == 97 && $gm[4] == 0 && $gm[3] <= 1);
 240   printf("* %s %s %2d %4d %s\n", $wday[$gm[6]], $mon[$gm[4]], $gm[3], $gm[5] + 1900, $who);
 241   $changes =~ s/%/%%/g;
 242   $changes =~ s/^(\s*)%%(\S*)/$1\[%%$2\]/;
 243   $changes =~ s/^(\s*)(\#\d*)/$1\[$2\]/mg;
 244   $changes =~ s/^\*/  */mg;
 245   print $changes;
 246 }
 247 exit(0);