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

