r3469 - scripts/trunk

[Cyril Brulebois]

Author: kibi-guest
Date: 2007-07-28 05:52:33 +0000 (Sat, 28 Jul 2007)
New Revision: 3469

Added:
   scripts/trunk/XS-Vcs-fields-update.pl
Log:
Add XS-Vcs-fields-update.pl

Added: scripts/trunk/XS-Vcs-fields-update.pl
===================================================================
--- scripts/trunk/XS-Vcs-fields-update.pl	                        (rev 0)
+++ scripts/trunk/XS-Vcs-fields-update.pl	2007-07-28 05:52:33 UTC (rev 3469)
@@ -0,0 +1,106 @@
+#!/usr/bin/perl -w
+#
+# Tiny script to add/check that the appopriate XS-Vcs-* fields are present
+# in the control file of some packages, eventually add or modify them.
+#
+# Cyril Brulebois <cyril.brulebois at enst-bretagne.fr>, 2007
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# 
+
+use strict;
+
+# Our XS-* fields
+sub xs_vcs_svn     { return "svn://svn.debian.org/pkg-games/packages/trunk/" . shift() . "/"; };
+sub xs_vcs_browser { return "http://svn.debian.org/wsvn/pkg-games/packages/trunk/" . shift () . "/?op=log"; };
+
+
+# Parameters handling
+my (@packages) = @ARGV;
+die << "END_OF_USAGE"
+Usage:
+    svn co svn://svn.debian.org/pkg-games/packages/trunk/
+    cd trunk
+    $0 package1 package2 [...] packageN # or: $0 *
+    svn diff
+    # edit debian/changelog
+    svn ci
+END_OF_USAGE
+    if not @packages;
+
+
+foreach my $package (@packages) {
+    # Check the file actually exists
+    if ( ! -f "$package/debian/control" ) {
+        warn "Unable to open $package/debian/control: SKIPPING";
+        next;
+    }
+
+    # Open it
+    open my $control_fh, '<', "$package/debian/control"
+        or die "Oops, unable to open $package/debian/control";
+
+    # Slurp it
+    my $control = join('', <$control_fh>);
+
+    # Close it
+    close $control_fh
+        or die "Oops, unable to close $package/debian/control";
+
+    # SVN: Already contains this field?
+    if ($control =~ /^XS-Vcs-Svn: (.*)$/ms ) {
+        my $svn = $1;
+        print "[$package] XS-Vcs-Svn already present: ";
+    
+        # Matches the appropriate value?
+        if ($svn eq xs_vcs_svn($package)) {
+            print "ALREADY OK\n";
+        }
+        else {
+            print "NEEDS MODIFICATION\n";
+            my $replacement = xs_vcs_svn($package);
+            $control =~ s/^XS-Vcs-Svn.*?$/XS-Vcs-Svn: $replacement/ms;
+        }
+    }
+    else {
+        print "[$package] XS-Vcs-Svn absent: ADDING\n";
+        my $addition = xs_vcs_svn($package);
+        $control =~ s/^$/XS-Vcs-Svn: $addition\n/ms;
+    }
+
+    # BROWSER: Already contains this field?
+    if ($control =~ /^XS-Vcs-Browser: (.*)$/ms ) {
+        my $browser = $1;
+        print "[$package] XS-Vcs-Browser already present: ";
+    
+        # Matches the appropriate value?
+        if ($browser eq xs_vcs_svn($package)) {
+            print "ALREADY OK\n";
+        }
+        else {
+            print "NEEDS MODIFICATION\n";
+            my $replacement = xs_vcs_browser($package);
+            $control =~ s/^XS-Vcs-Browser.*?$/XS-Vcs-Browser: $replacement/ms;
+        }
+    }
+    else {
+        print "[$package] XS-Vcs-Browser absent: ADDING\n";
+        my $addition = xs_vcs_browser($package);
+        $control =~ s/^$/XS-Vcs-Browser: $addition\n/ms;
+    }
+
+    # And now write back to the file
+    # Open it
+    open $control_fh, '>', "$package/debian/control"
+        or die "Oops, unable to open $package/debian/control";
+
+    # Slurp it
+    print $control_fh $control;
+
+    # Close it
+    close $control_fh
+        or die "Oops, unable to close $package/debian/control";
+
+}


Property changes on: scripts/trunk/XS-Vcs-fields-update.pl
___________________________________________________________________
Name: svn:executable
   + *