ICU-8863 fix cpysearch.pl

X-SVN-Rev: 30778

diff --git a/tools/scripts/cpysearch/cpysearch.pl b/tools/scripts/cpysearch/cpysearch.pl
index 8130f933bcb4d2526ee7d78d3f9268aa72fe6dbd..facb4d29973278beebcad8f835a1f0d2f14ba8ae 100755 (executable)
--- a/tools/scripts/cpysearch/cpysearch.pl
+++ b/tools/scripts/cpysearch/cpysearch.pl
@@ -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);