The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

BRIANDFOY / PerlPowerTools-1.049 / bin / head 

            

              
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

              
#!/usr/bin/perl
=begin metadata
Name: head
Description: print the first lines of a file
Author: Abigail, perlpowertools@abigail.be
License: perl
=end metadata
=cut
use strict;
use File::Basename qw(basename);
use Getopt::Std qw(getopts);
use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;
my $Program = basename($0);
my ($VERSION) = '1.3';
@ARGV = new_argv();
my %opt;
unless (getopts('n:', \%opt)) {
    warn "usage: $Program [-n count] [file ...]\n";
    exit EX_FAILURE;
}
my $count;
if (defined $opt{'n'}) {
    $count = $opt{'n'};
    if ($count =~ m/[^0-9]/) {
        warn "$Program: invalid number '$count'\n";
        exit EX_FAILURE;
    }
    if ($count == 0) {
        warn "$Program: count is too small\n";
        exit EX_FAILURE;
    }
} else {
    $count = 10;
}
my $rc = EX_SUCCESS;
my $sep = 0;
foreach my $file (@ARGV) {
    if (-d $file) {
        warn "$Program: '$file' is a directory\n";
        $rc = EX_FAILURE;
        next;
    }
    my $fh;
    unless (open $fh, '<', $file) {
        warn "$Program: failed to open '$file': $!\n";
        $rc = EX_FAILURE;
        next;
    }
    if (scalar(@ARGV) > 1) {
        if ($sep == 0) {
            $sep = 1;
        } else {
            print "\n";
        }
        print "==> $file <==\n";
    }
    head_fh($fh);
    unless (close $fh) {
        warn "$Program: failed to close '$file': $!\n";
        $rc = EX_FAILURE;
    }
}
head_fh(*STDIN) unless @ARGV;
exit $rc;
sub head_fh {
    my $fh = shift;
    foreach (1 .. $count) {
        my $line = <$fh>;
        last unless (defined $line);
        print $line;
    }
}
sub new_argv {
    my @new;
    my $end = 0;
    foreach my $arg (@ARGV) {
        if ($arg eq '--' || $arg !~ m/\A\-/) {
            push @new, $arg;
            $end = 1;
            next;
        }
        if (!$end && $arg =~ m/\A\-([0-9]+)\Z/) { # historic
            push @new, "-n$1";
        } else {
            push @new, $arg;
        }
    }
    return @new;
}
__END__
=pod
=head1 NAME
head - print the first lines of a file
=head1 SYNOPSIS
head [-n count] [files ...]
=head1 DESCRIPTION
I<head> prints the first I<count> lines from each file. If the I<-n> is
not given, the first 10 lines will be printed. If no files are given,
the first lines of standard input will be printed.
=head2 OPTIONS
I<head> accepts the following options:
=over 4
=item -n count
Print I<count> lines instead of the default 10.
=back
=head1 ENVIRONMENT
The working of I<head> is not influenced by any environment variables.
=head1 BUGS
I<head> has no known bugs.
=head1 STANDARDS
This I<head> implementation is compliant with the B<IEEE Std1003.2-1992>
specification, also known as B<POSIX.2>.
This I<head> implementation is compatible with the B<OpenBSD> implementation.
=head1 AUTHOR
The Perl implementation of I<head> was written by Abigail, I<perlpowertools@abigail.be>.
=head1 COPYRIGHT and LICENSE
This program is copyright by Abigail 1999.
This program is free and open software. You may use, copy, modify, distribute
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others to do the same.
=cut