Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Greyhawk Deity Tool

by bellaire (Hermit)
on Mar 10, 2009 at 01:09 UTC ( [id://749465]=sourcecode: print w/replies, xml ) Need Help??
Category: Fun Stuff
Author/Contact Info
Description: An example of things I do when bored at work. Not a terribly good example of much else. We use the names of Greyhawk deities for our internal projects, and scanning the Wikipedia page to find them was getting old. So, uh, this thing grabs the page markup using LWP::UserAgent, does some simple parsing, and internalizes the result for easy searches.

Update: As requested, made some minor adjustments to the usage description which should improve its clarity.
#!/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]
        };
    }
}
Replies are listed 'Best First'.
Re: Greyhawk Deity Tool
by dekimsey (Sexton) on Mar 10, 2009 at 15:11 UTC
    Awesomeness!
Re: Greyhawk Deity Tool
by zentara (Archbishop) on Mar 10, 2009 at 11:38 UTC
Re: Greyhawk Deity Tool
by webfiend (Vicar) on Mar 10, 2009 at 19:38 UTC

    Nice! A tiny bit more info in usage would be useful, though. It took me a couple of tries to figure out that the output of --list-portfolio was to be used in --find rather than --category

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2024-04-19 21:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found