ucl

   1 #!/usr/bin/perl -w
   2 #
   3 # ucl - update changelog for subversion or git projects (perl version)
   4 #
   5 # Copyright (c) 2005-2011 by Ricardo Mones <ricardo@mones.org>
   6 #
   7 # Permission  is hereby granted, free of  charge, to any  person obtaining a
   8 # copy of this software and associated documentation files (the "Software"),
   9 # to deal in the Software without  restriction, including without limitation
  10 # the  rights to use, copy, modify, merge, publish,  distribute, sublicense,
  11 # and/or sell  copies of the  Software, and to  permit  persons to  whom the
  12 # Software is furnished to do so, subject to the following conditions:
  13 #
  14 # The above  copyright  notice and this  permission notice shall be included
  15 # in all copies or substantial portions of the Software.
  16 #
  17 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  18 # IMPLIED,  INCLUDING BUT NOT LIMITED TO THE  WARRANTIES OF MERCHANTABILITY,
  19 # FITNESS FOR A  PARTICULAR PURPOSE AND  NONINFRINGEMENT. IN NO  EVENT SHALL
  20 # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  21 # LIABILITY,  WHETHER IN AN  ACTION OF CONTRACT, TORT OR  OTHERWISE, ARISING
  22 # FROM,  OUT OF OR  IN  CONNECTION  WITH  THE SOFTWARE OR  THE USE OR  OTHER
  23 # DEALINGS IN THE SOFTWARE.
  24 #
  25
  26 use strict;
  27
  28 # project data
  29 my $PROJECT = 'clawsker';       # project name
  30 my $TYPE = 'git';               # either 'git' or 'svn'
  31 my $REPO = 'git@github.com:mones/clawsker.git'; # repository base URL
  32 # project files
  33 my $CL = './ChangeLog';         # changelog file
  34 my $VF = './VERSION';           # version file
  35 my $VC = './VC';                # revision counter
  36 # excluded files
  37 my @NOTFORRELEASE = ( 'ucl', 'VC' );
  38
  39 # temporary files
  40 my $SF = '.ucl.status';         # status file
  41 my $PCL = '.ucl.prev';          # previous changelog
  42 # global version numbers
  43 my $release = undef;
  44
  45 sub print_help_info {
  46   my $help = <<'ENDOFHELP'
  47 Description:
  48     ucl          Update changelog for Subversion/Git repository
  49 Syntax:
  50     ucl [options]
  51 Where options are:
  52     -r x.y.z     Update is for release version x.y.z
  53     -t x.y.z     Tags current trunk as release x.y.z on repository
  54     -T x.y.z     Makes x.y.z release tarball
  55 Notes:
  56   Subversion repositories are assumed to have the trunk, branches and tags
  57   subtrees just under repository root.
  58   Repository tag names are always project-version to ease tarball generation.
  59 ENDOFHELP
  60   ;
  61   print $help;
  62   exit 0;
  63 }
  64
  65 sub repo_tag {
  66   my ($tag, $msg) = @_;
  67   if ($TYPE eq 'git') {
  68     qx/git branch $tag/;
  69   }
  70   if ($TYPE eq 'svn') {
  71     my $sourceurl = "$REPO/trunk/$PROJECT";
  72     my $targeturl = "$REPO/tags/$PROJECT/$tag";
  73     qx/svn cp $sourceurl $targeturl -m $msg/;
  74   }
  75 }
  76
  77 sub repo_get_tag_to_dir {
  78   my $tag = shift; # destination dir name is tag too
  79   if ($TYPE eq 'git') {
  80     qx/git archive --format zip --output .tmp_$tag.zip --prefix=$tag\/ $tag/;
  81     qx/unzip .tmp_$tag.zip -d ./;
  82     unlink(".tmp_$tag.zip") unless ! -d "$tag";
  83   }
  84   if ($TYPE eq 'svn') {
  85     my $targeturl = "$REPO/tags/$PROJECT/$tag";
  86     qx/svn export $targeturl/;
  87   }
  88 }
  89
  90 sub repo_update {
  91   if ($TYPE eq 'git') {
  92     qx/git checkout master/;
  93   }
  94   if ($TYPE eq 'svn') {
  95     qx/LANGUAGE=C svn up/;
  96   }
  97 }
  98
  99 sub repo_get_revision {
 100   my $rev = '';
 101   if ($TYPE eq 'git') {
 102     open (VCF, "<$VC") or die "opening $VC: $!\n";
 103     $_ = <VCF>;
 104     chomp;
 105     $rev = $_;
 106     close (VCF);
 107   }
 108   if ($TYPE eq 'svn') {
 109     $_ = qx/LANGUAGE=C svn info | grep "Revision"/;
 110     @_ = split (':');
 111     $rev = $_[1];
 112     $rev =~ s/\s+//;
 113   }
 114   return $rev;
 115 }
 116
 117 sub repo_get_modifications {
 118   my @mods = ();
 119   if ($TYPE eq 'git') {
 120     qx/git status --porcelain > $SF/;
 121     open (STF, "<$SF") or die "opening $SF: $!\n";
 122     while (<STF>) {
 123       chomp;
 124       if (/^\s?M\s+(.*)$/) {
 125         push (@mods, "\t* $1");
 126       }
 127       if (/^AM?\s+(.*)$/) {
 128         push (@mods, "\t* $1\t\t**NEW**");
 129       }
 130       if (/^D\s+(.*)$/) {
 131         push (@mods, "\t* $1\t\t**REMOVED**");
 132       }
 133       if (/^\?\s+(.*)$/) {
 134         print "Info: untracked: $1\n";
 135       }
 136     }
 137     close (STF);
 138     unlink ($SF); # remove the status file
 139   }
 140   if ($TYPE eq 'svn') {
 141     qx/svn status > $SF/;
 142     open (STF, "<$SF") or die "opening $SF: $!\n";
 143     while (<STF>) {
 144       chomp;
 145       if (/^MM?\s+(.*)$/) {
 146         push (@mods, "\t* $1");
 147       }
 148       if (/^AM?\s+(.*)$/) {
 149         push (@mods, "\t* $1\t\t**NEW**");
 150       }
 151       if (/^D\s+(.*)$/) {
 152         push (@mods, "\t* $1\t\t**REMOVED**");
 153       }
 154       if (/^\?\s+(.*)$/) {
 155         print "Info: not versioned: $1\n";
 156       }
 157     }
 158     close (STF);
 159     unlink ($SF); # remove the status file
 160   }
 161   return \@mods;
 162 }
 163
 164 sub tag_new_release {
 165   my $relnum = shift;
 166   $_ = $relnum;
 167   die "Invalid release version\n" unless (/^\d+\.\d+\.\d+$/);
 168   my $namevers = "$PROJECT-$relnum";
 169   my $commitmsg = "'tag release $relnum'";
 170   &repo_tag ($namevers, $commitmsg);
 171 }
 172
 173 sub tarball_from_release_tag {
 174   my $relnum = shift;
 175   $_ = $relnum;
 176   die "Invalid release version\n" unless (/^\d+\.\d+\.\d+$/);
 177   my $namevers = "$PROJECT-$relnum";
 178   &repo_get_tag_to_dir ($namevers);
 179   foreach my $file (@NOTFORRELEASE) {
 180     if (-f "$namevers/$file") {
 181       unlink("$namevers/$file");
 182     }
 183   }
 184   qx/tar czf $namevers.tar.gz $namevers/;
 185 }
 186
 187 sub parse_options {
 188   if (defined($ARGV[0])) {
 189     $_ = $ARGV[0];
 190     if (/-r/) {
 191       die "Undefined release version\n" unless defined ($ARGV[1]);
 192       $_ = $ARGV[1];
 193       die "Invalid release version\n" unless (/^\d+\.\d+\.\d+$/);
 194       $release = $_;
 195     }
 196     elsif (/-t/) {
 197       die "Undefined release version\n" unless defined ($ARGV[1]);
 198       &tag_new_release ($ARGV[1]);
 199       exit 0;
 200     }
 201     elsif (/-T/) {
 202       die "Undefined release version\n" unless defined ($ARGV[1]);
 203       &tarball_from_release_tag ($ARGV[1]);
 204       exit 0;
 205     }
 206     elsif (/-\?/) {
 207       &print_help_info ();
 208     }
 209     else {
 210       die "Unknown option. Try -? for help\n";
 211     }
 212   }
 213 }
 214
 215 sub get_changelog_date {
 216   my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime();
 217   $year += 1900;
 218   $mon += 1;
 219   $hour = ($hour < 10)? "0$hour": "$hour";
 220   $min = ($min < 10)? "0$min": "$min";
 221   $mon = ($mon < 10)? "0$mon": "$mon";
 222   $mday = ($mday < 10)? "0$mday": "$mday";
 223   return "$year-$mon-$mday $hour:$min";
 224 }
 225
 226 sub get_version_array {
 227   my $rel = shift;
 228   if (not defined ($rel)) { # get number from version file
 229     open (VTF, "<$VF") or die "opening $VF: $!\n";
 230     $_ = <VTF>;
 231     chomp;
 232     close (VTF);
 233   }
 234   else {
 235     $_ = $rel;
 236   }
 237   my @vers = ();
 238   if (/^(\d+)\.(\d+)\.(\d+)$/) {
 239     @vers = ($1, $2, $3, "");
 240   }
 241   if (/^(\d+)\.(\d+)\.(\d+)svn(\d+)$/) {
 242     @vers = ($1, $2, $3, $4);
 243   }
 244   if (/^(\d+)\.(\d+)\.(\d+)git(\d+)$/) {
 245     @vers = ($1, $2, $3, $4);
 246   }
 247   return \@vers;
 248 }
 249
 250 sub get_newer_version {
 251   my ($maj, $min, $mic, $ext, $lastr) = @_;
 252   my $nvers = "$maj.$min.$mic";
 253   if (not defined($release) or ($release eq "")) {
 254     if ($ext ne "") {
 255       $nvers = ($nvers . $TYPE . (1 + $lastr));
 256     }
 257   }
 258   return $nvers;
 259 }
 260
 261 sub get_newer_header {
 262   my $newversion = shift;
 263   my $cldate = &get_changelog_date;
 264   my $cluser = $ENV{USER};
 265   return "$cldate  $cluser   $newversion";
 266 }
 267
 268 sub main {
 269   # check we're in the right place
 270   -e "$CL" or die "Oops, no ChangeLog here\n";
 271   -e "$VF" or die "Oops, no VERSION here\n";
 272   &parse_options;
 273   # parser VERSION file or $release argument
 274   my $vs = &get_version_array ($release);
 275   my ($major, $minor, $micro, $extra) = (@$vs[0], @$vs[1], @$vs[2], @$vs[3]);
 276   # update directory to be sure we're at the last rev
 277   &repo_update ();
 278   # get last revision from repository
 279   my $lastrev = &repo_get_revision ();
 280   # calculate modifications
 281   my $modifs = &repo_get_modifications ();
 282   # save previous changelog
 283   rename ($CL, $PCL);
 284   # get new version
 285   my $newver = &get_newer_version ($major, $minor, $micro, $extra, $lastrev);
 286   # write new entry header
 287   open (NCL, ">$CL") or die "opening $CL: $!\n";
 288   # write new entry modifications
 289   my $newhdr = &get_newer_header ($newver);
 290   print NCL "$newhdr\n\n";
 291   foreach my $modif (@$modifs) { print NCL "$modif\n"; }
 292   print NCL "\n";
 293   # and previous entries
 294   open (PCL, "<$PCL") or die "opening $PCL: $!\n";
 295   while (<PCL>) { print NCL $_; }
 296   close (PCL);
 297   close (NCL);
 298   # and keep a digest for checking
 299   my $oldmd5 = qx/md5sum $CL | cut -f1 -d" "/;
 300   # edit changelog
 301   my $editor = 'vim'; # (defined($ENV{DISPLAY}))? 'gvim -f': 'vim';
 302   if (defined($ENV{EDITOR})) {
 303     $editor = $ENV{EDITOR};
 304   }
 305   my @editor = ($editor, $CL);
 306   system (@editor);
 307   # check for changes
 308   my $newmd5 = qx/md5sum $CL | cut -f1 -d" "/;
 309   if ($oldmd5 eq $newmd5) {
 310     print "Unmodified ChangeLog, discarding changes.\n";
 311     unlink ($CL);
 312     rename ($PCL, $CL);
 313   }
 314   else {
 315     unlink ($PCL);
 316     # update new version after changes
 317     qx/echo $newver > $VF/;
 318     $TYPE eq 'git' and do { # and counter for git
 319       my $newrev = 1 + $lastrev;
 320       qx/echo $newrev > $VC/;
 321     }
 322   }
 323 }
 324
 325 &main;
 326
 327 exit 0;
 328