improve ucl for dealing with new repo
[clawsker.git] / 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