[m-rev.] For review: automatically update copyright messages

[Ralph Becket]

This needs careful review - I'm not a Perl programmer.
I would pay money not to have to use Perl again.

Estimated hours taken: 6
Branches: main

CVSROOT/check.pl:
	Now updates the copyright message in Mercury code if necessary.

Index: check.pl
===================================================================
RCS file: /home/mercury1/repository/CVSROOT/check.pl,v
retrieving revision 1.16
diff -u -r1.16 check.pl
--- check.pl	21 Aug 2000 01:34:41 -0000	1.16
+++ check.pl	12 Nov 2002 01:57:04 -0000
@@ -16,10 +16,11 @@
 
 # we want them to have a copyright message that specifies the current year
 
-($_sec,$_min,$_hour,$_mday,$_mon,$year,$_wday,$_yday,$_isdst) = localtime;
+($_sec,$_min,$_hour,$_mday,$_mon,$this_year,$_wday,$_yday,$_isdst) = localtime;
 # localtime returns years since 1900, so we need to add 1900
 # to convert to years AD
-$year += 1900;	
+$this_year += 1900;	
+$last_year  = $this_year - 1;
 
 #-----------------------------------------------------------------------------#
 
@@ -92,38 +93,67 @@
 		next FILE;
 	}
 
-	#
-	# Check that the copyright message has been updated
-	# to include the current year.  But only for files within
-	# the `mercury' hierarchy.
+	# Check that the copyright message is present and update
+	# it if necessary to include the current year.  But only
+	# for files within the `mercury' hierarchy.
 	#
 	next FILE unless (check_copyright($directory, $arg));
 	# print "checking copyright for `$arg' (from `$directory')\n";
 
-	open 'arg' or die "Error opening $arg: $!\n";
+	open(ARG, $arg) or die "Error opening $arg for reading: $!\n";
 	$found = 0;
-	$copyright = "";
-	LINE:
-	while (<arg>) {
-		if (	/Copyright \(C\).*$year/ ||
-			/hereby placed in the public domain/)
+	$updated = 0;
+	@lines = ();
+	while (defined($line = <ARG>))
+	{
+		if    (	!$found &&
+			$line =~ /Copyright \(C\) .* The University of Melbourne/ )
+		{
+			$found = 1;
+
+
+			# Fix up the copyright date if necessary.
+			#
+			if ( $line !~ /$this_year/ )
+			{
+				if ( $line !~ /$last_year/ )
+				{
+					$line =~ s/ The University of Melbourne/, $this_year The University of Melbourne/;
+				}
+				else
+				{
+					$line =~ s/-$last_year/-$this_year/;
+					$line =~ s/$last_year /$last_year-$this_year/;
+				}
+
+				$updated = 1;
+			}
+		}
+		elsif (	!$found &&
+			$line =~ /hereby placed in the public domain/ )
 		{
 			$found = 1;
-			last LINE;
-		} elsif (/Copyright/i) {
-			$copyright .= "> $_";
 		}
+
+		push(@lines, $line)
 	}
-	close 'arg';
-	if (! $found) {
-		if ($copyright ne "") {
-			print "Copyright message for `$arg' appears to be "
-				. "out of date\n";
-			print "$copyright";
-		} else {
-			print "File `$arg' appears to have no "
-				. "copyright message\n";
+	close(ARG);
+
+	if ($updated) {
+		print "Updated the copyright message "
+			. "in file `$arg'\n";
+
+		open(ARG, ">$arg") or die "Error opening $arg for writing: $!\n";
+		foreach $line (@lines)
+		{
+			print ARG $line;
 		}
+		close(ARG)
+	}
+
+	if (! $found) {
+		print "File `$arg' appears to have no "
+			. "copyright message\n";
 		if ($force) {
 			print "Forcing commit anyway.\n";
 		} else {
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------