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 | |
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 |
Back to
Code Catacombs