dumpaudio

I was having all sorts of trouble trying to figure out how to extract audio from any video file into a WAV (signed 16-bit, little-endian) format. I was fortunate enough to find something that worked universally, so here it is:

dumpaudio

#!/bin/sh
if [ $# -ge 1 ]; then
IN=$1
OUT=$1.wav
if [ $# -ge 2 ]; then
OUT=$2
fi
ffmpeg -i "$IN" -f wav -acodec pcm_s16le "$OUT"
else
echo "Usage: $0 in [ out ]" >&2
fi

latest.sh

A bit lazy of me, but with my directories containing many entries, it's been easier to keep track of files via modification time. That's just what I've done with this script:

latest.sh

#!/bin/sh
FILE=
DATE=0
if [ $# -gt 0 ]; then
for i in "$@"
do
NDATE=`date -r "$i" '+%s'`
if [[ $NDATE -gt $DATE || -z "$FILE" ]]; then
FILE=$i
DATE=$NDATE
fi
done
echo "$FILE"
else
for i in *
do
NDATE=`date -r "$i" '+%s'`
if [[ $NDATE -gt $DATE || -z "$FILE" ]]; then
FILE=$i
DATE=$NDATE
fi
done
echo "$FILE"
fi

fortweet.sh

While bored, I decided to write this little shell script:

fortweet.sh

#!/bin/sh
fortune -n 140 -s | perl stweet.pl "$@"

psmap.sh and panonmap.sh

Another product of my boredom, these programs look over the virtual memory being used by a process. psmap.sh include dynamic libraries and files:

psmap.sh

#!/bin/sh
if [ $# -lt 1 ]; then
echo "Usage: $0 pname" > /dev/stderr
exit 1
fi
PIDS=( `pidof "$1"` )
if [ ${#PIDS[*]} -lt 1 ]; then
echo "No such process running: $1" > /dev/stderr
exit 2
fi
pmap -q ${PIDS[0]} | sort -k2,2 -n -r

panonmap.sh only gets the anonymous parts:

panonmap.sh

#!/bin/sh
if [ $# -lt 1 ]; then
echo "Usage: $0 pname" > /dev/stderr
exit 1
fi
PIDS=( `pidof "$1"` )
if [ ${#PIDS[*]} -lt 1 ]; then
echo "No such process running: $1" > /dev/stderr
exit 2
fi
pmap -q ${PIDS[0]} | sort -k2,2 -n -r | awk '/\[ anon \]/ {total = total + int($2); print}; END { print "Total anon: " total "K"}'

PerlArg.pm

I've been meaning to standardize how I parse arguments in my scripts for some time, but I've finally gotten around to it. This module follows conventions similar to most Unix tools in parsing its arguments, except -afoo to set a=foo isn't supported. I doubt it'll be missed, since a space in there is nothing:

PerlArg.pm

package PerlArg;
use strict;
use warnings;
use utf8;
my $VERSION = '0';
sub new {
my $class = shift;
my %args = @_;
my $self = {Long => {}, LongSynoms => {}, ShortSynoms => {}, Anon => []};
($self->{Long} = $args{Long}) if(defined $args{Long});
($self->{LongSynoms} = $args{LongSynoms}) if(defined $args{LongSynoms});
($self->{ShortSynoms} = $args{ShortSynoms}) if(defined $args{ShortSynoms});
bless($self, $class);
return $self;
}
sub addLong {
my $self = shift;
my $var = shift;
my $value = '';
($value = shift) if(scalar @ARGV);
$self->{Long}->{$var} = $value;
}
sub addSynom {
my $self = shift;
my ($syn, $equiv) = @_;
$self->{Synoms}->{$syn} = $equiv;
}
sub getValue {
my $self = shift;
my $var = shift;
return $self->{Long}->{$var};
}
sub getNames {
my $self = shift;
return keys %{$self->{Long}}
}
sub getAnonymous {
my $self = shift;
my $i = shift;
return ${$self->{Anon}}[$i];
}
sub getAnonymousAll {
my $self = shift;
return @{$self->{Anon}};
}
sub getAnonymousLength {
my $self = shift;
return scalar @{$self->{Anon}};
}
sub parseArgs {
my $self = shift;
my @args = @_;
my $arg = undef;
my $opts = 1;
while(scalar @args) {
$arg = shift @args;
if($opts and $arg eq '--') {
$opts = 0;
}
elsif($opts and $arg =~ /^--([^=]+)=(.*)$/) {
if(defined $self->{Long}->{$1}) {
$self->{Long}->{$1} = $2;
}
else {
die "Unknown argument: $1\n";
}
}
elsif($opts and $arg =~ /^--([^=]+)$/) {
if(defined $self->{LongSynoms}->{$1}) {
my $name = $1;
my $equiv = $self->{LongSynoms}->{$name};
if($equiv =~ /^([^=]+)=(.*)$/) {
if(defined $self->{Long}->{$1}) {
$self->{Long}->{$1} = $2;
}
else {
die "Unknown argument equivalent: $name -> $1\n";
}
}
elsif(!scalar @args) {
die "Needs a value: $name\n";
}
elsif(defined $self->{Long}->{$equiv}) {
my $value = shift @args;
$self->{Long}->{$equiv} = $value;
}
else {
die "Unknown argument equivalent: $name -> $1\n";
}
}
else {
die "Unknown argument: $1\n";
}
}
elsif($opts and $arg =~ /^-([^=]+)$/) {
my $len = length $1;
for(my $i = 0; $i < $len; $i++) {
my $a = substr($1, $i, 1);
if(defined $self->{ShortSynoms}->{$a}) {
my $equiv = $self->{ShortSynoms}->{$a};
if($equiv =~ /^([^=]+)=(.*)$/) {
if(defined $self->{Long}->{$1}) {
$self->{Long}->{$1} = $2;
}
else {
die "Unknown argument equivalent: $a -> $1\n";
}
}
elsif(!scalar @args or $i < $len - 1) {
die "Needs a value: $a\n";
}
elsif(defined $self->{Long}->{$equiv}) {
my $value = shift @args;
$self->{Long}->{$equiv} = $value;
}
else {
die "Unknown argument equivalent: $a -> $1\n";
}
}
else {
die "Unknown argument: $a\n";
}
}
}
else {
push(@{$self->{Anon}}, $arg);
}
}
}
1;
__END__

Here's a simple application of it:

perlargtest.pl

#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use PerlArg;

my $pars = PerlArg->new(
Long => {cow => 'say', foo => 'bar'},
LongSynoms => {'no-cow' => 'cow=no', cow => 'cow'},
ShortSynoms => {'y' => 'foo=yay!', 'k' => 'foo'}
);
$pars->parseArgs(@ARGV);
my @names = $pars->getNames;
print "$_: " . $pars->getValue($_) . "\n" foreach(@names);
print "ANON\n";
print "\t$_\n" foreach($pars->getAnonymousAll);% perl perlargtest.pl --foo=333 --no-cow -yk 300 -- --cow=say 100 200 300
cow: no
foo: 300
ANON
--cow=say
100
200
300

This module is going to be used to improve my new Postgres-based JDIC search client.

songproc

A couple of days ago, I wrote a simple Perl script, which really isn't all that special on its own:

collection.pl

#!/usr/bin/perl
use strict;
use POSIX qw(ceil floor);
use DBI;
my $dbname = $ENV{HOME} . "/.kde/share/apps/amarok/collection.db";
my $db = DBI->connect("dbi:SQLite:$dbname") || die "Database $dbname doesn't exist!\n";
my $datas = $db->selectall_arrayref("SELECT artist.name, tags.title, album.name, tags.track, tags.length, year.name FROM tags INNER JOIN artist ON artist.id = tags.artist INNER JOIN album ON album.id = tags.album INNER JOIN year ON year.id = tags.year");
my %albums;
foreach my $data (@{$datas}) {
my ($artist, $title, $album, $track, $dur, $year) = (${$data}[0], ${$data}[1], ${$data}[2], ${$data}[3],${$data}[4], ${$data}[5]);
my $length = $dur / 60;
my $min = floor($length);
my $sec = ceil(($length - $min) * 60);

$length = sprintf("%u:%02u", $min, $sec);
print "$artist\t$title\t$album\t$track\t$length\t$year\n";

}
$db->disconnect;

This script operates on Amarok's collection database for the current user, but only under 'normal-ish' Unix systems. However, the usefulness isn't in this script, but in the following. The 'and' version requires all given conditions to be met, and the 'or' version requires only one match:

songproc-and.awk

BEGIN {
FS=" "
};
(!length(artist) && !length(title) && !length(album)) ||
(length(artist) && length(title) && length(album) && $1 ~ artist && $2 ~ title && $3 ~ album) ||
(length(artist) && length(title) && !length(album) && $1 ~ artist && $2 ~ title) ||
(length(artist) && !length(title) && length(album) && $1 ~ artist && $3 ~ album) ||
(!length(artist) && length(title) && length(album) && $2 ~ title && $3 ~ album) ||
(length(artist) && !length(title) && !length(album) && $1 ~ artist) ||
(!length(artist) && length(title) && !length(album) && $2 ~ title) ||
(!length(artist) && !length(title) && length(album) && $3 ~ album) {
print $_
}

songproc-or.awk

BEGIN {
FS=" "
};
(!length(artist) && !length(title) && !length(album)) || (length(artist) && $1 ~ artist) || (length(title) && $2 ~ title) || (length(album) && $3 ~ album) {
print $_
}

In either case, if no variables are defined it'll return all songs. Here's an example of a query:

% perl collection.pl | awk -f songproc-and.awk artist=中島みゆき album=パラダイス・カフェ | sort -n -t"`tab`" --key=4,4
中島みゆき 旅人のうた パラダイス・カフェ 1 5:03 1996
中島みゆき 伝説 パラダイス・カフェ 2 4:45 1996
中島みゆき 永遠の嘘をついてくれ パラダイス・カフェ 3 5:59 1996
中島みゆき Alone, Please パラダイス・カフェ 4 5:12 1996
中島みゆき それは愛ではない パラダイス・カフェ 5 4:15 1996
中島みゆき なつかない猫 パラダイス・カフェ 6 4:43 1996
中島みゆき Singles Bar パラダイス・カフェ 7 5:55 1996
中島みゆき 青い時代 パラダイス・カフェ 8 3:47 1996
中島みゆき たかが愛 パラダイス・カフェ 9 5:45 1996
中島みゆき 阿檀の木の下で パラダイス・カフェ 10 6:40 1996
中島みゆき パラダイス・カフェ パラダイス・カフェ 11 5:21 1996

This is a listing of all songs by 中島みゆき in the album パラダイス・カフェ, sorted by their track number. If I wanted to reorder the fields, I could just use a simple awk print. Also, I created a simple script that outputs a tab, since it's so painful to do in shells with tab-completion.

#!/bin/sh
echo -e '\t'

Not really worth taking up a whole line, but it's an amazingly useful script.

iter.sh

My CSE303 instructor said it wasn't possible to iterate through a script's arguments through numbers, but I managed to get something working.

#!/bin/sh

for i in $(seq 1 $#); do
x="$(eval echo \$\{$i\})"
echo $x
done% sh iter.sh 1 2 3 4 5 6
1
2
3
4
5
6Unlike shift, you can have any subset of the arguments.

disget

Sometimes you want to download a certain file (over FTP in this case), but Google doesn't always give an answer. Although simple, this script takes the work out of finding the right files:

distget

#!/bin/sh
MIRROR='ftp://gentoo.osuosl.org/pub/gentoo/distfiles/'

if [[ "$1" != '' ]]; then
wget -O - "$MIRROR" | grep "$1" | awk '{print $6}' | awk -F\" '{print $2}'
fi% sh distget cow
--2008-04-07 07:54:45-- ftp://gentoo.osuosl.org/pub/gentoo/distfiles/
=> `-'
Resolving gentoo.osuosl.org... 140.211.166.134
Connecting to gentoo.osuosl.org|140.211.166.134|:21... connected.
Logging in as anonymous ... Logged in!
==> SYST ... done. ==> PWD ... done.
==> TYPE I ... done. ==> CWD /pub/gentoo/distfiles ... done.
==> PASV ... done. ==> LIST ... done.

[ <=> ] 2,251,749 730K/s in 3.0s

2008-04-07 07:54:48 (730 KB/s) - `-' saved [2251749]

Removed `.listing'.
Wrote HTML-ized index to `-'.
ftp://gentoo.osuosl.org:21/pub/gentoo/distfiles/cowbell-0.2.7.1.tar.gz
ftp://gentoo.osuosl.org:21/pub/gentoo/distfiles/cowloop-1.4.tar.gz
ftp://gentoo.osuosl.org:21/pub/gentoo/distfiles/cowloop-2.14.tar.gz
ftp://gentoo.osuosl.org:21/pub/gentoo/distfiles/cowloop-2.15.tar.gz
ftp://gentoo.osuosl.org:21/pub/gentoo/distfiles/cowloop-3.0.tar.gz
ftp://gentoo.osuosl.org:21/pub/gentoo/distfiles/cowsay-3.03.tar.gz

Make me a Sandwich

I've decided to turn a popular XKCD into an actual Makefile:

Makefile

sandwich:
if [ -f sandwich-tmp ]; then \
if [ "`awk '{ out = out $$_ }; END { print out }' sandwich-tmp`" == "mea" ]; then \
if [ `id -u` -eq 0 ]; then \
echo "Okay."; \
else \
echo "What? Make it yourself."; \
fi; \
fi; \
fi
me:
echo "me" > sandwich-tmp
a:
echo "a" >> sandwich-tmp% make me a sandwich
echo "me" > sandwich-tmp
echo "a" >> sandwich-tmp
if [ -f sandwich-tmp ]; then \
if [ "`awk '{ out = out $_ }; END { print out }' sandwich-tmp`" == "mea" ]; then \
if [ `id -u` -eq 0 ]; then \
echo "Okay."; \
else \
echo "What? Make it yourself."; \
fi; \
fi; \
fi
What? Make it yourself.
% sudo make me a sandwich
echo "me" > sandwich-tmp
echo "a" >> sandwich-tmp
if [ -f sandwich-tmp ]; then \
if [ "`awk '{ out = out $_ }; END { print out }' sandwich-tmp`" == "mea" ]; then \
if [ `id -u` -eq 0 ]; then \
echo "Okay."; \
else \
echo "What? Make it yourself."; \
fi; \
fi; \
fi
Okay.

This script was partially autogenerated by this other Perl script:

smake.pl

#!/usr/bin/perl -w
use strict;
use warnings;

scalar @ARGV >= 2 || die "Usage: $0 target1 target2 [ ... ]\n";

my @targets = @ARGV;
my $final = pop @targets;
my $comp = '';
($comp .= $_) foreach(@targets);
my @lines = ("$final:", "\tif [ -f $final-tmp ]; then", "\t\tif [ \"\`awk '{ out = out \$_ }; END { print out }' $final-tmp\`\" == \"$comp\" ]; then", "\t\t\techo \"Okay.\"", "\t\tfi", "\tfi");
my $first = shift @targets;
push(@lines, ("$first:", "\techo \"$first\" > $final-tmp"));
push(@lines, ("$_:", "\techo \"$_\" >> $final")) foreach(@targets);
print "$_\n" foreach(@lines);

note2latex

Back when I was at Cascadia, I had decided to take my notes in LaTeX. However, I soon realized that pure LaTeX wouldn't do, as it was a bit too generic for my purposes. In order to reduce the load, I wrote a couple of scripts (unnecessary to use two, but I felt like it) and a style file.

note2latex

#!/bin/bash
TEXPP=/usr/local/bin/texpp.pl
LATEX=/usr/bin/latex

JOBNAME="$1.out"
OUT="$JOBNAME.tex"
$TEXPP "$1" "$OUT"
$LATEX "$OUT"
if [[ "`grep -i '\\\label' "$OUT" 2> /dev/null`" != "" || "`grep -i '\\\ref' "$OUT" 2> /dev/null`" != "" ]]; then
$LATEX "$OUT"
fi
rm -f "$OUT"
mv -f "$JOBNAME.dvi" "`basename "$1" .tex`.dvi"
mv -f "$JOBNAME.aux" "`basename "$1" .tex`.aux"
mv -f "$JOBNAME.log" "`basename "$1" .tex`.log"

texpp.pl

#!/usr/bin/perl
use strict;
use utf8;
scalar @ARGV >= 2 || die "No file given.\nUsage: texpp.pl infile outfile.\n";
my $infile = $ARGV[0];
my $outfile = $ARGV[1];
-e "$infile" || die "No such file.\n";
open(BUFF, "$infile") || die "Input file opening error.";
my @lines = <BUFF>;
close(BUFF);
my $count = scalar @lines;
for(my $i = 0; $i < $count; $i++) {
$lines[$i] =~ s/\\begin{sls}{([A-z]*)}/\\begin{sls}{\1}{foo$i}/g;
}
my @outlines = ("\\documentclass[12pt,letterpaper]{article}\n", "\\usepackage{notes}\n", "\\usepackage[margin=0.5in]{geometry}\n", "\\pagestyle{empty}\n", "\\begin{document}\n", @lines, "\\end{document}\n");
open(BUFF, ">$outfile") || die "Output file opening error.";
print BUFF @outlines;
close(BUFF);

notes.sty

\ProvidesPackage{notes}[2007/01/03 note list formatter]
\usepackage[dvips]{graphicx}
\usepackage{wrapfig}
\usepackage{color}
\usepackage{polynom}
\usepackage{mathrsfs}
\usepackage{amsmath}
\usepackage{amsfonts}
\polyset{vars=}
\newenvironment{note}[2]{
\hfill \emph{`` #1''}

\hfill #2

}
{
\par
}
\newenvironment{sls}[2]{
\newcounter{#2}\begin{list}{\csname#1\endcsname{#2}.}{\usecounter{#2}}
}
{
\end{list}\par
}
\newcommand{\dm}[1]{$\displaystyle #1$}
\newcommand{\im}[1]{\item $\displaystyle #1$}
\newcommand{\Sum}{
\displaystyle\sum
}
\newcommand{\Lim}{
\displaystyle\lim
}
\newcommand{\Int}{
\displaystyle\int
}
\newcommand{\laplace}{\mathscr{L}}
\newcommand{\ns}{\mathscr{N}}
\newcommand{\rng}{\mathscr{R}}
\newcommand{\s}{\mathbb{S}}
\renewcommand{\choose}[2]{\left(\begin{array}{c}
#1 \\
#2 \\
\end{array}\right)}
\newcommand{\rsp}{\mbox{Row}}
\newcommand{\csp}{\mbox{Col}}
\newcommand{\real}{\mathbb{R}}
\newcommand{\complex}{\mathbb{C}}
\newcommand{\rational}{\mathbb{Q}}
\newcommand{\To}{$\to$\hspace{4pt}}
\newcommand{\E}[1]{\times 10^{#1}}
\newcommand{\diff}[2]{\frac{d #1}{d #2}}
\newcommand{\pdiff}[2]{\displaystyle\frac{\partial #1}{\partial #2}}
\newcommand{\degree}{^\circ}
\newcommand{\tdot}{$\cdot$}
\newcommand{\then}{\mbox{then}}
\newcommand{\lvb}{\left <}
\newcommand{\rvb}{\right >}
\newcommand{\pvec}[1]{\left < #1\right >}
\newcommand{\lb}{\left [}
\newcommand{\rb}{\right ]}
\newcommand{\pbs}[1]{\left [ #1\right ]}
\newcommand{\bbs}[1]{\Big [ #1\Big ]}
\newcommand{\lp}{\left (}
\newcommand{\rp}{\right )}
\newcommand{\pcs}[1]{\left \{ #1\right \}}
\newcommand{\pps}[1]{\left ( #1\right )}
\newcommand{\abs}[1]{\left |#1\right |}
\newcommand{\vlen}[1]{\left \|#1\right \|}
\newcommand{\eval}[2]{\Big |_{#1}^{#2}}
\newcommand{\spn}[1]{\mbox{span}\pcs{#1}}
\newcommand{\spp}[1]{\mbox{span}}
\newcommand{\bol}[1]{\textbf{#1}}
\newcommand{\ita}[1]{\textit{#1}}
\newcommand{\und}[1]{\underline{#1}}
%\newcommand{\iint}{\int\!\!\!\int}
%\newcommand{\iiint}{\int\!\!\!\int\!\!\!\int}
\newcommand{\blue}[1]{\begin{color}{blue}#1\end{color}}
\newcommand{\green}[1]{\begin{color}{green}#1\end{color}}
\newcommand{\red}[1]{\begin{color}{red}#1\end{color}}
\newcommand{\cyan}[1]{\begin{color}{cyan}#1\end{color}}


\newcommand{\ihat}{\hat\imath}
\newcommand{\jhat}{\hat\jmath}
\newcommand{\khat}{\hat k}


\newcommand{\Sup}[1]{$\displaystyle ^{\mbox{\tiny #1}}$}
\newcommand{\Sub}[1]{$\displaystyle _{\mbox{\tiny #1}}$}
\renewenvironment{matrix}[1]{\left [\begin{array}{ #1}}
{\end{array}\right ]}
\newenvironment{varr}{\left [\begin{array}{c}}
{\end{array}\right ]}
\newenvironment{detr}[1]{\left |\begin{array}{ #1}}
{\end{array}\right |}
\newenvironment{forty}{T\left (\left [\begin{array}{c}}
{\end{array}\right ]\right )}
\newcommand{\pldv}[4]{\polyset{vars=#1}\polylongdiv[stage=#2]{#3}{#4}\polyset{vars=}}
\newcommand{\syndev}[5]{\begin{array}{r | #2}
#1 & #3 \\
&&#4 \\
\hline
& #5 \\
\end{array}}

Portfind

Although done several months ago, this is one of my most memorable Perl scripts. It's a script designed to search for ebuilds under any Portage tree, regardless of package managers. Unlike most package managers I've seen, it also searches the metadata.xml files in the tree.

portfind-usql

#!/usr/bin/perl
use strict;
use File::Basename;
use XML::DOM;
use Term::ANSIColor;
use Digest::MD5 qw(md5 md5_hex);
use MIME::Base64;
use Encode;
use DBI;
use Switch;

our $searchall;
our $colorreplace = -1;
our $insensitive = -1;
our $printg = 1;
our $arch = undef;
our %portdirs;
our %eclasses;
our %modtimes;
our $dbfile = undef;
our $monitorupdates = -1;
our $newdb;
our $nocolor = -1;
#our $ebmode = -1;
our @searchterms;




if(-e "/etc/portfind.conf") {
open(FILE, "</etc/portfind.conf") || die "Configuration file is unreadable.\n";
my @lines = <FILE>;
chomp(@lines);
close(FILE);
foreach my $line (@lines) {
if("$line" =~ /^[\s]*\#/) {
}
elsif("$line" =~ /^[\s]*[Hh]ighlight[\:\s]+([Yy]es|[Nn]o)[\s]*$/) {
my $pre = "$line";
$pre =~ s/^[\s]*[Hh]ighlight[\:\s]+([Yy]es|[Nn]o)[\s]*$/\1/;
$pre = lc($pre);
switch($pre) {
case "yes" { $colorreplace = 1 }
else {$colorreplace = 0 }
}
}
elsif("$line" =~ /^[\s]*[Cc]ase[Ii]nsensitive[\:\s]+([Yy]es|[Nn]o)[\s]*$/) {
my $pre = "$line";
$pre =~ s/^[\s]*[Cc]ase[Ii]nsensitive[\:\s]+([Yy]es|[Nn]o)[\s]*$/\1/;
$pre = lc($pre);
switch($pre) {
case "yes" { $insensitive = 1 }
else {$insensitive = 0 }
}
}
elsif("$line" =~ /^[\s]*[Mm]onitor[Uu]pdates[\:\s]+([Yy]es|[Nn]o)[\s]*$/) {
my $pre = "$line";
$pre = lc($pre);
$pre =~ s/^[\s]*[Mm]onitor[Uu]pdates[\:\s]+([Yy]es|[Nn]o)[\s]*$/\1/;
switch($pre) {
case "yes" { $monitorupdates = 1 }
else { $monitorupdates = 0 }
}
}
# elsif("$line" =~ /^[\s]*[Ee]build[Mm]ode[\:\s]+([Ss]hell|[Oo]ld)[\s]*$/) {
# my $pre = "$line";
# $pre = lc($pre);
# $pre =~ s/^[\s]*[Ee]build[Mm]ode[\:\s]+([Ss]hell|[Oo]ld)[\s]*$/\1/;
# switch($pre) {
# case "shell" { $monitorupdates = 1 }
# else { $monitorupdates = 0 }
# }
# }
elsif("$line" =~ /^[\s]*[Aa]rch[\:\s]+[A-z0-9\-]+?[\s]*$/) {
my $pre = "$line";
$pre =~ s/^[\s]*[Aa]rch[\:\s]+([A-z0-9\-]+?)[\s]*$/\1/;
$pre = lc($pre);
$arch = "$pre";
}
elsif("$line" =~ /^[\s]*[Ss][Qq][Ll][Ff]ile[\:\s]+[^\:\s]+?[\s]*$/) {
my $pre = "$line";
$pre =~ s/^[\s]*[Ss][Qq][Ll][Ff]ile[\:\s]+([^\:\s]+?)[\s]*$/\1/;
$pre = lc($pre);
$dbfile = "$pre";
}
elsif("$line" =~ /^[\s]*[Pp]ort[Dd]ir[\:\s]+[a-z0-9_-]+?[\:\s]+[^\:\s]+?[\:\s]+[^\:\s]+?[\s]*$/) {
my $key = "$line";
$key =~ s/^[\s]*[Pp]ort[Dd]ir[\:\s]+([a-z0-9_-]+?)[\:\s]+[^\:\s]+?[\:\s]+[^\:\s]+?[\s]*$/\1/;
my $pre = "$line";
$pre =~ s/^[\s]*[Pp]ort[Dd]ir[\:\s]+[a-z0-9_-]+?[\:\s]+([^\:\s]+?)[\:\s]+[^\:\s]+?[\s]*$/\1/;
my $eclass = "$line";
$eclass =~ s/^[\s]*[Pp]ort[Dd]ir[\:\s]+[a-z0-9_-]+?[\:\s]+[^\:\s]+?[\:\s]+([^\:\s]+?)[\s]*$/\1/;
$portdirs{$key} = $pre;
$eclasses{$key} = $eclass;
}
}
}
if($colorreplace == -1) {
$colorreplace = 1;
}
if($insensitive == -1) {
$insensitive = 1;
}
if($nocolor == -1) {
$nocolor = 0;
}
if($monitorupdates == -1) {
$monitorupdates = 0;
}
#if($ebmode == -1) {
# $ebmode = 1;
#}
if(!$arch) {
$arch = "x86";
}
if(!$dbfile) {
$dbfile = "/usr/portfind.dbl";
}
if(!scalar %portdirs) {
%portdirs = ("gentoo" => "/usr/portage");
%eclasses = ("gentoo" => "/usr/portage/eclass");
}



my @opts;
foreach my $ARG (@ARGV) {
if($ARG =~ /^\-\-[^-]+.*$/) {
push(@opts, $ARG);
}
}


if(grep(/^\-\-insensitive$/, @opts)) {
$insensitive = 1;
}
elsif(grep(/^\-\-no\-insensitive$/, @opts)) {
$insensitive = 0;
}
if(grep(/^\-\-highlight$/, @opts)) {
$colorreplace = 1;
}
elsif(grep(/^\-\-no\-highlight$/, @opts)) {
$colorreplace = 0;
}
if(grep(/^\-\-monitor\-updates$/, @opts)) {
$monitorupdates = 1;
}
elsif(grep(/^\-\-no\-monitor\-updates$/, @opts)) {
$monitorupdates = 0;
}
if(grep(/^\-\-no-color$/, @opts)) {
$nocolor = 1;
}






if($printg) {
my $text .= "Portfind-uSQL pre-alpha, Copyright (C) 2007 Neil E. Hodges\n";
$text .= "portfind-uSQL comes with ABSOLUTELY NO WARRANTY\n";
print $text;
}





if(-e "$dbfile" && $monitorupdates) {
my $dbh = DBI->connect("dbi:SQLite:$dbfile") || die "Unable to open DBFile: $dbfile\n";
foreach my $key (%portdirs) {
my $portdir = $portdirs{$key};
if(-e "$portdir") {
my $modtime = -A "$portdir";
my $dbmodtime;
my $dbdata = $dbh->selectall_arrayref("SELECT * FROM modtimes WHERE dir = \'$portdir\'");
foreach my $dbdat (@{$dbdata}) {
$dbmodtime = ${$dbdat}[2];
}
if(abs($dbmodtime - $modtime) >= 0.02) {
print colored("$portdir has been modified", 'bold red') . ": Please " . colored("--update", 'bold yellow') . "\n";
$modtimes{$key} = 1;
}
elsif(!$dbmodtime) {
print colored("${portdir}'s modification time hasn't been recorded", 'bold red') . ": Please " . colored("--update", 'bold yellow') . "\n";
}
else {
$modtimes{$key} = 0;
}
}
}
$dbh->disconnect;
}


if(scalar @ARGV < 1) {
$searchall = 1;
}
elsif(grep(/^\-\-update$/, @opts)) {
$newdb = 1;
$searchall = 1;
}
elsif(grep(/^\-\-help$/, @opts)) {
my $text = "Usage: " . basename($0) . " " . colored("\[", 'bold') . " " . colored("option", 'bold green') . " " . colored("\|", 'bold') . " search terms " . colored("\]", 'bold') . "\n";
$text .= "\t" . colored("Options:\n", 'bold');
$text .= "\t\t" . colored("--help", 'bold green') . ": Display this message.\n";
$text .= "\t\t" . colored("--update", 'bold yellow') . ": Update database.\n";
$text .= "\t\t" . colored("--help-config", 'bold red') . ": Configuration help.\n";
$text .= "\t\t" . colored("--no-color", 'bold blue') . ": Disables colored output.\n";
$text .= "\tThe following options can be given the " . colored("--no", 'bold') . " beginning. E.G.: --no-insensitive\n";
$text .= "\t\t" . colored("--insensitive", 'bold cyan') . ": Toggles case sensitivity.\n";
$text .= "\t\t" . colored("--highlight", 'bold cyan') . ": Toggles highlighting of search terms in found text.\n";
$text .= "\t\t" . colored("--monitor-updates", 'bold cyan') . ": Toggles Portage tree update monitoring by access time.\n";
if($nocolor) {
print &nocolor("$text");
}
else {
print "$text";
}
exit;
}
elsif(grep(/^\-\-help-config$/, @opts)) {
my $text = colored(basename($0) . " Configuration:", 'bold') . "\n";
$text .= "Configuration file lies at " . colored("/etc/portfind.conf", 'bold blue') . ": " . ((-e "/etc/portfind.conf") ? colored("Found", 'bold green') : colored("Not found", 'bold red')) . "\n";
$text .= "\tAny line began with a \# is a comment.\n";
$text .= "\tLines are written a leading config option, and separators are \: and/or spaces, ending with a newline.\n";
$text .= "\t\tE.G.: \"CaseInsensitive\: Yes\"\n";
$text .= "\t" . colored("CaseInsensitive", 'bold cyan') . ": " . colored("Yes", 'bold green') . " or " . colored("No", 'bold red') . ": Toggles whether to search without case sensitivity.\n";
$text .= "\t\t" . colored("Note", 'bold') . ": The case sensitive search is much quicker.\n";
$text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . (($insensitive) ? colored("Yes", 'bold green') : colored("No", 'bold red')) . "\n";
$text .= "\t" . colored("Highlight", 'bold cyan') . ": " . colored("Yes", 'bold green') . " or " . colored("No", 'bold red') . ": Toggles whether to highlight search terms in found text.\n";
$text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . (($colorreplace) ? colored("Yes", 'bold green') : colored("No", 'bold red')) . "\n";
$text .= "\t" . colored("MonitorUpdates", 'bold cyan') . ": " . colored("Yes", 'bold green') . " or " . colored("No", 'bold red') . ": Toggles whether updates are monitored via access times.\n";
$text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . (($monitorupdates) ? colored("Yes", 'bold green') : colored("No", 'bold red')) . "\n";
# $text .= "\t" . colored("EbuildMode", 'bold cyan') . ": " . colored("Shell", 'bold green') . " or " . colored("Old", 'bold red') . ": Toggles whether to use the new " . colored("ebuld_parse.sh", 'bold green') . " shell script or the old " . colored("ebuild_parse", 'bold red') . " program.\n";
# $text .= "\t\t" . colored("Note", 'bold') . ": The shell script method is faster.\n";
# $text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . (($ebmode) ? colored("Shell", 'bold green') : colored("Old", 'bold red')) . "\n";
$text .= "\t" . colored("Arch", 'bold cyan') . ": The architecture as put by Portage of your current systems.\n";
$text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . colored($arch, 'bold green') . "\n";
$text .= "\t" . colored("SQLFile", 'bold cyan') . ": The location of the SQLite database\n";
$text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . colored($dbfile, 'bold green') . ": " . ((-e $dbfile) ? colored("Found", 'bold green') : colored("Not Found, please ", 'bold red') . colored("--update", 'bold yellow')) . "\n";
$text .= "\t" . colored("PortDir", 'bold cyan') . ": The Portage trees, including overlays and the main tree\n";
$text .= "\t\tMay be specified multiple times for multiple trees.\n";
$text .= "\t\tPortDir: name /path/to/tree /path/to/eclass\n";
if($monitorupdates) {
foreach my $key (keys %portdirs) {
$text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . colored("$key", 'green') . " -> " . colored("$portdirs{$key}", 'bold green') . ": " . ((-e $portdirs{$key}) ? colored("Found", 'bold green') . (($modtimes{$key}) ? "/" . colored("Update", 'bold red') : "") : colored("Not found", 'bold red')) . " (" . colored("Eclass: ", 'bold yellow') . colored("$eclasses{$key}", 'bold green') . ": " . ((-e $eclasses{$key}) ? colored("Found", 'bold green') : colored("Not Found", 'bold red')) . ")\n";
}
}
else {
foreach my $key (keys %portdirs) {
$text .= "\t\t" . colored("Currently", 'bold yellow') . ": " . colored("$key", 'green') . " -> " . colored("$portdirs{$key}", 'bold green') . ": " . ((-e $portdirs{$key}) ? colored("Found", 'bold green') : colored("Not found", 'bold red')) . " (" . colored("Eclass: ", 'bold yellow') . colored("$eclasses{$key}", 'bold green') . ": " . ((-e $eclasses{$key}) ? colored("Found", 'bold green') : colored("Not Found", 'bold red')) . ")\n";
}
}
if($nocolor) {
print &nocolor("$text");
}
else {
print "$text";
}
exit;
}
else {
$searchall = 0;
foreach my $ARG (@ARGV) {
if(!($ARG =~ /^--[^-]+.*$/)) {
push(@searchterms, $ARG);
}
}
}
if($newdb && -e "$dbfile") {
unlink("$dbfile");
}

my $dbh = DBI->connect("dbi:SQLite:$dbfile") || die "Unable to open DBFile: $dbfile\n";



if($newdb) {
STDOUT->autoflush(1);
print "Creating new DB at $dbfile...\n";
my @categories = &generate_db;


$dbh->do("CREATE TABLE categories(id INTEGER PRIMARY KEY AUTOINCREMENT, name CHAR(32))");
$dbh->do("CREATE TABLE ebuilds(id INTEGER PRIMARY KEY AUTOINCREMENT, name CHAR(64), catname CHAR(32), longdesc CHAR(2048), longhash CHAR(32))");
$dbh->do("CREATE TABLE shortdescs(id INTEGER PRIMARY KEY AUTOINCREMENT, ename CHAR(64), catname CHAR(32), version CHAR(32), mask CHAR(8), shortdesc CHAR(1024), shorthash CHAR(32), use CHAR(512))");
$dbh->do("CREATE TABLE modtimes(id INTEGER PRIMARY KEY AUTOINCREMENT, dir CHAR(512), modtime REAL)");

foreach my $key (%portdirs) {
my $portdir = $portdirs{$key};
if(-e "$portdir") {
my $modtime = -A "$portdir";
$dbh->do("INSERT INTO modtimes (dir, modtime) VALUES(\'$portdir\', $modtime)");
}
}


my $sth = $dbh->prepare("INSERT INTO ebuilds (name, catname, longdesc, longhash) VALUES(?, ?, ?, ?)");
my $lth = $dbh->prepare("INSERT INTO shortdescs (ename, catname, version, mask, shortdesc, shorthash, use) VALUES(?, ?, ?, ?, ?, ?, ?)");
print "Building SQLite database.\n";
my $precent = 0;
my $len = scalar @categories;
for(my $i = 0; $i < $len; $i++) {
my $category = $categories[$i];
my $catname = $category->name;
$dbh->do("INSERT INTO categories (name) VALUES(\'$catname\')");
my @ebuilds = @{$category->ebuilds};
foreach my $ebuild (@ebuilds) {
my $ename = $ebuild->name;
my $longdesc = $ebuild->longdesc;
my %shortdesc = %{$ebuild->shortdesc};
my %use = %{$ebuild->use};
my %mask = %{$ebuild->mask};
$longdesc = (($longdesc) ? "$longdesc" : "NULL");
$sth->execute($ename, $catname, $longdesc, &ascii_md5_hex("$longdesc"));
foreach my $key (sort keys %shortdesc) {
$lth->execute($ename, $catname, $key, $mask{$key}, $shortdesc{$key}, &ascii_md5_hex("$shortdesc{$key}"), $use{$key});
}
}
my $percent = (($i + 1) / $len) * 100;
if(abs($precent - $percent) >= 0.7) {
print "\b\b\b\b" . &round($percent) . "%";
$precent = $percent;
}
}
print "\nComplete.\n";
}
else {
if($searchall) {
my @categories = &extract_from_db($dbh);
if($nocolor) {
foreach my $category (@categories) {
foreach my $ebuild (@{$category->ebuilds}) {
print &nocolor(&printinfo($ebuild, $category->name));
}
}
}
else {
foreach my $category (@categories) {
foreach my $ebuild (@{$category->ebuilds}) {
print (&printinfo($ebuild, $category->name));
}
}
}
}
else {
my @found;
STDOUT->autoflush(1);
@found = &search_from_db($dbh);
STDOUT->autoflush(0);
if($nocolor) {
if(scalar @found == 0) {
print "No results.\n";
}
else {
foreach my $sf (@found) {
print &nocolor(&printinfo($sf->ebuild, $sf->category->name));
}
}
}
else {
if(scalar @found == 0) {
print colored("No results.", 'bold red') . "\n";
}
else {
foreach my $sf (@found) {
print (&printinfo($sf->ebuild, $sf->category->name));
}
}
}
}
}
$dbh->disconnect;

sub extract_from_db {
my $dbh = shift;
my @categories;
my $dbcategories = $dbh->selectall_arrayref("SELECT * FROM categories");
foreach my $dbcategory (@{$dbcategories}) {
my $category = new Category;
$category->name(${$dbcategory}[1]);

my $dbebuilds = $dbh->selectall_arrayref("SELECT * FROM ebuilds WHERE catname = \'${$dbcategory}[1]\'");
foreach my $dbebuild (@{$dbebuilds}) {
my $ebuild = new Ebuild;
$ebuild->name(${$dbebuild}[1]);
my $ename = $ebuild->name;
my $longdesc = ${$dbebuild}[3];
$ebuild->longdesc(($longdesc eq "NULL") ? undef : $longdesc);
my $dbshortdescs = $dbh->selectall_arrayref("SELECT * FROM shortdescs WHERE ename = \'$ename\'");
foreach my $dbshortdesc (@{$dbshortdescs}) {
my $version = ${$dbshortdesc}[2];
${$ebuild->shortdesc}{$version} = ${$dbshortdesc}[4];
${$ebuild->mask}{$version} = ${$dbshortdesc}[3];
}
push(@{$category->ebuilds}, $ebuild);
}
push(@categories, $category);
}
return @categories;
}
sub search_from_db {
my $dbh = shift;
my @found;
my $dbcategories = $dbh->selectall_arrayref("SELECT * FROM categories");
print STDERR "Initiating search.\n";
my $len = scalar @{$dbcategories};
my $precent = 0;
for(my $i = 0; $i < $len; $i++) {
my $dbcategory = ${$dbcategories}[$i];
my $category = new Category;
$category->name(${$dbcategory}[1]);
my $catname = ${$dbcategory}[1];
foreach my $term (@searchterms) {
my $dbebuilds;
if($insensitive) {
$dbebuilds = $dbh->selectall_arrayref("SELECT * FROM ebuilds WHERE catname = \'$catname\' AND (name LIKE \'\%$term\%\' OR longdesc LIKE \'\%$term\%\')");
}
else {
$dbebuilds = $dbh->selectall_arrayref("SELECT * FROM ebuilds WHERE catname = \'$catname\' AND (name GLOB \'\*$term\*\' OR longdesc GLOB \'\*$term\*\')");
}
foreach my $dbebuild (@{$dbebuilds}) {
my $ebuild = new Ebuild;
$ebuild->name(${$dbebuild}[1]);
my $ename = ${$dbebuild}[1];
$ebuild->name($ename);
my $longdesc = ${$dbebuild}[3];
if($longdesc ne "NULL") {
}
else {
$longdesc = undef;
}
$ebuild->longdesc($longdesc);




my $dbshortdescs = $dbh->selectall_arrayref("SELECT * FROM shortdescs WHERE ename = \'${$dbebuild}[1]\' AND catname = \'$catname\'");
foreach my $dbshortdesc (@{$dbshortdescs}) {
my $version = ${$dbshortdesc}[3];
my $shortdesc = ${$dbshortdesc}[5];
${$ebuild->shortdesc}{$version} = $shortdesc;
${$ebuild->mask}{$version} = ${$dbshortdesc}[4];
${$ebuild->use}{$version} = ${$dbshortdesc}[7];
}
my $enc = new Encapsulated;
$enc->ebuild($ebuild);
$enc->category($category);
push(@found, $enc);
}


my $dbshortdescs;
if($insensitive) {
$dbshortdescs = $dbh->selectall_arrayref("SELECT * FROM shortdescs WHERE shortdesc LIKE \'\%$term\%\' AND catname = \'$catname\'");
}
else {
$dbshortdescs = $dbh->selectall_arrayref("SELECT * FROM shortdescs WHERE shortdesc GLOB \'\*$term\*\' AND catname = \'$catname\'");
}
foreach my $dbshortdesc(@{$dbshortdescs}) {
my $ename = ${$dbshortdesc}[1];
if(&findebuild_encapsulated("$catname/$ename", 0, @found) == -1) {
my $dbebuilds = $dbh->selectall_arrayref("SELECT * FROM ebuilds WHERE catname = \'$catname\' AND name = \'$ename\'");
my $dbename = undef;
my $longdesc = undef;
foreach my $dbebuild (@{$dbebuilds}) {
if($ename eq ${$dbebuild}[1] && $catname eq ${$dbebuild}[2]) {
$dbename = ${$dbebuild}[1];
$longdesc = ${$dbebuild}[3];
}
}
if($dbename) {
my $ebuild = new Ebuild;
$ebuild->name($ename);
$ebuild->longdesc(($longdesc eq "NULL") ? undef : $longdesc);


my $dbebuild_shortdescs = $dbh->selectall_arrayref("SELECT * FROM shortdescs WHERE ename = \'$ename\' AND catname = \'$catname\'");
foreach my $dbebuild_shortdesc (@{$dbebuild_shortdescs}) {
my $version = ${$dbshortdesc}[3];
my $shortdesc = ${$dbshortdesc}[5];
${$ebuild->shortdesc}{$version} = $shortdesc;
${$ebuild->mask}{$version} = ${$dbshortdesc}[4];
${$ebuild->use}{$version} = ${$dbshortdesc}[7];
}
my $enc = new Encapsulated;
$enc->category($category);
$enc->ebuild($ebuild);
push(@found, $enc);
}
}
}
}
my $percent = (($i + 1) / $len) * 100;
if(abs($precent - $percent) >= 0.7) {
print STDERR "\b\b\b\b" . &round($percent) . "%";
$precent = $percent;
}
}
print STDERR "\nSearch complete.\n";
return @found;
}
sub generate_db {
my @categories;
print "Reading directory tree.\n";
foreach my $key (keys %portdirs) {
my $portdir = $portdirs{$key};
if(-e "$portdir") {
print "\nFor $portdir:\nFinding categories\n";
my @categorydirs = <$portdir/*-*>;
my $len = scalar @categorydirs;
my $precent = 0;
for(my $i = 0; $i < $len; $i++) {
my $category = $categorydirs[$i];
if(-d "$category" && !(&findcategory(@categories, basename("$category")))) {
my $cat = new Category;
$cat->name(basename("$category"));
push(@categories, $cat);
}

my $percent = (($i + 1) / $len) * 100;
if(abs($precent - $percent) >= 0.7) {
print "\b\b\b\b" . &round($percent) . "%";
$precent = $percent;
}
}
print "\nFinding ebuilds\n";



my $precent = 0;
my $len = scalar @categories;
for(my $i = 0; $i < $len; $i++) {
my $category = $categories[$i];
my $catname = $category->name;
foreach my $subdir (<$portdir/$catname/*>) {
my @tfiles = <$subdir/*>; # TEMPORARY TO FIND EBUILDS
if(-d "$subdir" && scalar @tfiles) {
my $ebuild = undef;
my $found = &findebuild(@{$category->ebuilds}, basename("$subdir"));
if($found > -1) {
$ebuild = ${$category->ebuilds}[$found];
}
else {
$ebuild = new Ebuild;
}
$ebuild->name(basename("$subdir"));
foreach my $file (<$subdir/*>) {
if(! -d "$file") {
push(@{$ebuild->files}, basename("$file"));
}
}
if($found > -1) {
${$category->ebuilds}[$found] = $ebuild;
}
else {
push(@{$category->ebuilds}, $ebuild);
}
}
}
my $percent = (($i + 1) / $len) * 100;
if(abs($precent - $percent) >= 0.7) {
print "\b\b\b\b" . &round($percent) . "%";
$precent = $percent;
}
}
}
}
print "\nCreating database from files.";
foreach my $key (keys %portdirs) {
my $portdir = $portdirs{$key};
my $eclass = $eclasses{$key};
if(-e "$portdir") {
print "\nFor $portdir:\n";
my $precent = 0;
my $len = scalar @categories;
for(my $i = 0; $i < $len; $i++) {
my $category = $categories[$i];
my $catname = $category->name;
foreach my $ebuild (@{$category->ebuilds}) {
my $ename = $ebuild->name;
if(-d "$portdir/$catname/$ename") {
foreach my $file (@{$ebuild->files}) {
if("$file" eq "metadata.xml" && -e "$portdir/$catname/$ename/$file") {
my $parser = new XML::DOM::Parser;
my $xml = $parser->parsefile("<$portdir/$catname/$ename/$file");
my $nodes = $xml->getElementsByTagName("longdescription");
my $n = $nodes->getLength;
for(my $i = 0; $i < $n; $i++) {
my $node = $nodes->item($i);
my $lang = $node->getAttributeNode("lang");
if($n == 1 || ($lang && $lang->getValue eq "en")) {
my $children = $node->getChildNodes;
my $nc = $children->getLength;
for(my $c = 0; $c < $nc; $c++) {
my $subnode = $children->item($c);
if($subnode->getNodeType == TEXT_NODE) {
$ebuild->longdesc($subnode->getNodeValue);
}
}
}
}
$xml->dispose;
}
elsif("$file" =~ /\.ebuild$/ && -e "$portdir/$catname/$ename/$file") {
my $version = "$file";
my $tmpename = "$ename";
my $descfound = 0;
my $maskfound = 0;
$tmpename =~ s/\+/\\\+/g;
$version =~ s/^$tmpename-([a-z0-9_.-]+)\.ebuild$/\1:$key/;
# open(FILE, "<$portdir/$catname/$ename/$file");
# my @lines = <FILE>;
# chomp(@lines);
# close(FILE);
my %varhash;
# if($ebmode) {
%varhash = &ebuild_get_vars_sh($catname, "$portdir/$catname/$ename/$file", $eclass);
# }
# else {
# %varhash = &ebuild_get_vars("$portdir/$catname/$ename/$file", $eclass);
# }
# foreach my $line (@lines) {
# if("$line" =~ /DESCRIPTION=\".*?\"/) {
# my $desc = "$line";
# $desc =~ s/^.*?DESCRIPTION=\"(.*?)\".*?$/\1/;
# ${$ebuild->shortdesc}{$version} = "$desc";
# $descfound = 1;
# }
# elsif("$line" =~ /KEYWORDS=\".*?\"/) {
# my $keywords = "$line";
# my $keyword = undef;
#
# if("$keywords" =~ /[\"\s]\~$arch([\"\s])/) {
# $keyword = "~";
# }
# elsif("$keywords" =~ /[\"\s]$arch([\"\s])/) {
# $keyword = "+";
# }
# elsif("$keywords" =~ /[\"\s]\-$arch([\"\s])/) {
# $keyword = "-";
# }
# else {
# $keyword = " ";
# }
# ${$ebuild->mask}{$version} = "$keyword";
# $maskfound = 1;
# }
# }
# DESCRIPTION
${$ebuild->shortdesc}{$version} = $varhash{"DESCRIPTION"};
# MASK
my $keywords = $varhash{"KEYWORDS"};
my $keyword = undef;

if("$keywords" =~ /\~($arch)([^a-z0-9-]+|$)/) {
$keyword = "~";
}
elsif("$keywords" =~ /($arch)([^a-z0-9-]+|$)/) {
$keyword = "+";
}
elsif("$keywords" =~ /\-($arch)([^a-z0-9-]+|$)/) {
$keyword = "-";
}
else {
$keyword = " ";
}
${$ebuild->mask}{$version} = "$keyword";
# END MASK

${$ebuild->use}{$version} = $varhash{"IUSE"};
if($varhash{"DESCRIPTION"} =~ /^[\s\t]*$/) {
${$ebuild->shortdesc}{$version} = undef;
}
}
}
}
}
my $percent = (($i + 1) / $len) * 100;
if(abs($precent - $percent) >= 0.7) {
print "\b\b\b\b" . &round($percent) . "%";
$precent = $percent;
}
}
}
}
print "\nGeneration complete.\n";
return @categories;
}
# NEW EBUILD PARSING CODE

#sub ebuild_get_vars {
# my $efile = shift;
# my $eclass = shift;
# my $foo;
# my %varhash;
# $foo = `ebuild_parse $efile $eclass`;
# my @data = split(/\n/, $foo);
# foreach my $dat (@data) {
# my $varname = $dat;
# $varname =~ s/^\'([A-z0-9_-]*?)\': \'\'\'.*\'\'\'$/\1/;
# my $varvalue = $dat;
# $varvalue =~ s/^\'[A-z0-9_-]*?\': \'\'\'(.*)\'\'\'$/\1/;
# $varhash{$varname} = $varvalue;
# }
# return %varhash;
#}
sub ebuild_get_vars_sh {
my $catname = shift;
my $efile = shift;
my $eclass = shift;
my $foo;
my %varhash;
my $pv = basename($efile);
my $pdir = $efile; # Package name
$pdir =~ s/\/[^\/]*\.ebuild$//;
$pdir = basename($pdir);
$pdir =~ s/(\W)/\\\1/g;
if($pv =~ /^$pdir-.*?-r[0-9]+\.ebuild/) {
$pv =~ s/^$pdir-(.*?)-r[0-9]+\.ebuild$/\1/;
}
else {
$pv =~ s/^$pdir-(.*?)\.ebuild$/\1/;
}
$foo = `ebuild_parse.sh $efile $catname $pdir $pv $eclass`;
my @data = split(/\n/, $foo);
foreach my $dat (@data) {
my $varname = $dat;
$varname =~ s/^\'([A-z0-9_-]*?)\': \'\'\'.*\'\'\'$/\1/;
my $varvalue = $dat;
$varvalue =~ s/^\'[A-z0-9_-]*?\': \'\'\'(.*)\'\'\'$/\1/;
$varhash{$varname} = $varvalue;
}
return %varhash;
}



sub findcategory {
my $catname = pop @_;
my @categories = @_;
foreach my $category (@categories) {
my $name = $category->name;
if("$name" eq "$catname") {
return 1;
}
}
return 0;
}
sub findebuild {
my $ename = pop @_;
my @ebuilds = @_;
for(my $i = 0; $i < scalar @ebuilds; $i++) {
my $name = $ebuilds[$i]->name;
if("$name" eq "$ename") {
return $i;
}
}
return -1;
}
sub findebuild_encapsulated {
my $ename = shift;
my $i0 = shift;
my @encapsulated = @_;
for(my $i = $i0; $i < scalar @encapsulated; $i++) {
my $enc = $encapsulated[$i];
my $category = $enc->category;
my $catname = $category->name;

my $ebuild = $enc->ebuild;
my $cename = $ebuild->name;
if($ename eq "$catname/$cename") {
return $i;
}
}
return -1;
}
sub highlight {
my $term = shift;
my $text = shift;
my $colors = shift;
my $recolor = color shift;
my $uncolor = color 'reset';
my @captured;
if($insensitive) {
@captured = "$text" =~ /$term/ig;
}
else {
@captured = "$text" =~ /$term/g;
}
foreach my $found (@captured) {
my $colored = colored("$found", $colors);
my $filterfound = "$found";
$filterfound =~ s/(\W)/\\\1/g;
$text =~ s/$filterfound/${uncolor}${colored}${recolor}/g;
}
return $text;
}

sub printinfo {
my $ebuild = shift;
my $catname = shift;
my $ename = $ebuild->name;
my $longdesc = $ebuild->longdesc;
my %shortdesc = %{$ebuild->shortdesc};
my %mask = %{$ebuild->mask};
my %use = %{$ebuild->use};
if($colorreplace) {
foreach my $term (@searchterms) {
$ename = &highlight($term, $ename, 'cyan', 'bold blue');
$longdesc = &highlight($term, $longdesc, 'cyan', 'reset');
foreach my $version (keys %shortdesc) {
$shortdesc{$version} = &highlight($term, $shortdesc{$version}, 'cyan', 'reset');
}
}
}

my $ret = colored("$catname/$ename\n", 'bold blue');
$ret .= "\t" . colored("Short Description\n", 'bold green');
foreach my $version (reverse sort keys %shortdesc) {
my $maskcolor = color('reset') . colored("$mask{$version}", 'red') . color('bold yellow');
$ret .= "\t\t" . colored("$version [$maskcolor]: ", 'bold yellow') . "$shortdesc{$version}\n";
if($use{$version}) {
$ret .= "\t\t\t" . colored("USE:", 'bold blue') . " " . colored($use{$version}, 'green') . "\n";
}
}
if($longdesc && !("$longdesc" =~ /^[\s\t\n]*$/)) {
my @arraydesc = split(/\n/, "$longdesc");
chomp(@arraydesc);
if(!$arraydesc[0]) {
shift(@arraydesc);
}
$ret .= "\t" . colored("Long Description\n", 'bold red');
foreach my $line (@arraydesc) {
$line =~ s/^[\s\t]*/\t\t/g;
$ret .= "$line\n";
}
}
$ret .= "\n";
return "$ret";
}
sub ascii_md5_hex {
my $text = shift;
$text = encode("ascii", "$text");
return md5_hex("$text");
}
sub round {
my $number = shift;
return int($number + .5 * ($number <=> 0));
}
sub nocolor {
my $text = shift;
$text =~ s/\e\[.+?m//g;
return $text;
}



package Category;
sub new {
my $self = { };
my $class = shift;
return bless($self, $class);
}
sub name {
my $self = shift;
$self->{NAME} = shift if @_;
return $self->{NAME};
}
sub ebuilds {
my $self = shift;
if(!defined $self->{EBUILDS}) {
$self->{EBUILDS} = [ ];
}
return $self->{EBUILDS};
}
package Encapsulated;
sub new {
my $self = { };
my $class = shift;
return bless($self, $class);
}
sub category {
my $self = shift;
$self->{CATEGORY} = shift if @_;
return $self->{CATEGORY};
}
sub ebuild {
my $self = shift;
$self->{EBUILD} = shift if @_;
return $self->{EBUILD};
}
package Ebuild;
sub new {
my $self = { };
my $class = shift;
return bless($self, $class);
}
sub name {
my $self = shift;
$self->{NAME} = shift if @_;
return $self->{NAME};
}
sub files {
my $self = shift;
if(!defined $self->{FILES}) {
$self->{FILES} = [ ];
}
return $self->{FILES};
}
sub longdesc {
my $self = shift;
$self->{LDESC} = shift if @_;
return $self->{LDESC};
}
sub shortdesc {
my $self = shift;
if(!defined $self->{SDESC}) {
$self->{SDESC} = { };
}
return $self->{SDESC};
}
sub use {
my $self = shift;
if(!defined $self->{USE}) {
$self->{USE} = { };
}
return $self->{USE};
}
sub mask {
my $self = shift;
if(!defined $self->{MASK}) {
$self->{MASK} = { };
}
return $self->{MASK};
}

Example portfind.conf

Highlight: yes
CaseInsensitive: no
Arch: amd64
SeachMode: DB
Portdir: gentoo /usr/portage /usr/portage/eclass
SQLFile: /usr/portfind.dbl
MonitorUpdates: no

ebuild_parse.sh

#!/bin/bash
env -i
set +o posix
if [ "$5" = "" ]; then
echo "Usage: $0 ebuild catname ename vers eclassdir"
exit 1
fi
GCONF_DEBUG='yes'
ARTS_REQUIRED='no'
EBUILDFILE=$1
CATEGORY=$2
PN=$3
PV=$4
ECLASSDIR=$5


# BEGIN COPYRIGHT
# Copyright (c) 1999-2005 Gentoo Foundation

SANDBOX_PREDICT="${SANDBOX_PREDICT}:/proc/self/maps:/dev/console:/dev/random"
export SANDBOX_PREDICT="${SANDBOX_PREDICT}:${PORTAGE_PYM_PATH}:${PORTAGE_DEPCACHEDIR}"
export SANDBOX_WRITE="${SANDBOX_WRITE}:/dev/shm:/dev/stdout:/dev/stderr:${PORTAGE_TMPDIR}"
export SANDBOX_READ="${SANDBOX_READ}:/dev/shm:/dev/stdin:${PORTAGE_TMPDIR}"

if [ ! -z "${PORTAGE_GPG_DIR}" ]; then
SANDBOX_PREDICT="${SANDBOX_PREDICT}:${PORTAGE_GPG_DIR}"
fi

declare -rx EBUILD_PHASE

function qa_source () {
local shopts=$(shopt) OLDIFS="$IFS"
source "$@" || return 1
# [[ $shopts != $(shopt) ]] &&
# eqawarn "QA Notice: Global shell options changed and were not restored while sourcing '$*'"
# [[ "$IFS" != "$OLDIFS" ]] &&
# eqawarn "QA Notice: Global IFS changed and was not restored while sourcing '$*'"
return 0
}

function qa_call() {
local shopts=$(shopt) OLDIFS="$IFS"
"$@" || return 1
# [[ $shopts != $(shopt) ]] &&
# eqawarn "QA Notice: Global shell options changed and were not restored while calling '$*'"
# [[ "$IFS" != "$OLDIFS" ]] &&
# eqawarn "QA Notice: Global IFS changed and was not restored while calling '$*'"
return 0
}

# We need this next line for "die" and "assert". It expands
# It _must_ preceed all the calls to die and assert.
shopt -s expand_aliases
function die () {
echo -n
}
#alias die='exit 1'
alias assert='_pipestatus="${PIPESTATUS[*]}"; [[ "${_pipestatus// /}" -eq 0 ]] || exit 1'
alias save_IFS='[ "${IFS:-unset}" != "unset" ] && old_IFS="${IFS}"'
alias restore_IFS='if [ "${old_IFS:-unset}" != "unset" ]; then IFS="${old_IFS}"; unset old_IFS; else unset IFS; fi'

OCC="$CC"
OCXX="$CXX"


# the sandbox is disabled by default except when overridden in the relevant stages
export SANDBOX_ON="0"

function addread () {
echo -n
}

function addwrite () {
echo -n
}

function adddeny () {
echo -n
}

function addpredict () {
echo -n
}

function lchown () {
chown -h "$@"
}

function lchgrp () {
chgrp -h "$@"
}
function esyslog () {
return 0
}

function use () {
useq ${1}
}

function usev () {
if useq ${1}; then
echo "${1}"
return 0
fi
return 1
}

function useq () {
local u=$1
local found=0

# if we got something like '!flag', then invert the return value
if [[ ${u:0:1} == "!" ]] ; then
u=${u:1}
found=1
fi

# Make sure we have this USE flag in IUSE
if ! hasq "${u}" ${IUSE} ${E_IUSE} && ! hasq "${u}" ${PORTAGE_ARCHLIST} selinux; then
# eqawarn "QA Notice: USE Flag '${u}' not in IUSE for ${CATEGORY}/${PF}"
echo -n
fi

if hasq ${u} ${USE} ; then
return ${found}
else
return $((!found))
fi
}
function has_version () {
if [ "${EBUILD_PHASE}" == "depend" ]; then
return 1
fi
if "${PORTAGE_BIN_PATH}/portageq" 'has_version' "${ROOT}" "$1"; then
return 0
else
return 1
fi
}

function portageq () {
if [ "${EBUILD_PHASE}" == "depend" ]; then
return 1
fi
"${PORTAGE_BIN_PATH}/portageq" "$@"
}


function hasq () {
[[ " ${*:2} " == *" $1 "* ]]
}
function has () {
hasq "$@"
}
function debug-print () {
echo -n
}

function debug-print-function () {
echo -n
}

function debug-print-section () {
echo -n
}
function use_with () {
if [ -z "$1" ]; then
echo "!!! use_with() called without a parameter." >&2
echo "!!! use_with <USEFLAG> [<flagname> [value]]" >&2
return 1
fi

local UW_SUFFIX=""
if [ ! -z "${3}" ]; then
UW_SUFFIX="=${3}"
fi

local UWORD="$2"
if [ -z "${UWORD}" ]; then
UWORD="$1"
fi

if useq $1; then
echo "--with-${UWORD}${UW_SUFFIX}"
else
echo "--without-${UWORD}"
fi
return 0
}

function use_enable () {
if [ -z "$1" ]; then
echo "!!! use_enable() called without a parameter." >&2
echo "!!! use_enable <USEFLAG> [<flagname> [value]]" >&2
return 1
fi

local UE_SUFFIX=""
if [ ! -z "${3}" ]; then
UE_SUFFIX="=${3}"
fi

local UWORD="$2"
if [ -z "${UWORD}" ]; then
UWORD="$1"
fi

if useq $1; then
echo "--enable-${UWORD}${UE_SUFFIX}"
else
echo "--disable-${UWORD}"
fi
return 0
}
function eerror () {
echo -n
}
# END COPYRIGHT
function EXPORT_FUNCTIONS {
for i in $*
do
export $i
done
}
function inherit () {
for i in $*
do
if [ -e "$ECLASSDIR/$i.eclass" ]; then
source "$ECLASSDIR/$i.eclass"
else
source "/usr/portage/eclass/$i.eclass"
fi
done
}

source "$EBUILDFILE"
echo "'IUSE': '''$IUSE'''"
echo "'KEYWORDS': '''$KEYWORDS'''"
echo "'DESCRIPTION': '''$DESCRIPTION'''"

Help output

# portfind-usql --help
Portfind-uSQL pre-alpha, Copyright (C) 2007 Neil E. Hodges
portfind-uSQL comes with ABSOLUTELY NO WARRANTY
Usage: portfind-usql [ option | search terms ]
Options:
--help: Display this message.
--update: Update database.
--help-config: Configuration help.
--no-color: Disables colored output.
The following options can be given the --no beginning. E.G.: --no-insensitive
--insensitive: Toggles case sensitivity.
--highlight: Toggles highlighting of search terms in found text.
--monitor-updates: Toggles Portage tree update monitoring by access time.
# portfind-usql --help-config
Portfind-uSQL pre-alpha, Copyright (C) 2007 Neil E. Hodges
portfind-uSQL comes with ABSOLUTELY NO WARRANTY
portfind-usql Configuration:
Configuration file lies at /etc/portfind.conf: Found
Any line began with a # is a comment.
Lines are written a leading config option, and separators are : and/or spaces, ending with a newline.
E.G.: "CaseInsensitive: Yes"
CaseInsensitive: Yes or No: Toggles whether to search without case sensitivity.
Note: The case sensitive search is much quicker.
Currently: No
Highlight: Yes or No: Toggles whether to highlight search terms in found text.
Currently: Yes
MonitorUpdates: Yes or No: Toggles whether updates are monitored via access times.
Currently: No
Arch: The architecture as put by Portage of your current systems.
Currently: amd64
SQLFile: The location of the SQLite database
Currently: /usr/portfind.dbl: Found
PortDir: The Portage trees, including overlays and the main tree
May be specified multiple times for multiple trees.
PortDir: name /path/to/tree /path/to/eclass
Currently: gentoo -> /usr/portage: Found (Eclass: /usr/portage/eclass: Found)
)