#! /usr/bin/perl # , and is released # under the terms of the GPL version 2, or any later version, at your # option. See the file README and COPYING for more information. # Copyright 2009 by Don Armstrong . # $Id: perl_script 1432 2009-04-21 02:42:41Z don $ use warnings; use strict; use Getopt::Long; use Pod::Usage; =head1 NAME - =head1 SYNOPSIS [options] Options: --debug, -d debugging level (Default 0) --help, -h display this help --man, -m display manual =head1 OPTIONS =over =item B<--debug, -d> Debug verbosity. (Default 0) =item B<--help, -h> Display brief usage information. =item B<--man, -m> Display this manual. =back =head1 EXAMPLES =cut use vars qw($DEBUG); my %options = (debug => 0, help => 0, man => 0, ); GetOptions(\%options, 'debug|d+','help|h|?','man|m'); pod2usage() if $options{help}; pod2usage({verbose=>2}) if $options{man}; $DEBUG = $options{debug}; my @USAGE_ERRORS; # if (1) { # push @USAGE_ERRORS,"You must pass something"; # } pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS; my %rows; @rows{@ARGV}=(1) x @ARGV; my @header; my $row=0; my $output_newline = 0; while () { chomp; $row++; my @row = split /[\t\s]/, $_; if (!@header) { @header = @row; next; } if (@ARGV and not exists $rows{$row}) { next; } if ($output_newline) { print qq(\n); } for my $i (0..$#row) { print $i <= $#header ?$header[$i]:'???'; print ': '.$row[$i].qq(\n); } $output_newline=1; } __END__