mmm, not what i want
[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 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