Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

search/browse freebsd ports INDEX*

by parv (Vicar)
on Jan 18, 2003 at 04:56 UTC ( #227920=sourcecode: print w/replies, xml ) Need Help??
Category: freebsd ports, text processing
Author/Contact Info parv
Description:

Parse-index.perl eases searching & browsing of FreeBSD Ports INDEX* (without make(1) and without the restriction of being in /usr/ports) with help of Perl regular expressions.

this program uses the home made Util.pm (not inculded in this post).

one may need to adjust the modules in use lib 'modules' as appropriate.

the program itself is also available from...
http://www103.pair.com/parv/comp/src/perl/parse-index.perl

Fixed a regex bug, in version 0.025, which would have matched for the wrong reasons. Code below and at above URL has been updated.

#!/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
Replies are listed 'Best First'.
Re: search/browse freebsd ports INDEX*
by tomhukins (Curate) on Jan 19, 2003 at 03:12 UTC
    Do you know about my Perl modules for parsing FreeBSD's Ports INDEX file? My modules have a few small bugs that need fixing, but mostly they work well. I haven't put them on CPAN because they're specific to one OS (although maybe I should, I don't know), but they're in the Ports collection.
      talk about creating the almost similar wheel!
      
      i was not aware of your efforts.  i announced it on -questions
      mailing list, got no response.
      
      from the description, it looks like your module does what i had
      wished & created.  i will study it in few days.  
Fixed an ugly regex bug (parse-index.perl, v0.025)
by parv (Vicar) on Feb 10, 2003 at 08:52 UTC

    Regex Fix (v0.025, feb 10 2003): Fixed a bug which would have macthed/failed for the wrong reasons. Before...

    my $Configure = { ... # field to search in (if not 'show' whole index), , 'find' => [ 'name' , qr{^(?: (?{ join '|' , qw(show any) , ${$Fields{'keep'}} }) ) }xi ] };

    ...after...

    my $Configure = { ... # 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;
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://227920]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (4)
As of 2020-06-01 23:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you really want to know if there is extraterrestrial life?



    Results (12 votes). Check out past polls.

    Notices?