trunk/exec/copy_find

   1 #!/usr/bin/perl
   2 ## DOC: cran2deb copy_find path
   3 ## DOC:     a tool for finding (heuristically) some copyright notices.
   4 ## DOC:
   5
   6 use warnings;
   7 use strict;
   8
   9 use File::Find qw(find);
  10
  11 my $keywords='\(C\)|©|copyright|warranty|redistribution|modification|patent|trademark|licen[cs]e|permission';
  12 my @files;
  13
  14 find(sub {if (-f $File::Find::name && $File::Find::name !~ /debian/) {push @files,$File::Find::name} },@ARGV);
  15
  16 my @missing_copyright;
  17 my %copyright_notices;
  18 for my $file (@files) {
  19     my $fh = IO::File->new($file,'r') or die "Unable to open '$file' for reading: $!";
  20     my $has_copyright = 0;
  21     my $lines=0;
  22     my $chars=0;
  23     while (<$fh>) {
  24         $chars+=length($_);
  25         $lines++;
  26         chomp;
  27         if (/\Q$keywords\E/) {
  28             $copyright_notices{$_} = $_;
  29             $has_copyright = 1;
  30         }
  31     }
  32     if (not $has_copyright) {
  33         push @missing_copyright,[$file,$lines,$chars];
  34     }
  35 }
  36 print "Suspect copyright notices:\n";
  37 for my $notice (keys %copyright_notices) {
  38     print '    '.$copyright_notices{$notice}."\n";
  39 }
  40 print "Files without *suspect* copyright notices:\n";
  41 for my $fr (@missing_copyright) {
  42     print '    '.$fr->[0]."\n";
  43     print '    '.call_file($fr->[0])."\n";
  44     print '    chars:'.$fr->[1]."\n";
  45     print '    lines:'.$fr->[2]."\n";
  46 }
  47
  48 sub call_file{
  49     my ($file) = @_;
  50     my $file_fh;
  51     my $result;
  52     open($file_fh,"-|",'file',$file);
  53     local $\;
  54     $result = <$file_fh>;
  55     chomp $result;
  56     return $result;
  57 }