ucl

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