Slash Boxes
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

jjohn (22)

  (email not shown publicly)
AOL IM: taskboy3000 (Add Buddy, Send Message)

Perl hack/Linux buff/OSS junkie.

Journal of jjohn (22)

Sunday March 06, 2005
10:36 AM

pedagogical benefits of porno

[ #23522 ]

Whether pornography is psychologically damaging, socially corrosive or just plain nasty, it is clear that at least for men, it is a strong attractor and motivator. It is time we left behind antiquated nineteenth century morality and boldly embraced this core driver of male behavior to fill the more serious deficit of quality programmers in the U.S.A.

To this end, I submit my own work, a perl script that fetches the publicly available gallery at The real benefit of this script (well, at least secondarily) is that it is my first concerted use of Andy Lester's WWW::Mechanize. Because of the positive reinforcement generated by this script, I am more likely to use this module in other, less pornographic work -- and so I move the Wheels of Industry forward! Adam Smith's Invisible Hand of Capitalism guides me!

Briefly, the script fetches the front page and looks for a link labled "FOLIO [\d+]". This page is then fetched and links that start with "javascript:" are culled. By adding on "&m=img" to these links, it is possible to get to the actual picture in question. These images are stored in a directory on my Winders box, hence the funny path names.

Based on the impressive success of this experiment, I recommend that we teach children to read by giving them digests of Penthouse Forum. We must always be thinking of the children!

I further recommend that we ease the suffering of the impoverished by eating their babies.

More Good Ideas () to come...

use strict;
use WWW::Mechanize;

my $base_url = qq[];
my $main_page= qq[/public/main.php];
my $dest_dir = "F:\\news\\ishotmyself";

print "Fetching $base_url/$main_page\n";

my $B = WWW::Mechanize->new;

unless ($B->success()) {
    die "Couldn't fetch main page: ", $B->status();

print "Main page fetched\n";

print "Dumping folio links\n";
my $todays_gallery;
my $gallery = "unknown";
foreach my $l ($B->links()) {
    next if $l->text() !~ /folio \[\d+\]/i;
    $todays_gallery = $l;
    ($gallery = $l->url) =~ /([^=]+)$/;
    $gallery = $1;
    print "\t", $l->text(), " : ", $l->url(), "\n";

# find today's folio name
print "Fetching ", $todays_gallery->url, "\n";
unless ($B->success()) {
    print "Couldn't fetch '" . $todays_gallery->url(),
          "' : ", $B->status(), "\n";
    print $B->content, "\n";

#open OUT, ">out.txt";
#print OUT $B->content, "\n";
#close OUT;

print "Dumping folio links\n";
my @found;
foreach my $l ($B->links()) {
    next if $l->url !~ /^javascript:popupLandscape/;
    print "\t", $l->text(), " : ", $l->url(), "\n";

    # unjavascript!
    (my $url = $l->url()) =~ /\('([^']+)'\)/;
    if ($1) {
      push @found, "$1&m=img";
    } else {
      warn "Couldn't unjavascriptify!\n";

unless (-d $dest_dir) {
  mkdir $dest_dir;

$dest_dir .= "\\$gallery";
unless (-d $dest_dir) {
   print "Creating $dest_dir\n";
   mkdir $dest_dir || warn "mkdir $dest_dir failed: $!";

print "chdir $dest_dir\n";
chdir $dest_dir;

print "Fetching public images\n";
my $cnt = 1;
for my $l (@found) {
   unless ($B->success()) {
     warn "picture fetch failed: ", $B->status, "\n";

   my $imgfile = sprintf("${gallery}_%03d.jpg", $cnt++);
   if (-e $imgfile) {
     print "\tOVERWRITING $imgfile\n";
   if (open(OUT, ">$imgfile")) {
     print "\tWriting $imgfile\n";
     print OUT $B->content();
     close OUT;
   } else {
     warn("open $imgfile failed : $!");

print "done\n";

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
More | Login | Reply
Loading... please wait.