From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

BRIANDFOY / PerlPowerTools-1.051 / bin / what 

            

              
1
—
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
—
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

              
#!/usr/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