#! perl # # copyright-update.pl -- Update copyright year # $Id: copyright-update.pl,v 1.9 2004/04/04 16:17:30 jaalto Exp $ # # File id # # Copyright (C) 2000-2005 Jari Aalto # Created: 2000-01 # Keywords: Perl, copyright, update # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as # published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, # Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # Visit http://www.gnu.org/copyleft/gpl.html # # Documentation # # This program will update the year part of the copyright line. # # Copyright (C) 2000-2005 # # => # # Copyright (C) 2000-2005 # # The Copyright year can be passed as command line option. If no # option is given, current year is used. # # Code Note # # This code has been edited using Emacs editor, where M-x cperl-mode # and M-x font-lock-mode was turned on. Due to highlighting problems, # a simple Perl regexp marker // confused averything, so an alternative # m,, match operator was used. # # End use autouse 'Pod::Text' => qw( pod2text ); use autouse 'Pod::Html' => qw( pod2html ); use 5.004; use strict; use English; use Getopt::Long; use File::Find; my $LIB = "copyright-update.pl"; use vars qw ( $VERSION ); # This is for use of Makefile.PL and ExtUtils::MakeMaker # So that it puts the tardist number in format YYYY.MMDD # The REAL version number is defined later # # The following variable is updated by Emacs setup whenever # this file is saved. See http//tiny-tools.sourceforge.net/ my $VERSION = '2005.0216'; # **************************************************************************** # # DESCRIPTION # # Help function and embedded POD documentation # # INPUT PARAMETERS # # none # # RETURN VALUES # # none # # **************************************************************************** =pod =head1 NAME copyright-update.pl - Update Copyright year information =head1 README This program updates the copyright year information for given files. The year is current year unless passed with B<--year> YEAR option. perl -S copyright-update.pl --verbose 1 --test [--year 2002] * To change all files recursively form current directory, whose author is "Mr. Foo" use command below. The B<--regexp> option requires that file contains that line. perl -S copyright-update.pl --recursive --Regexp "Author:.*Mr. Foo" \ --verbose 1 --test --year 2002 . For the above command, only files that contain lines like these would be updated: Copyright (C) 2000-2005 Copyright: (C) 2000-2005 The format must be exatly as show here. Different amount of spaces is permitted, but the YEAR-YEAR must be kept together in files. =head1 OPTIONS =head2 Gneneral options =over 4 =item B<--help -h> Print text help =item B<--Help-html> Print help in HTML format. You can pipe this to a browser: perl -S copyright-update.pl --Help-html | lynx =item B<--Help-man> Print help in Unix manual page format. You can pipe this to a comman: perl -S copyright-update.pl --Help-man | nroff -man | less =item B<--recursive> Recursively search all direcotries given at command line. =item B<--Regexp REGEXP> Change only files whose content matches REGEXP. =item B<--test> hangedRun in test mode. Show what would happen. No files are changed. =item B<--verbose LEVEL> Print informational messages. Increase numeric LEVEL for more verbosity. =item B<--Version> Print contact and version information =item B<--year YEAR> Update files using YEAR. Year value must be four digits. The default is current calendar year. =back =head2 Miscellaneous options =over 4 =item B<--debug> Turn on debug. =back =head1 DESCRIPTION =head1 TROUBLESHOOTING None. =head1 EXAMPLES None. =head1 ENVIRONMENT No environment variables are used. =head1 FILES None. =head1 SEE ALSO =head1 BUGS No known limitations. =head1 AVAILABILITY http://tiny-tools.sourceforge.net/ =head1 SCRIPT CATEGORIES CPAN/Administrative =head1 COREQUISITES Uses tandard Perl modules. =head1 OSNAMES C =head1 VERSION $Id: copyright-update.pl,v 1.9 2004/04/04 16:17:30 jaalto Exp $ =head1 AUTHOR Copyright (C) 2000-2005 Jari Aalto. All rights reserved. This program is free software; you can redistribute and/or modify program under the same terms as Perl itself or in terms of Gnu General Public licence v2 or later. =cut sub Help (;$$) { my $id = "$LIB.Help"; my $type = shift; # optional arg, type my $msg = shift; # optional arg, why are we here... if ( $type eq -html ) { pod2html $PROGRAM_NAME; } elsif ( $type eq -man ) { eval "use Pod::Man"; $EVAL_ERROR and die "$id: Cannot generate Man: $EVAL_ERROR"; my %options; $options{center} = 'cvs status - formatter'; my $parser = Pod::Man->new(%options); $parser->parse_from_file ($PROGRAM_NAME); } else { pod2text $PROGRAM_NAME; } defined $msg and print $msg; exit 1; } # **************************************************************************** # # DESCRIPTION # # Return current year YYYY # # INPUT PARAMETERS # # None # # RETURN VALUES # # number YYYY # # **************************************************************************** sub Year () { my $id = "$LIB.Year"; 1900 + (localtime time())[5]; } # **************************************************************************** # # DESCRIPTION # # Read command line arguments and their parameters. # # INPUT PARAMETERS # # None # # RETURN VALUES # # Globally set options. # # **************************************************************************** sub HandleCommandLineArgs () { my $id = "$LIB.HandleCommandLineArgs"; use vars qw ( $test $verb $debug $YEAR $OPT_RECURSIVE $OPT_REGEXP ); Getopt::Long::config( qw ( require_order no_ignore_case no_ignore_case_always )); my ( $help, $helpMan, $helpHtml ); # local variables to function GetOptions # Getopt::Long ( "year=i" => \$YEAR , "help" => \$help , "Help-man" => \$helpMan , "Help-html" => \$helpHtml , "test" => \$test , "debug" => \$debug , "verbose:i" => \$verb , "recursive" => \$OPT_RECURSIVE , "Regexp" => \$OPT_REGEXP ); $help and Help(); $helpMan and Help(-man); $helpMan and Help(-html); $YEAR = Year() unless defined $YEAR; unless ( $YEAR =~ m,^\d{4}$, ) { die "$id: Option --year must be given with four digits [$YEAR]"; } if ( defined $verb and $verb == 0 ) { $verb = 1; } $verb = 1 if $test and $verb == 0; $verb = 5 if $debug; } # **************************************************************************** # # DESCRIPTION # # Handle Single file # # INPUT PARAMETERS # # %hash -file => [filename list] # -regexp => Regexp to match file content. # If regexp is not found in file, file is not # handled. # # RETURN VALUES # # none # # **************************************************************************** sub HandleFile ( % ) { my $id = "$LIB.HandleFile"; my %arg = @ARG; my @files = @{ $arg{-file} }; my $regexp = $arg{-regexp} || '' ; unless ( @files ) { warn "$id: -file argument is empty: ", $arg{-file}; return; } $debug and print "$id: -file [@files], -regexp [$regexp]\n"; local ( *FILE, $ARG ); for my $file ( @files ) { $debug and print "$id: Opening file: $file\n"; # ..................................................... read ... unless ( open FILE, "< $file" ) { $verb and print "$id: Cannot open $file\n"; next; } else { binmode FILE; $ARG = join '', ; close FILE; unless ( $ARG ) { $verb and print "$id: Empty file: $file\n"; return; } } if ( $regexp ) { unless ( /$regexp/o ) { $verb and print "$id: Content does not quelify regexp check: $file\n"; } } my $yyyy = '\d{4}'; my $lead = 'Copyright:?[ \t]+\([Cc]\)[ \t]+' . $yyyy . '-'; # If we find the LEAD, then check if YEAR is different # and finally do substitution. # # If everything went ok, replace file. my $y; if ( not /$lead($yyyy)/i ) { $verb > 1 and print "$id: No Copyright statement : $file\n"; } elsif ( $1 and ($y = $1) eq $YEAR ) { $verb > 2 and print "$id: Copyright is already $YEAR: $file\n" } elsif ( $1 and not s/($lead)($yyyy)/$1$YEAR/gi ) { $verb and print "$id: Substitute could't change year." . " Check correct format in file: $file\n"; } else { my $msg = "$id: Changed"; $test and $msg = "$id: Would change"; $verb and print "${msg} $file $y => $YEAR\n"; $test and next; unless ( open FILE, "> $file" ) { print "$id: Cannot open for writing: $file\n"; } else { binmode FILE; print FILE $ARG; close FILE; } } } } # **************************************************************************** # # DESCRIPTION # # Recursively find out all files and chnege their content. # # INPUT PARAMETERS # # None. This function is called from File::FInd.pm library # # RETURN VALUES # # None. # # **************************************************************************** sub wanted () { my $id = "$LIB.wanted"; my $dir = $File::Find::dir; my $file = $File::Find::name; if ( $dir =~ m,(CVS|RCS)$,i ) { $File::Find::prune = 1; $debug and print "$id: Ignored directory: $dir\n"; return; } # Emacs backup files this.txt~ and #this.text# my $ignore = '[#~]$|\.(log|tmp|bak|bin|s?o|com|exe)$' . '\.(ppt|xls|jpg|png|gif|tiff|bmp)$' ; if ( $file =~ m,$ignore,oi ) { $debug and print "$id: Ignored temporary file: $file\n"; return; } if ( -f ) { if ( $verb > 3 ) { print "$id: $file\n"; } HandleFile -file => [$file], -regexp => $OPT_REGEXP; } } # **************************************************************************** # # DESCRIPTION # # Expand files in list. Win32 support # # INPUT PARAMETERS # # @ list of file glob patterns. # # RETURN VALUES # # @ list of filenames # # **************************************************************************** sub FileGlobs ( @ ) { my $id = "$LIB.FileGlobs"; my @list = @ARG; not @list and die "$id: No files to expand. Argument list is empty."; my @files; for my $glob ( @list ) { # Win32 can't expand "*". We must do it here. # Grep only FILES, not directories. push @files, grep { -f } glob $glob; } $debug and print "$id: RETURN [@files]\n"; @files; } # **************************************************************************** # # DESCRIPTION # # Main function # # INPUT PARAMETERS # # None # # RETURN VALUES # # None # # **************************************************************************** sub Main () { my $id = "$LIB.Main"; HandleCommandLineArgs(); unless ( @ARGV ) { die "What files to change? See --help."; } $debug and print "$id: ARGV [@ARGV]\n"; # .......................................... expand command line ... if ( $OPT_RECURSIVE ) { find( {wanted => \&wanted, no_chdir => 1}, @ARGV ); } else { my @files = FileGlobs @ARGV; HandleFile -file => [@files], -regexp => $OPT_REGEXP; } } Main(); 0; __END__