#!/usr/bin/perl -w # # Original Id: cat,v 1.2 2004/08/05 14:17:43 cwest Exp # Taken from perl power tools: http://ppt.perl.org/ # # Added code to *NOT* print directories unless non-printing # characters are handled properly. my $rcsid = '$Id: cat,v 1.2 2006/08/01 22:03:01 vogelke Exp $'; use Getopt::Long; use File::Basename; use Pod::Usage; use Carp; use strict; $ENV{'PATH'} = join ":", qw(/bin /usr/bin /usr/local/bin); my $VERSION = '1.2mod'; # keep original rev but show it's changed my $myname = basename($0); $myname =~ s/\.\w*$//; # strip any extension # Get the options. my %options; my @getopt_args = ( 'h|?', # print usage 'b', # number non-blank lines 'e', # print '$' at EOL 'm', # print manpage 'n', # number all lines 's', # squeeze blank lines 't', # visible tabs 'u', # unbuffer output 'v', # handle non-printing characters 'V', # print version ); Getopt::Long::config("noignorecase", "bundling"); usage() unless GetOptions(\%options, @getopt_args); manpage() if $options{'m'}; version() if $options{'V'}; usage() if $options{'h'}; my ($tabs, $ends, $nonprinting); if (exists $options{e}) { $ends = $nonprinting = 1; } if (exists $options{t}) { $tabs = $nonprinting = 1; } if (exists $options{v}) { $nonprinting = 1; } my $squeeze_empty = exists $options{s}; my $number_lines = exists $options{n}; my $number_non_blanks = exists $options{b}; # Unbuffer output for -u. $| = exists $options{u}; my $was_empty = 0; my $count = 0; while (<>) { # Skip directories unless handling nonprinting characters. # $ARGV can be a filename or "-" (stdin). unless ($nonprinting) { if ($ARGV eq '-') { if (-d STDIN) { carp "stdin is a directory"; close(ARGV); next; } } else { if (-d $ARGV) { carp "$ARGV is a directory"; close(ARGV); next; } } } # Original code starts here. if ($squeeze_empty) { my $is_empty = /^$/; if ($is_empty && $was_empty) { next; } $was_empty = $is_empty; } $_ = sprintf "%6d $_", ++$count if $number_lines || $number_non_blanks && /\S/; $_ =~ s/$/\$/ if $ends; if ($nonprinting) { $_ =~ s/([\x80-\xFF])/"M-" . ("\x7F" & $1)/ge; $_ =~ s/([\x00-\x08\x0B-\x1F])/"^" . chr (0100 + ord $1)/ge; $_ =~ s/\x7F/^?/g; } if ($tabs) { $_ =~ s/\x09/^I/g; } print; } exit(0); #--------------------------------------------------------------------- # Print a usage message from the comment header and exit. sub usage { my ($emsg) = @_; require Pod::Usage; import Pod::Usage qw(pod2usage); warn "$emsg\n" if defined $emsg; pod2usage(-verbose => 1); } sub manpage { require Pod::Usage; import Pod::Usage qw(pod2usage); pod2usage(-exitstatus => 0, -verbose => 2); } #--------------------------------------------------------------------- # Print the current version and exit. sub version { print "$myname v$VERSION\n"; exit(0); } #--------------------------------------------------------------------- __END__ =pod =head1 NAME cat -- concatenate and print files. =head1 SYNOPSIS cat [-behmnstuVv] [file ...] =head1 DESCRIPTION I reads and prints the files in order they are given. If no files are given, I is processed. A lone dash represents I as well. =head2 OPTIONS I accepts the following options: =over 4 =item -b Number all the non blank lines, starting at 1. =item -e Print a dollar sign (B<$>) at the end of each lines. Implies I<-v>. =item -h Print help information and exit. =item -m Print man page and exit. =item -n Number all the lines, starting at 1. =item -s The I option. Sequential empty lines are squeezed into a single empty line. =item -t Display tabs as I<^I>. Implies I<-v>. =item -u Unbuffer output. =item -V Print version and exit. =item -v Display non-printable characters in a printable way. Characters in the range I<\000> - I<\037>, with the exception of tabs and linefeeds, are printed as I<^X>, where I is the symbol I<\0100> higher. I is printed as I<^?>. Characters whose highest bit is set are printed as I, followed by the representation of the character with the high bit stripped. =back =head1 ENVIRONMENT The working of I is not influenced by any environment variables. =head1 BUGS I has no known bugs. =head1 STANDARDS This I implementation is compliant with the B specification, also known as B. This I implementation is compatible with the B implementation. =head1 AUTHOR The Perl implementation of I was written by Abigail, I. =head1 COPYRIGHT and LICENSE This program is copyright by Abigail 1999. Modified by Karl Vogel to ignore directories unless non-printable characters are properly handled, 1 Aug 2006 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