RE: Name of IF style

[田口 浩]

Thanks for replies.

This type of style should be named for the first creator or first teller
to have firstly reffered to it, like K&R or Allman.

I made a silly script to find the first writer...
By my script the first person is M[irs]+. eagle.

C:\>FFIND_IF.pl > FFIF.log
C:/Perl/lib/CPAN.pm
C:/Perl/lib/Class/Struct.pm
...
C:/Perl/site/lib/SQL/Parser.pm
C:/Perl/site/lib/Win32/GuiTest.pm

1204 files checked, 34 are printded

#  $Id: ReadKey.pm,v 2.23 2005/01/11 21:16:31 jonathan Exp $
# $Id: CPAN.pm,v 1.412 2003/07/31 14:53:04 k Exp $
# $Id: Text.pm,v 2.21 2002/08/04 03:34:58 eagle Exp $
# $Id: GuiTest.pm,v 1.14 2001/12/01 23:34:50 erngui Exp $
# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
C:\>

#!Perl
# FFIND_IF.pl: File Find for IF
# $Id: FFIND_IF.pl,v 1.0 2007-02-04 18:00 h-taguchi Exp $
use strict;
use File::Find;
use File::Slurp;

my $file_num = 0;
my %file_printed;
my %Id_header;

find(\&find_if, 'C:/Perl');

print STDERR "\n$file_num files checked, " . keys(%file_printed). " are 
printded\n";

for (sort { get_date($b) <=> get_date($a) } keys %Id_header) {
  print STDERR $_;
}

exit;

sub get_date {
  my $str = shift;
  my ($date) = $str =~ /\b((?:19|20)\d\d\D\d\d\D\d\d)\b/;
  return $date;
}

sub find_if {
  if (-f and /\.pm$/) {
    ++$file_num;
    my @rec = read_file($_);
    my @ifs;
    my $Id_header;
    for (@rec) {
      if (/\$Id:/) {
        $Id_header = $_; next;
      }
      # get:
      #   if (
      #   elsif (
      #   else
      if (/^\s*if .+ \{ .+ \}/) {
        undef @ifs;
        push @ifs => $_;
      } elsif (/^\s*(elsif|else) .+ \{ .+ \}/) {
        push @ifs => $_;
      } else {
        if (@ifs >= 2) {
          print_file_name($File::Find::name, $Id_header);
          print "\n", @ifs;
        }
        undef @ifs;
      }
    }
  }
}

sub print_file_name {
  my $file = shift;
  my $header = shift;
  unless ($file_printed{$file}) {
    ++$file_printed{$file};
    print "\n\n=== $file ===\n";
    print "  $header" if $header;
    print STDERR $file, "\n";
    
    ++$Id_header{$header};
  }
}
__END__


> Taguchi-ryuu! :)

Thanks but,
okogamasii desu :-)
_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs