#!/usr/pkg/bin/perl

=begin metadata

Name: what
Description: extract version information from a file
Author: Ken Schumack, schumacks@att.net
License: perl

=end metadata

=cut

use strict;

use Getopt::Std qw(getopts);

my $matches = 0;
my %opt;
getopts('s', \%opt) or usage();
@ARGV or usage();

for my $file (@ARGV)
    {
        if (-d $file) {
            print $file, ":\n";
            next;
        }
        my $fh;
        unless (open $fh, '<', $file) {
            warn "Unable to open '$file': $!\n";
            last;
        }
        printWhat($fh, $file, $opt{'s'});
        close $fh;
    }
exit ($matches ? 0 : 1);

#### read open file and print "what" statements...
#### pass in file handle, file name, and whether to stop printing after 1st "what"
sub printWhat
{
    my $file_handle = shift;
    my $file_name   = shift;
    my $stop_flag   = shift;
    my $line;
    print "$file_name:\n" if $file_name ne "";
    while (defined($line = <$file_handle>))
    {
        next unless $line =~ m/\@\(#\)/;
        $matches++;
        my @match = ($line);
        if ($line =~ m/\0/) ## there may be more than 1 in here
        {
            my @F = split(/\0/, $line);
            @match = grep { m/\@\(#\)/ } @F;
        }
        for my $f (@match)
        {
            $f =~ s|.*\@\(#\)||;
            $f =~ s|[">\0\\].*||; ##BSD spec says print to 1st " > \ or null
            chomp $f;
            print "\t$f\n";
            return if $stop_flag;
        }
    }
}

sub usage {
    require Pod::Usage;
    Pod::Usage::pod2usage({ -exitval => 1, -verbose => 0 });
}

__END__

=pod

=head1 NAME

what - extract version information from a file

=head1 SYNOPSIS

what [ C<-s> ] filename ...

=head1 DESCRIPTION

what searches each filename for occurrences of the pattern
B<@>(#) that the SCCS get command substitutes for the %Z% ID
keyword, and prints what follows up to a ", >, NEWLINE,
\, or null character. What can be used on any type of file,
NOT just SCCS files. Just put the magic 4 character B<@>(#)
pattern in your file and you are set.

=head2 OPTIONS

B<->B<s> Stop after the first occurrence of the pattern.

=head1 EXIT STATUS

The what utility exits with status of 0 if any version information was found,
or with a status of 1 otherwise.

=head1 ENVIRONMENT

The working of B<what> is not influenced by any environment variables.

=head1 EXAMPLES

If a Perl program test1.pl contains:

  my $REV = '@(# ) $Revision: 1.3 ...

and a C program test2.c contains:

  char rcsid[] = "@(# ) $Revision: 1.15 ....

and the C program is compiled to a.out...

The command:

prompt%> what test1.pl test2.c a.out

produces:

B<test1.pl:>
        B<$Revision>B<: 1.3 $';>

B<test2.c:>
        B<$Revision>B<: 1.15 $";>

B<a.out;>
        B<$Revision>B<: 1.15 $>

=head1 BUGS

B<what> has no known bugs.

=head1 AUTHOR

This Perl implementation of B<what> was written by Ken Schumack schumacks@att.net

=head1 COPYRIGHT and LICENSE

This program is copyright by Ken Schumack 1999.

This program is free and open software. You may use, modify, distribute
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.

=cut


