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

In reply to search/browse freebsd ports INDEX* by parv

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.