ICU-8863 fix cpysearch.pl
X-SVN-Rev: 30778
This commit is contained in:
Abhinav Gupta
parent
1b6e647811
commit
133e973a5e
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# ***********************************************************************
|
||||
# * COPYRIGHT:
|
||||
# * Copyright (c) 2002-2009, International Business Machines Corporation
|
||||
# * Copyright (c) 2002-2011, International Business Machines Corporation
|
||||
# * and others. All Rights Reserved.
|
||||
# ***********************************************************************
|
||||
#
|
||||
@ -9,25 +9,121 @@
|
||||
# this current year on them.
|
||||
#
|
||||
use strict;
|
||||
use warnings;
|
||||
use Time::localtime;
|
||||
use File::stat;
|
||||
use File::Find;
|
||||
|
||||
my $icuSource = $ARGV[0];
|
||||
die "Can't open ICU dir: $icuSource" unless -d $icuSource ;
|
||||
my $icu_src = $ARGV[0] || ".";
|
||||
my $cpyskip = 'cpyskip.txt';
|
||||
|
||||
my $ignore = "CVS|\\.svn|\\~|\\#|Debug|Release|\\.dll|\\.ilk|\\.idb|\\.pdb|\\.dsp|\\.dsw|\\.opt|\\.ncb|\\.vcproj|\\.sln|\\.suo|\\.cvsignore|\\.cnv|\\.res|\\.icu|\\.exe|\\.obj|\\.bin|\\.exp|\\.lib|\\.out|\\.plg|positions|unidata|\\.jar|\\.spp|\\.stub|\\.policy|\\.ttf|\\.TTF|\\.otf";
|
||||
die "Can't open ICU directory: $icu_src" unless -d $icu_src;
|
||||
|
||||
my ($sec, $min, $hour, , $day, $mon, $year, $wday, $yday, $isdst) = localtime;
|
||||
$year += 1900;
|
||||
if ( ! -f "cpyskip.txt" ) {
|
||||
die "Can't open cpyskip.txt, please download from http://source.icu-project.org/cpyskip.txt (see http://site.icu-project.org/processes/copyright-scan for more details)"
|
||||
die ("Can't find $cpyskip. Please download it from ".
|
||||
"http://source.icu-project.org/cpyskip.txt (see ".
|
||||
"http://site.icu-project.org/processes/copyright-scan for more details).")
|
||||
unless -f $cpyskip;
|
||||
|
||||
# list of file extensions to ignore
|
||||
my @ignore_extensions = qw(svn dll ilk idb pdb dsp dsw opt ncb vcproj sln suo
|
||||
cvsignore cnv res icu exe obj bin exp lib out plg jar spp stub policy ttf
|
||||
TTF otf);
|
||||
my $ignore_exts = join '|',
|
||||
map { "\\.$_" }
|
||||
@ignore_extensions;
|
||||
|
||||
# ignore regex
|
||||
my $ignore = "CVS|\\~|\\#|Debug|Release|positions|unidata|$ignore_exts";
|
||||
|
||||
my $year = localtime->year + 1900;
|
||||
|
||||
# Perl doesn't have fnmatch. Closest thing is File::FnMatch but that's
|
||||
# UNIX-only (see its caveats). So, as a workaround, convert globs to regular
|
||||
# expressions. Translated from Python's fnmatch module.
|
||||
sub glob_to_regex($) {
|
||||
my ($glob, $i, $len, $regex);
|
||||
$glob = shift;
|
||||
$i = 0;
|
||||
$len = length($glob);
|
||||
$regex = "";
|
||||
|
||||
# charat(STR, IDX)
|
||||
# Return the character in the argument at the given index.
|
||||
my $charat = sub($$) { return substr(shift, shift, 1) };
|
||||
|
||||
while ($i < $len) {
|
||||
my ($c, $out);
|
||||
$c = &$charat($glob, $i++);
|
||||
if ($c eq '*') { $out = '.*' }
|
||||
elsif ($c eq '?') { $out = '.' }
|
||||
elsif ($c eq '[') { # glob classes
|
||||
my $j = $i;
|
||||
|
||||
# Get the closing index of the class. ] appearing here is part
|
||||
# of the class.
|
||||
if ($j < $len && &$charat($glob, $j) eq '!') { $j++ }
|
||||
if ($j < $len && &$charat($glob, $j) eq ']') { $j++ }
|
||||
while ($j < $len && &$charat($glob, $j) ne ']') { $j++ }
|
||||
|
||||
# Didn't find closing brace. Use literal [
|
||||
if ($j >= $len) { $out = "\\[" }
|
||||
|
||||
else {
|
||||
# The complete class contents (except the braces)
|
||||
my $s = substr($regex, $i, $j - $i);
|
||||
$s =~ s/\\/\\\\/g;
|
||||
$i = $j + 1; # change position to outside class
|
||||
|
||||
# Negation
|
||||
if (&$charat($s, 0) eq '!') { $s = '^'.substr($s, 1); }
|
||||
# Literal ^
|
||||
elsif (&$charat($s, 0) eq '^') { $s = '\\'.$s; }
|
||||
|
||||
$out = "[$s]";
|
||||
}
|
||||
}
|
||||
else { $out = quotemeta($c) }
|
||||
$regex .= $out;
|
||||
}
|
||||
return $regex;
|
||||
}
|
||||
my $command = "find $icuSource -type f -mtime -$yday | fgrep -v -f cpyskip.txt";
|
||||
my @files = `$command`;
|
||||
@files = grep(!/$ignore/, @files);
|
||||
my $file;
|
||||
foreach $file (@files) {
|
||||
chomp $file;
|
||||
my @lines = `head -n 20 "$file"`;
|
||||
if (grep(/copyright.*$year/i, @lines) == 0) {
|
||||
print "$file\n";
|
||||
}
|
||||
|
||||
open SKIP, "<$cpyskip" or die "Error opening $cpyskip.";
|
||||
my @ignore_globs = map { chomp; glob_to_regex($_) } <SKIP>;
|
||||
close SKIP;
|
||||
|
||||
# Check if this file should be ignored.
|
||||
sub ignore($) {
|
||||
my $filename = shift;
|
||||
return 1 if $filename =~ /$ignore/;
|
||||
for my $r (@ignore_globs) { return 1 if $filename =~ /$r/ }
|
||||
0;
|
||||
}
|
||||
|
||||
# any(CODE, LIST)
|
||||
# Evaluate CODE for each element of LIST till CODE($_) returns 1. Return 0 if
|
||||
# not found.
|
||||
sub any(&@) {
|
||||
my $code = shift;
|
||||
local $_;
|
||||
&$code && return 1 for @_;
|
||||
0;
|
||||
}
|
||||
|
||||
find({
|
||||
wanted => sub { # $_ is the full path to the file
|
||||
return unless -f;
|
||||
return if (localtime(stat($_)->mtime)->year + 1900) < $year;
|
||||
return if ignore($_);
|
||||
# file is recent and shouldn't be ignored. find copyright.
|
||||
|
||||
# if file contains a line with "copyright" and current year on the
|
||||
# same line, we're good.
|
||||
open F, "<$_" or die "Error opening '$_'.";
|
||||
my $result = any { $_ =~ /copyright.*$year/i } <F>;
|
||||
close F;
|
||||
|
||||
print "$_\n" unless $result;
|
||||
},
|
||||
no_chdir => 1,
|
||||
}, $icu_src);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user