#!/usr/bin/perl -w
use LWP::UserAgent;
use Data::Dumper;
use Getopt::Long;
use HTML::Entities;
my $DATA_URL = 'http://en.wikipedia.org/wiki/Special:Export/List_of_Gr
+eyhawk_deities';
my $USAGE = << "USAGE_END";
Usage: gh-deity <option>
Options:
Searching Portfolios:
-f | --find <str> Searches for deities where <str> is a
substring of a keyword in his/her portfoli
+o.
-p | --list-portfolio List all unique keywords available in
the portfolios of listed deities.
Searching Categories of Deities:
-n | --name-like <str> Search for deities where <str> is
a substring of his/her name (case-
insensitive)
-c | --category [cat] List all deities from the given category,
e.g. 'dwarven deities', 'elven deities',
or list valid categories. (Matches substri
+ngs)
-t | --type [type] List all deities by the given type, e.g.
god, goddess, demi-god, etc. With no
argument, lists valid types.
Information on a single deity:
-d | --deity <deity> Retrieve information for the named <deity>
+,
case-insensitive.
USAGE_END
my %all_ports;
my %gods;
my %categories;
my %types;
my ( $category, $deity, $find, $list_port, $name_like, $type );
get_options();
load_data();
if ($name_like) {
god_info($_) for ( map { $gods{$_} } grep {/$name_like/i} keys %go
+ds );
}
if ($find) {
for $d ( values %gods ) {
god_info($d) if ( scalar grep {/$find/i} @{ $d->{portfolio} }
+);
}
}
if ($deity) {
if ( exists $gods{ lc($deity) } ) {
god_info( $gods{ lc($deity) } );
}
else {
print "Deity not found: $deity\n";
}
}
if ($list_port) {
print join( q{, }, sort keys %all_ports );
print "\n";
}
if ( defined $category ) {
list_deities( 'category', $category, \%categories );
}
if ( defined $type ) {
list_deities( 'type', $type, \%types );
}
sub usage {
my $msg = shift;
if ( defined $msg ) {
print "$msg\n$USAGE";
exit(1);
}
print $USAGE;
exit(0);
}
sub get_options {
my $result = GetOptions(
'category|c:s' => \$category,
'deity|d=s' => \$deity,
'find|f=s' => \$find,
'list-portfolio|p' => \$list_port,
'name-like|n=s' => \$name_like,
'type|t:s' => \$type,
);
my $num_opts = scalar grep { defined $_ } ( $category, $deity, $fi
+nd, $list_port, $name_like, $type );
unless ($num_opts) {
usage();
}
if ( 1 < $num_opts ) {
usage("Only one option at a time, please");
}
if ( not $result ) {
usage("Invalid options detected");
}
}
sub god_info {
my $god = shift;
printf "%s (%s) [%s]\n\t%s\n\n", $god->{name}, $god->{category}, $
+god->{type}, join( q{,}, @{ $god->{portfolio} } );
}
sub list_deities {
my ( $name, $var, $hash ) = @_;
if ( $var eq "" ) {
printf "%s listing:\n", ucfirst($name);
print join( "\n", sort keys %$hash );
print "\n";
}
else {
if ( exists $hash->{ lc($var) } ) {
printf "Known deities of $name '%s':\n", lc($var);
for my $gname ( sort grep { lc( $gods{$_}->{$name} ) eq $v
+ar } keys %gods ) {
god_info( $gods{$gname} );
}
}
else {
printf "%s not found: %s\n", ucfirst($name), $var;
}
}
}
sub load_data {
my $ua = LWP::UserAgent->new;
my @data;
$ua->timeout(5);
my $response = $ua->get($DATA_URL);
if ( $response->is_success ) {
@data = split( /\n/, decode_entities( $response->decoded_conte
+nt ) );
}
else {
die "Unable to retrieve $DATA_URL\n";
}
my $current_category;
for (@data) {
if (/^=+(.+?)=+/) {
$current_category = $1;
}
my ( $name, $type, $portfolio ) = /^\*\[\[(?:.+\|)?(.+?)\]\],
+([^\(\[]+?) (?:of (.+))/;
if ( defined $portfolio ) {
$portfolio =~ s/\[\[(?:.+\|)?(.+)\]\]/$1/g;
$portfolio =~ s/\<ref.*?\>//g;
$portfolio =~ s/\<.*?\>//g;
$portfolio =~ s/\[.*?\]//g;
$portfolio =~ s/\(.*?\)//g;
}
my @portfolio = grep { length($_) > 1 }
split( /\s*,\s*|\s*and\s*|\s*&\s*/, defined $portfolio ? l
+c($portfolio) : q{} );
s/[^\w\s]//g for (@portfolio);
s/^\s*|\s*$//g for (@portfolio);
@all_ports{@portfolio} = (1) x @portfolio;
next unless ( defined $name );
$categories{ lc($current_category) } = 1;
$types{ lc($type) } = 1;
$gods{ lc($name) } = {
name => $name,
type => $type,
category => $current_category,
portfolio => [@portfolio]
};
}
}
|