#!/usr/bin/perl -w
#
# $Id: lext.pl,v 1.5 2003/01/13 05:28:42 jmates Exp $
#
# Copyright (c) 2000-2001, Jeremy Mates.  This script is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
#######################################################################
#
# REQUIREMENTS

require 5.005;

use strict;

#####################################################################
#
# Modules

use Carp;                       # better error reporting
use Getopt::Std;                # command line option processing

use File::Find;			# recursive file walking

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.5 $ ') =~ s/[^0-9.]//g;

my (%opts, %seen, @files, $ext_count, $non_count);

######################################################################
#
# MAIN

# parse command-line options
getopts('h?lns:p:', \%opts);

#help() if exists $opts{'h'} or exists $opts{'?'};

if(exists($opts{'h'}) || exists($opts{'?'})) {
    print <<"HELP";
Usage: $0 [options] directories_to_parse_here

A directory-recursive file-extension information gathering tool.

Options
  -h/?   See this text.
  -l     List all extensions, and their popularity (default)
  -n     List files with no extensions.
  -s     Perl expression that will result in the current item
         (stored in \$_) being skipped if the expression turns
         out to be "true."  Example:

         -s '-d || m/^\.rsrc\$/' .

         Would skip counting directories or '.rsrc' files for
         anything in the stats. (But would still traverse
         down into the "skipped" directories!)

  -p     Perl expression that will result in the current directory
         (stored in \$_) being pruned out of the tree.  Use this to
         skip "dot directories," for example:

	 -p 'm/^\../' .

	 The -d check is used to ensure the prune test is only run
	 on directories, so any stat() calls in your expression
         should use the shortcut _ operator.

HELP
	exit;
}

# look for input on STDIN if no more arguments *after* checking
# for the huh? options on the command line to prevent script
# waiting for STDIN from the user.
chomp(@ARGV = <STDIN>) unless @ARGV;

for(@ARGV) {
    %seen = ();
    @files = ();
    $ext_count = $non_count = 0;

    find(\&indagate, $_);

    # print the seen hash out
    unless(exists($opts{'n'}) && ! exists($opts{'l'})) {
	print "Summary of extensions in ", $_, " (", $ext_count, " items)\n";
	foreach (sort (keys %seen)) {
	    print $_, "\t", $seen{$_}, "\n";
	}
    }
    
    # print non-extensioned files
    if(exists($opts{'n'})) {
	print "Files without extensions in ", $_, " (", $non_count, " items)\n";
	print join("\n", @files), "\n";
    }
}

# an archaic subroutine...
sub indagate {
    # see if we should "prune" this directory
    if (exists $opts{'p'} && -d) {
	my $results = eval "return 1 if( " . $opts{'p'} . " );";

	if($@) {
	    chomp($@);
	    die "Prune error: ", $@; # croak on errors
	}

	if($results) {
	    $File::Find::prune = 1;
	    return;
	}
    }

    # (try to) figure out what not to count
    if (exists $opts{'s'}) {
	my $result = eval "return 1 if( " . $opts{'s'} . " );";

	if($@) {
	    chomp($@);
	    die "Skip error: ", $@; # croak on errors
	}

	if($result) {
	    return;
	}
    }

    # build up file list of non-extensioned files
    if(exists($opts{'n'})) {
	unless (m/.\.[^.]+$/) {
	    push(@files, $File::Find::name);
	    $non_count++;
	}
    }

    # keep track of file extensions w/ count in seen hash
    # modifies $_, so do last! :)
    unless(exists($opts{'n'}) && ! exists($opts{'l'})) {
	if(s/.+(\.[^.]+)$/$1/) {
	    $seen{$_}++;
	    $ext_count++;
	}
    }
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

blank.pl - a script with stub docs

=head1 SYNOPSIS

Quick usage notes here.

=head1 DESCRIPTION

=head2 Overview

Short description of what script is intended to do.

=head2 Normal Usage

  $ blank.pl [options]

See L<"OPTIONS"> for details on the command line switches supported.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=back

Use B<-f> I<asdf> if a switch takes an argument of some kind.

=head1 EXAMPLES

Additional examples/helpfull hints expanding on SYNOPSIS.

=head1 ENVIRONMENT

Any special environement details or warnings?

=head1 FILES

Any important files this script relies on?

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 TODO

Replace default stub POD entries with real documentation.

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2000-2001, Jeremy Mates.  This script is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=head1 HISTORY

A blank perl template I threw together to make writing new scripts
easier.

=head1 VERSION

  $Id: lext.pl,v 1.5 2003/01/13 05:28:42 jmates Exp $

=cut