{ "content": [ { "type": "text", "text": "# WWW::Mechanize::Examples (perldoc)\n\n## NAME\n\nWWW::Mechanize::Examples - Sample programs that use WWW::Mechanize\n\n## SYNOPSIS\n\nPlenty of people have learned WWW::Mechanize, and now, you can too!\nFollowing are user-supplied samples of WWW::Mechanize in action. If you have samples you'd like\nto contribute, please send 'em to \"\".\nYou can also look at the t/*.t files in the distribution.\nPlease note that these examples are not intended to do any specific task. For all I know,\nthey're no longer functional because the sites they hit have changed. They're here to give\nexamples of how people have used WWW::Mechanize.\nNote that the examples are in reverse order of my having received them, so the freshest examples\nare always at the top.\n\n## Sections\n\n- **NAME**\n- **VERSION**\n- **SYNOPSIS** (2 subsections)\n- **AUTHOR**\n- **COPYRIGHT AND LICENSE**\n\nUse structuredContent.sections for detailed options, examples, and full documentation.\n" } ], "structuredContent": { "command": "WWW::Mechanize::Examples", "section": "", "mode": "perldoc", "summary": "WWW::Mechanize::Examples - Sample programs that use WWW::Mechanize", "synopsis": "Plenty of people have learned WWW::Mechanize, and now, you can too!\nFollowing are user-supplied samples of WWW::Mechanize in action. If you have samples you'd like\nto contribute, please send 'em to \"\".\nYou can also look at the t/*.t files in the distribution.\nPlease note that these examples are not intended to do any specific task. For all I know,\nthey're no longer functional because the sites they hit have changed. They're here to give\nexamples of how people have used WWW::Mechanize.\nNote that the examples are in reverse order of my having received them, so the freshest examples\nare always at the top.", "tldr_summary": null, "tldr_examples": [], "tldr_source": null, "flags": [], "examples": [], "see_also": [], "section_outline": [ { "name": "NAME", "lines": 2, "subsections": [] }, { "name": "VERSION", "lines": 2, "subsections": [] }, { "name": "SYNOPSIS", "lines": 14, "subsections": [ { "name": "Starbucks Density Calculator, by Nat Torkington", "lines": 437 }, { "name": "Hacking Movable Type, by Dan Rinzel", "lines": 71 } ] }, { "name": "AUTHOR", "lines": 2, "subsections": [] }, { "name": "COPYRIGHT AND LICENSE", "lines": 5, "subsections": [] } ], "sections": { "NAME": { "content": "WWW::Mechanize::Examples - Sample programs that use WWW::Mechanize\n", "subsections": [] }, "VERSION": { "content": "version 2.06\n", "subsections": [] }, "SYNOPSIS": { "content": "Plenty of people have learned WWW::Mechanize, and now, you can too!\n\nFollowing are user-supplied samples of WWW::Mechanize in action. If you have samples you'd like\nto contribute, please send 'em to \"\".\n\nYou can also look at the t/*.t files in the distribution.\n\nPlease note that these examples are not intended to do any specific task. For all I know,\nthey're no longer functional because the sites they hit have changed. They're here to give\nexamples of how people have used WWW::Mechanize.\n\nNote that the examples are in reverse order of my having received them, so the freshest examples\nare always at the top.\n", "subsections": [ { "name": "Starbucks Density Calculator, by Nat Torkington", "content": "Here's a pair of programs from Nat Torkington, editor for O'Reilly Media and co-author of the\n*Perl Cookbook*.\n\nRael [Dornfest] discovered that you can easily find out how many Starbucks there are in an\narea by searching for \"Starbucks\". So I wrote a silly scraper for some old census data and\ncame up with some Starbucks density figures. There's no meaning to these numbers thanks to\nerrors from using old census data coupled with false positives in Yahoo search (e.g., \"Dodie\nStarbuck-Your Style Desgn\" in Portland OR). But it was fun to waste a night on.\n\nHere are the top twenty cities in descending order of population, with the amount of\nterritory each Starbucks has. E.g., A New York NY Starbucks covers 1.7 square miles of\nground.\n\nNew York, NY 1.7\nLos Angeles, CA 1.2\nChicago, IL 1.0\nHouston, TX 4.6\nPhiladelphia, PA 6.8\nSan Diego, CA 2.7\nDetroit, MI 19.9\nDallas, TX 2.7\nPhoenix, AZ 4.1\nSan Antonio, TX 12.3\nSan Jose, CA 1.1\nBaltimore, MD 3.9\nIndianapolis, IN 12.1\nSan Francisco, CA 0.5\nJacksonville, FL 39.9\nColumbus, OH 7.3\nMilwaukee, WI 5.1\nMemphis, TN 15.1\nWashington, DC 1.4\nBoston, MA 0.5\n\n\"getpopdata\"\n\n#!/usr/bin/perl -w\n\nuse WWW::Mechanize;\nuse Storable;\n\n$url = 'http://www.census.gov/population/www/documentation/twps0027.html';\n$m = WWW::Mechanize->new();\n$m->get($url);\n\n$c = $m->content;\n\n$c =~ m{(.*?)}s\nor die \"Can't find the population table\\n\";\n$t = $1;\n@outer = $t =~ m{(.*?)}gs;\nshift @outer;\nforeach $r (@outer) {\n@bits = $r =~ m{(.*?)}gs;\nfor ($x = 0; $x < @bits; $x++) {\n$b = $bits[$x];\n@v = split /\\s*
\\s*/, $b;\nforeach (@v) { s/^\\s+//; s/\\s+$// }\npush @{$data[$x]}, @v;\n}\n}\n\nfor ($y = 0; $y < @{$data[0]}; $y++) {\n$data{$data[1][$y]} = {\nNAME => $data[1][$y],\nRANK => $data[0][$y],\nPOP => commafree($data[2][$y]),\nAREA => commafree($data[3][$y]),\nDENS => commafree($data[4][$y]),\n};\n}\n\nstore(\\%data, \"cities.dat\");\n\nsub commafree {\nmy $n = shift;\n$n =~ s/,//;\nreturn $n;\n}\n\n\"plagueofcoffee\"\n\n#!/usr/bin/perl -w\n\nuse WWW::Mechanize;\nuse strict;\nuse Storable;\n\n$SIG{WARN} = sub {} ; # ssssssh\n\nmy $Cities = retrieve(\"cities.dat\");\n\nmy $m = WWW::Mechanize->new();\n$m->get(\"http://local.yahoo.com/\");\n\nmy @cities = sort { $Cities->{$a}{RANK} <=> $Cities->{$b}{RANK} } keys %$Cities;\nforeach my $c ( @cities ) {\nmy $fields = {\n'stx' => \"starbucks\",\n'csz' => $c,\n};\n\nmy $r = $m->submitform(formnumber => 2,\nfields => $fields);\ndie \"Couldn't submit form\" unless $r->issuccess;\n\nmy $hits = numberofhits($r);\n# my $ppl = sprintf(\"%d\", 1000 * $Cities->{$c}{POP} / $hits);\n# print \"$c has $hits Starbucks. That's one for every $ppl people.\\n\";\nmy $density = sprintf(\"%.1f\", $Cities->{$c}{AREA} / $hits);\nprint \"$c : $density\\n\";\n}\n\nsub numberofhits {\nmy $r = shift;\nmy $c = $r->content;\nif ($c =~ m{\\d+ out of (\\d+) total results for}) {\nreturn $1;\n}\nif ($c =~ m{Sorry, no .*? found in or near}) {\nreturn 0;\n}\nif ($c =~ m{Your search matched multiple cities}) {\nwarn \"Your search matched multiple cities\\n\";\nreturn 0;\n}\nif ($c =~ m{Sorry we couldn.t find that location}) {\nwarn \"No cities\\n\";\nreturn 0;\n}\nif ($c =~ m{Could not find.*?, showing results for}) {\nwarn \"No matches\\n\";\nreturn 0;\n}\ndie \"Unknown response\\n$c\\n\";\n}\n\npb-upload, by John Beppu\nThis program takes filenames of images from the command line and uploads them to a\nwww.photobucket.com folder. John Beppu, the author, says:\n\nI had 92 pictures I wanted to upload, and doing it through a browser would've been torture.\nBut thanks to mech, all I had to do was `./pb.upload *.jpg` and watch it do its thing. It\nfelt good. If I had more time, I'd implement WWW::Photobucket on top of WWW::Mechanize.\n\n#!/usr/bin/perl -w -T\n\nuse strict;\nuse WWW::Mechanize;\n\nmy $login = \"loginname\";\nmy $password = \"password\";\nmy $folder = \"folder\";\n\nmy $url = \"http://img78.photobucket.com/albums/v281/$login/$folder/\";\n\n# login to your photobucket.com account\nmy $mech = WWW::Mechanize->new();\n$mech->get($url);\n$mech->submitform(\nformnumber => 1,\nfields => { password => $password },\n);\ndie unless ($mech->success);\n\n# upload image files specified on command line\nforeach (@ARGV) {\nprint \"$\\n\";\n$mech->formnumber(2);\n$mech->field('thefile[]' => $);\n$mech->submit();\n}\n\nlistmod, by Ian Langworth\nIan Langworth contributes this little gem that will bring joy to beleaguered mailing list\nadmins. It discards spam messages through mailman's web interface.\n\n#!/arch/unix/bin/perl\nuse strict;\nuse warnings;\n#\n# listmod - fast alternative to mailman list interface\n#\n# usage: listmod crew XXXXXXXX\n#\n\ndie \"usage: $0 \\n\" unless @ARGV == 2;\nmy ($listname, $password) = @ARGV;\n\nuse CGI qw(unescape);\n\nuse WWW::Mechanize;\nmy $m = WWW::Mechanize->new( autocheck => 1 );\n\nuse Term::ReadLine;\nmy $term = Term::ReadLine->new($0);\n\n# submit the form, get the cookie, go to the list admin page\n$m->get(\"https://lists.ccs.neu.edu/bin/admindb/$listname\");\n$m->setvisible( $password );\n$m->click;\n\n# exit if nothing to do\nprint \"There are no pending requests.\\n\" and exit\nif $m->content =~ /There are no pending requests/;\n\n# select the first form and examine its contents\n$m->formnumber(1);\nmy $f = $m->currentform or die \"Couldn't get first form!\\n\";\n\n# get me the base form element for each email item\nmy @items = map {m/^.+?-(.+)/} grep {m/senderbanp/} $f->param\nor die \"Couldn't get items in first form!\\n\";\n\n# iterate through items, prompt user, commit actions\nforeach my $item (@items) {\n\n# show item info\nmy $sender = unescape($item);\nmy ($subject) = [$f->findinput(\"senderbanp-$item\")->valuenames]->[1]\n=~ /Subject:\\s+(.+?)\\s+Size:/g;\n\n# prompt user\nmy $choice = '';\nwhile ( $choice !~ /^[DAX]$/ ) {\nprint \"$sender\\: '$subject'\\n\";\n$choice = uc $term->readline(\"Action: defer/accept/discard [dax]: \");\nprint \"\\n\\n\";\n}\n\n# set button\n$m->field(\"senderaction-$item\" => {D=>0,A=>1,X=>3}->{$choice});\n}\n\n# submit actions\n$m->click;\n\nccdl, by Andy Lester\nSteve McConnell, author of the landmark *Code Complete* has put up the chapters for the 2nd\nedition in PDF format on his website. I needed to download them to take to Kinko's to have\nprinted. This little program did it for me.\n\n#!/usr/bin/perl -w\n\nuse strict;\nuse WWW::Mechanize;\n\nmy $start = \"http://www.stevemcconnell.com/cc2/cc.htm\";\n\nmy $mech = WWW::Mechanize->new( autocheck => 1 );\n$mech->get( $start );\n\nmy @links = $mech->findalllinks( urlregex => qr/\\d+.+\\.pdf$/ );\n\nfor my $link ( @links ) {\nmy $url = $link->urlabs;\nmy $filename = $url;\n$filename =~ s[^.+/][];\n\nprint \"Fetching $url\";\n$mech->get( $url, ':contentfile' => $filename );\n\nprint \" \", -s $filename, \" bytes\\n\";\n}\n\nquotes.pl, by Andy Lester\nThis was a program that was going to get a hack in *Spidering Hacks*, but got cut at the last\nminute, probably because it's against IMDB's TOS to scrape from it. I present it here as an\nexample, not a suggestion that you break their TOS.\n\nLast I checked, it didn't work because their HTML didn't match, but it's still good as sample\ncode.\n\n#!/usr/bin/perl -w\n\nuse strict;\n\nuse WWW::Mechanize;\nuse Getopt::Long;\nuse Text::Wrap;\n\nmy $match = undef;\nmy $random = undef;\nGetOptions(\n\"match=s\" => \\$match,\n\"random\" => \\$random,\n) or exit 1;\n\nmy $movie = shift @ARGV or die \"Must specify a movie\\n\";\n\nmy $quotespage = getquotespage( $movie );\nmy @quotes = extractquotes( $quotespage );\n\nif ( $match ) {\n$match = quotemeta($match);\n@quotes = grep /$match/i, @quotes;\n}\n\nif ( $random ) {\nprint $quotes[rand @quotes];\n}\nelse {\nprint join( \"\\n\", @quotes );\n}\n\n\nsub getquotespage {\nmy $movie = shift;\n\nmy $mech = WWW::Mechanize->new;\n$mech->get( \"http://www.imdb.com/search\" );\n$mech->success or die \"Can't get the search page\";\n\n$mech->submitform(\nformnumber => 2,\nfields => {\ntitle => $movie,\nrestrict => \"Movies only\",\n},\n);\n\nmy @links = $mech->findalllinks( urlregex => qr[^/Title] )\nor die \"No matches for \\\"$movie\\\" were found.\\n\";\n\n# Use the first link\nmy ( $url, $title ) = @{$links[0]};\n\nwarn \"Checking $title...\\n\";\n\n$mech->get( $url );\nmy $link = $mech->findlink( textregex => qr/Memorable Quotes/i )\nor die qq{\"$title\" has no quotes in IMDB!\\n};\n\nwarn \"Fetching quotes...\\n\\n\";\n$mech->get( $link->[0] );\n\nreturn $mech->content;\n}\n\n\nsub extractquotes {\nmy $page = shift;\n\n# Nibble away at the unwanted HTML at the beginnning...\n$page =~ s/.+Memorable Quotes//si;\n$page =~ s/.+?( tag\nmy @quotes = split( //, $page );\n\nfor my $quote ( @quotes ) {\nmy @lines = split( /
/, $quote );\nfor ( @lines ) {\ns/<[^>]+>//g; # Strip HTML tags\ns/\\s+/ /g; # Squash whitespace\ns/^ //; # Strip leading space\ns/ $//; # Strip trailing space\ns/"/\"/g; # Replace HTML entity quotes\n\n# Word-wrap to fit in 72 columns\n$Text::Wrap::columns = 72;\n$ = wrap( '', ' ', $ );\n}\n$quote = join( \"\\n\", @lines );\n}\n\nreturn @quotes;\n}\n\ncpansearch.pl, by Ed Silva\nA quick little utility to search the CPAN and fire up a browser with a results page.\n\n#!/usr/bin/perl\n\n# turn on perl's safety features\nuse strict;\nuse warnings;\n\n# work out the name of the module we're looking for\nmy $modulename = $ARGV[0]\nor die \"Must specify module name on command line\";\n\n# create a new browser\nuse WWW::Mechanize;\nmy $browser = WWW::Mechanize->new();\n\n# tell it to get the main page\n$browser->get(\"http://search.cpan.org/\");\n\n# okay, fill in the box with the name of the\n# module we want to look up\n$browser->formnumber(1);\n$browser->field(\"query\", $modulename);\n$browser->click();\n\n# click on the link that matches the module name\n$browser->followlink( textregex => $modulename );\n\nmy $url = $browser->uri;\n\n# launch a browser...\nsystem('galeon', $url);\n\nexit(0);\n\nljfriends.cgi, by Matt Cashner\n#!/usr/bin/perl\n\n# Provides an rss feed of a paid user's LiveJournal friends list\n# Full entries, protected entries, etc.\n# Add to your favorite rss reader as\n# http://your.site.com/cgi-bin/ljfriends.cgi?user=USER&password=PASSWORD\n\nuse warnings;\nuse strict;\n\nuse WWW::Mechanize;\nuse CGI;\n\nmy $cgi = CGI->new();\nmy $form = $cgi->Vars;\n\nmy $agent = WWW::Mechanize->new();\n\n$agent->get('http://www.livejournal.com/login.bml');\n$agent->formnumber('3');\n$agent->field('user',$form->{user});\n$agent->field('password',$form->{password});\n$agent->submit();\n$agent->get('http://www.livejournal.com/customview.cgi?user='.$form->{user}.'&styleid=225596&checkcookies=1');\nprint \"Content-type: text/plain\\n\\n\";\nprint $agent->content();\n" }, { "name": "Hacking Movable Type, by Dan Rinzel", "content": "use strict;\nuse WWW::Mechanize;\n\n# a tool to automatically post entries to a moveable type weblog, and set arbitrary creation dates\n\nmy $mech = WWW::Mechanize->new();\nmy $entry;\n$entry->{title} = \"Test AutoEntry Title\";\n$entry->{btext} = \"Test AutoEntry Body\";\n$entry->{date} = '2002-04-15 14:18:00';\nmy $start = qq|http://my.blog.site/mt.cgi|;\n\n$mech->get($start);\n$mech->field('username','und3f1n3d');\n$mech->field('password','obscur3d');\n$mech->submit(); # to get login cookie\n$mech->get(qq|$start?mode=view&type=entry&blogid=1|);\n$mech->formname('entryform');\n$mech->field('title',$entry->{title});\n$mech->field('categoryid',1); # adjust as needed\n$mech->field('text',$entry->{btext});\n$mech->field('status',2); # publish, or 1 = draft\n$results = $mech->submit();\n\n# if we're ok with this entry being datestamped \"NOW\" (no {date} in %entry)\n# we're done. Otherwise, time to be tricksy\n# MT returns a 302 redirect from this form. the redirect itself contains a handler\n# which takes the user to an editable version of the form where the create date can be edited\n# MT date format of YYYY-MM-DD HH:MI:SS is the only one that won't error out\n\nif ($entry->{date} && $entry->{date} =~ /^\\d{4}-\\d{2}-\\d{2}\\s+\\d{2}:\\d{2}:\\d{2}/) {\n# travel the redirect\n$results = $mech->get($results->{headers}->{location});\n$results->{content} =~ /get($start.$1);\n$mech->formname('entryform');\n$mech->field('createdonmanual',$entry->{date});\n$mech->submit();\n}\n\nget-despair, by Randal Schwartz\nRandal submitted this bot that walks the despair.com site sucking down all the pictures.\n\nuse strict;\n$|++;\n\nuse WWW::Mechanize;\nuse File::Basename;\n\nmy $m = WWW::Mechanize->new;\n\n$m->get(\"http://www.despair.com/indem.html\");\n\nmy @toplinks = @{$m->links};\n\nfor my $toplinknum (0..$#toplinks) {\nnext unless $toplinks[$toplinknum][0] =~ /^http:/;\n\n$m->followlink( n=>$toplinknum ) or die \"can't follow $toplinknum\";\n\nprint $m->uri, \"\\n\";\nfor my $image (grep m{^http://store4}, map $->[0], @{$m->links}) {\nmy $local = basename $image;\nprint \" $image...\", $m->mirror($image, $local)->message, \"\\n\"\n}\n\n$m->back or die \"can't go back\";\n}\n" } ] }, "AUTHOR": { "content": "Andy Lester \n", "subsections": [] }, "COPYRIGHT AND LICENSE": { "content": "This software is copyright (c) 2004 by Andy Lester.\n\nThis is free software; you can redistribute it and/or modify it under the same terms as the Perl\n5 programming language system itself.\n", "subsections": [] } } } }