#!/usr/local/bin/perl
use warnings;
use strict;
## name: parse-index.perl
##
## version: 0.025 -- feb 10 2003
##
## author: parv, parv UNDERSCORE fm AT emailuser DOT net
##
## license: free to use as you please w/ proper credit given.
## use at your own risk. all responsibility for potential damage,
## loss, etc. is disclaimed.
##
## purpose: to search and present freebsd ports INDEX* without make
## or with the restriction of being in /usr/ports by w/ help of
## perl (like) regular expressions
##
## usage:
## to search for 'twm', 'vtwm', or 'tvtwm' in comments...
##
## parse-index.perl -comment '\bt?v?twm'
##
## ...to see whole index...
##
## parse-index.perl -show
##
## ...see "parse-index.perl -usage" for details
##
use Getopt::Long qw(:config default);
use Pod::Usage;
# location where non-default modules live
use lib '/home/parv/comp/perl.mod';
use Util qw( if_match check_hash max_length );
# index layout (all on one line in order)
# when in doubt, defer to /usr/ports/Mk/bsd.port.mk ( describe target
+)
# ----
# distribution-name|port-path|installation-prefix|comment|description
+-file\
# |maintainer|categories|build deps |run deps|www site
# ----
my %Fields =
( # names, in order, of the fields of a record
#
'all' => [ qw{ name origin install-prefix comment descripti
+on
maintainer category build-dep run-dep uri
}
]
# fields which can have multple enteries
, 'multi' => qr/^(?: category | build-dep | run-dep )/x
# fields to ignore if/when searching
#
, 'skip' => qr/^(?: install-prefix | description )/x
);
# length of the longest field name
$Fields{'max-length'} = max_length( $Fields{'all'} );
# number of fields
$Fields{'count'} = scalar @{ $Fields{'all'} };
# fields to keep, to be used as search options
$Fields{'keep'} =
\join( '|'
, grep { $_ !~ m/$Fields{'skip'}/ } @{ $Fields{'all'} }
);
# default options - controlling overall behaviour
my $Configure =
{ 'usage' => 0
# directory where ports tree is installed
, 'dir' => defined $ENV{PORTSDIR}
? $ENV{PORTSDIR} : '/usr/ports'
, 'index' => 'INDEX'
# to-be-compiled regex to search for
, 'what' => ''
# field to search in (if not 'show' whole index),
, 'find' => [ 'name'
# regex to be compiled
, join '|' , qw(show any) , ${$Fields{'keep'}}
]
};
$Configure->{'find'}->[1] = qr/^ $Configure->{'find'}->[1] /xi;
# update $Configure w/ any user specified options
$Configure = get_config($Configure);
# compile regex
$Configure->{'what'} = qr/$Configure->{'what'}/i;
handle_index( $Configure , 'print' );
sub handle_index
{
my ($conf , $do_what) = @_;
{ my @err = check_hash( $conf );
die ${$err[1]} , "\n" unless $err[0];
}
my $index = join '/' , $conf->{dir} , $conf->{'index'};
die "$index is unreadable\n" unless -r $index;
# if not printing, then we will pass the processed index
$do_what = 'pass'
unless defined $do_what and $do_what eq 'print';
# 'find' sub to match if asked
#
my $where = $conf->{'find'}->[0];
my $find =
( $where eq 'show' )
? sub { 1; }
: ( $where eq 'any' )
? # try to match pattern w/ contents of ANY of the fields
sub
{ my ($re , $h) = @_;
return
if_match( $re , [ map { $h->{$_} } keys %$h ] );
}
: # try to match pattern w/ contents of a PARTICULAR field
sub
{ my ($re , $h) = @_;
return if_match( $re , $h->{$where} )
if exists $h->{$where};
return 0;
};
# used only when printing is not specified
my @processed = ()
if $do_what ne 'print';
# print or save record processed records
#
my $rec_do = ( $do_what eq 'print' )
? sub { print @{ $_[0] }; }
: sub { push @processed , @{ $_[0] }; };
open( INDEX , '<', $index )
|| die "could not open $index: $!\n";
while ( <INDEX> )
{ chomp;
my ($items , $name) = field_values($_);
next
unless $items and $find->( $conf->{'what'} , $name );
# print|save records
$rec_do->( pretty_record($name) );
}
close(INDEX) || die "could not close $index: $!\n";
return \@processed if $do_what ne 'print';
return;
}
# return pretty up record from record hash ref
sub pretty_record
{ my $rec = shift;
my $value = sub { my $val = shift;
return (ref $val ne 'ARRAY' ? $val : @{ $val });
};
my @rec;
# create array elements either for printing or passing
#
foreach my $key ( @{ $rec->{Ordered} } )
{
push( @rec
, map { sprintf( "%$Fields{'max-length'}s: %s\n"
, $key , $_
)
}
$value->($rec->{$key})
);
}
push @rec , "\n";
return \@rec;
}
# return fields number & hash ref of a record keyed by value type
sub field_values
{ my $rec = shift;
# get elements
my @values = split '\|' , $rec , $Fields{'count'};
my $found = scalar @values;
my %pairs = ();
# needs to be 10 values may be whether empty, but not undefined
unless ( $Fields{'count'} == $found )
{
warn<<_WARN_;
$rec
is illformed; fields needed: $Fields{'count'} , found: $found
_WARN_
return (0 , \%pairs);
}
# fill %pairs w/ field element names & values
#
foreach my $idx ( 0 .. $found -1 )
{ # skip empty values
next
if $values[ $idx ] =~ m/^\s*$/;
# save order of keys
#
push @{ $pairs{'Ordered'} } , $Fields{'all'}->[ $idx ];
# crearte key/value pair
#
$pairs{ $Fields{'all'}->[$idx] } = $values[ $idx ];
}
# change multiple-values in to array
foreach ( keys %pairs )
{
# skip single item value/key
next
unless $_ =~ m/$Fields{'multi'}/;
$pairs{$_} = [ split /\s+/ , $pairs{$_} ];
}
return ( scalar( keys %pairs ) -1 # "Ordered" key doesn't count
, \%pairs
);
}
# get options
sub get_config
{
my $conf = shift;
{ my @err = check_hash( $conf );
die ${$err[1]} unless $err[0];
}
GetOptions( 'usage|help' => \$conf->{'usage'}
, 'dir=s' => \$conf->{'dir'}
, 'index=s' => \$conf->{'index'}
, 'find=s' => \$conf->{'find'}->[0]
, 'class|category' =>
sub{ $conf->{'find'}->[0] = 'category'; }
, 'show' => sub{ $conf->{'find'}->[0] = 'show'; }
, 'any' => sub{ $conf->{'find'}->[0] = 'any'; }
, 'name' => sub{ $conf->{'find'}->[0] = 'name'; }
, 'origin' => sub{ $conf->{'find'}->[0] = 'origin'; }
, 'comment' => sub{ $conf->{'find'}->[0] = 'comment'; }
)
|| die pod2usage('-exitval' => 1 , '-verbose' => 0);
pod2usage('-exitval' => 0 , '-verbose' => 3)
if $conf->{'usage'};
pod2usage( '-message' => "either specify to show the whole index or
+type of search to do\n"
, '-exitval' => 1 , '-verbose' => 0
)
if ( $conf->{'find'}->[0] eq 'show' && scalar @ARGV )
|| ( $conf->{'find'}->[0] ne 'show' && !scalar @ARGV );
# regex to search for
$conf->{'what'} = join('|' , @ARGV) if scalar @ARGV;
check_config($conf);
return $conf;
}
sub check_config
{
my $conf = shift;
{ my $message = ''; # message collector for messages
# check for (correct) options
foreach my $k (keys %$conf)
{
next unless ref $conf->{$k} eq 'ARRAY';
# collect error messages for wrong options
# ----
# first element is the default/given option,
# 2d is regex of allowable options
# ----
$message .= "incorrect option '" . $conf->{$k}->[0] . "' given\n
+"
unless $conf->{$k}->[0] =~ m/ $conf->{$k}->[1] /x;
}
die pod2usage( '-message' => $message , '-exitval' => 1
, '-verbose' => 0
)
if length $message;
}
return;
}
__DATA__
=head1 NAME
parse-index.perl - search and browse the FreeBSD ports INDEX*
=head1 SYNOPSIS
parse-index.perl -usage
parse-index.perl -show
parse-index.perl [ -port ] pattern
parse-index.perl [ -any | -comment | -port | -origin | -class
| -find=<too many options to list>
]
pattern
=head1 DESCRIPTION
Parse-index.perl eases searching & browsing of I<FreeBSD Ports INDEX*>
(without make(1) and without the restriction of being in F</usr/ports>
+)
with help of Perl regular expressions.
To search for a port (name), just specify a pattern; there is no press
+ing
need to specify B<-port> or B<-find=port> option.
The given arguments/patterns separated by spaces/tabs are turned into
+an
OR'd regex. To avoid this behaviour, protect the spaces. In other
words, take care to avoid shell interpretation.
=head1 OPTIONS
=over 2
=item B<-usage>
Show this message; overrides any other option.
=item B<-dir>=I<ports tree location>
Specify ports tree directory.
If unspecified, I<PORTSDIR> envrionment variable is checked. If this
+is
also unspecified, F</usr/ports> is used as the default.
This option overrides I<PORTSDIR> which overrides default F</usr/ports
+>.
=item B<-index>=I<name of index file>
Specify name of the index file. Mind you that this is a file name not
a file path (at least for now).
=item B<-show>
=item B<-any>
=item B<-name>
=item B<-origin>
=item B<-comment>
=item B<-class>
=item B<-find>=I<show>|I<any>|I<name>|I<origin>|I<comment>|I<class>|I<
+category>
=item B<-find>=I<maintainer>|I<build-dep>|I<run-dep>|I<uri>
Specify what to do, or where search in for given (command line)
argument(s).
=over 2
=item B<show>
show the whole index.
=back
(Below are proper search options which define, for given arguments, th
+e
field (singular) to search for all the ports. Their purpose are expli
+citly
listed for completeness sake even if that is balatantly obvious.)
=over 2
=item B<any>
search anywhere in a port's record.
=item B<name>
search in port name.
this option is assumed when any ther options are missing and at least
+an
argument (to search for) is given.
=item B<origin>
search in origin (I<bsd.port.mk> lists it as "port path").
=item B<comment>
search in (one line) comment.
=item B<maintainer>
search from maintainer (e-mail address).
=item B<class> | B<category>
search for the catgeories in which a particular port, well, has been
categorized.
=item B<build-dep>
search build dependencies.
=item B<run-dep>
search run time dependencies.
=item B<uri>
search for unique resource identifier, URI (web or FTP adderss for
example).
=back
=back
=head1 ENVIRONMENT
=over 2
=item I<PORTSDIR>
Environment variable pointing to the location of ports tree.
=back
=head1 FILES
=over 2
=item F</usr/ports>
Default location of ports tree.
=item F</usr/ports/INDEX>
Default index file for FreeBSD [34].x.
=item F</usr/ports/Mk/bsd.port.mk>
just read it to see what it does.
=back
=head1 SEE ALSO
I<pkg_info>(1), I<ports>(7)
I<pkg_version>(1), I<portupgrade>(1), I<pkg_tree>(7)
FreeBSD ports collection: http://www.freebsd.org/ports/
=head1 Author, Distribution and such
parv, parv UNDERSCORE fm AT emailuser DOT net
version: 0.025 -- feb 10 2003
Free to use as you please w/ proper credit given. Use at your own ris
+k.
All responsibility for potential damage, loss, etc. is disclaimed.
=cut
|