This repository has been archived on 2025-02-12. You can view files and clone it, but cannot push or open issues or pull requests.
NeoStats/tools/copyright-update.pl

626 lines
13 KiB
Perl
Executable file

#!/usr/bin/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-2008 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-2008
#
# =>
#
# Copyright (C) 2000-2008
#
# 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-2008
Copyright: (C) 2000-2008
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
<Longer program description>
=head1 TROUBLESHOOTING
None.
=head1 EXAMPLES
None.
=head1 ENVIRONMENT
No environment variables are used.
=head1 FILES
None.
=head1 SEE ALSO
<references to other programs>
=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<any>
=head1 VERSION
$Id: copyright-update.pl,v 1.9 2004/04/04 16:17:30 jaalto Exp $
=head1 AUTHOR
Copyright (C) 2000-2008 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 '', <FILE>;
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|.svn|.libs)$,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__