+sub print_help_info {
+ my $help = <<'ENDOFHELP'
+Description:
+ ucl Update changelog for Subversion/Git repository
+Syntax:
+ ucl [options]
+Where options are:
+ -r x.y.z Update is for release version x.y.z
+ -t x.y.z Tags current trunk as release x.y.z on repository
+ -T x.y.z Makes x.y.z release tarball
+Notes:
+ Subversion repositories are assumed to have the trunk, branches and tags
+ subtrees just under repository root.
+ Repository tag names are always project-version to ease tarball generation.
+ENDOFHELP
+ ;
+ print $help;
+ exit 0;
+}
+
+sub repo_tag {
+ my ($tag, $msg) = @_;
+ if ($TYPE eq 'git') {
+ qx/git branch $tag/;
+ }
+ if ($TYPE eq 'svn') {
+ my $sourceurl = "$REPO/trunk/$PROJECT";
+ my $targeturl = "$REPO/tags/$PROJECT/$tag";
+ qx/svn cp $sourceurl $targeturl -m $msg/;
+ }
+}
+
+sub repo_get_tag_to_dir {
+ my $tag = shift; # destination dir name is tag too
+ if ($TYPE eq 'git') {
+ qx/git archive --format zip --output .tmp_$tag.zip --prefix=$tag\/ $tag/;
+ qx/unzip .tmp_$tag.zip -d ./;
+ unlink(".tmp_$tag.zip") unless ! -d "$tag";
+ }
+ if ($TYPE eq 'svn') {
+ my $targeturl = "$REPO/tags/$PROJECT/$tag";
+ qx/svn export $targeturl/;
+ }
+}
+
+sub repo_update {
+ if ($TYPE eq 'git') {
+ qx/git checkout master/;
+ }
+ if ($TYPE eq 'svn') {
+ qx/LANGUAGE=C svn up/;
+ }
+}
+
+sub repo_get_revision {
+ my $rev = '';
+ if ($TYPE eq 'git') {
+ open (VCF, "<$VC") or die "opening $VC: $!\n";
+ $_ = <VCF>;
+ chomp;
+ $rev = $_;
+ close (VCF);
+ }
+ if ($TYPE eq 'svn') {
+ $_ = qx/LANGUAGE=C svn info | grep "Revision"/;
+ @_ = split (':');
+ $rev = $_[1];
+ $rev =~ s/\s+//;
+ }
+ return $rev;
+}
+
+sub repo_get_modifications {
+ my @mods = ();
+ if ($TYPE eq 'git') {
+ qx/git status --porcelain > $SF/;
+ open (STF, "<$SF") or die "opening $SF: $!\n";
+ while (<STF>) {
+ chomp;
+ if (/^\s?M\s+(.*)$/) {
+ push (@mods, "\t* $1");
+ }
+ if (/^AM?\s+(.*)$/) {
+ push (@mods, "\t* $1\t\t**NEW**");
+ }
+ if (/^D\s+(.*)$/) {
+ push (@mods, "\t* $1\t\t**REMOVED**");
+ }
+ if (/^\?\s+(.*)$/) {
+ print "Info: untracked: $1\n";
+ }
+ }
+ close (STF);
+ unlink ($SF); # remove the status file
+ }
+ if ($TYPE eq 'svn') {
+ qx/svn status > $SF/;
+ open (STF, "<$SF") or die "opening $SF: $!\n";
+ while (<STF>) {
+ chomp;
+ if (/^MM?\s+(.*)$/) {
+ push (@mods, "\t* $1");
+ }
+ if (/^AM?\s+(.*)$/) {
+ push (@mods, "\t* $1\t\t**NEW**");
+ }
+ if (/^D\s+(.*)$/) {
+ push (@mods, "\t* $1\t\t**REMOVED**");
+ }
+ if (/^\?\s+(.*)$/) {
+ print "Info: not versioned: $1\n";
+ }
+ }
+ close (STF);
+ unlink ($SF); # remove the status file
+ }
+ return \@mods;
+}
+