| Subject: | Acme::Playmate not working (fix provided) |
| Date: | Wed, 7 Nov 2007 01:18:31 -0300 |
| To: | bug-Acme-Playmate [...] rt.cpan.org |
| From: | breno <breno [...] rio.pm.org> |
Hi,
I've been browsing around the "Acme" namespace and just found your
Acme::Playmate module. Nice! But it has some issues, the worse being
it just doesn't work at all on the current "playboy.com" website...
I mangled with it a little and provided the following "revision". It
not only fixes the website's playmate directory but also updates the
regexp's code (although I'm sure there are better ways to do it, I
didn't bother much as this is "Acme" :-)
Oh, I also took the liberty of putting the attributes inside a hash,
instead of plain scalars. It looked right. And I put the regexp's
matches inside "if" clauses, so it couldn't possibly put trash inside
the attributes in case it didn't match at all (playboy may change its
layout again -- gotta be on the safe side :-) Please forgive me for
that (it's your module, you can still leave it the way it was, of
course -- as long as the regexps and $url are fixed :-).
I'm making a presentation on Acme modules for YAPC::Brazil::2007 this
saturday (November 10th) and your module will be in it, so it would be
great if people could already download a fixed version by then.
Thanks!
breno
--------------------------8<------------------------- (cut here!)
my $url = "http://www.playboy.com/girls/playmates/directory/";
sub new
{
my $class = shift;
my ($year, $month ) = @_;
$year = "1953" unless defined $year;
$month = "12" unless defined $month;
my $ua = LWP::UserAgent->new;
$ua->agent("Acme::Playmate " . $VERSION);
my $req = HTTP::Request->new(GET => $url . $year . $month . ".html");
$req->header('Accept' => 'text/html');
my $res = $ua->request($req);
if(!$res->is_success) {
die "Failed to fetch information: " . $res->status_line . " \n";
}
my $con = $res->content;
my %args = ();
if ($con =~ /.*?<span class="pmd_pm_name">(.*?)<\/span>.*?/s) {
$args{'Name'} = $1;
}
if ($con =~ /.*?<b>BIRTHPLACE:<\/b>\s*(.*?)\s*<br \/>.*?/s) {
$args{'BirthPlace'} = $1;
}
if ($con =~ /.*?<b>BUST:<\/b>\s*(.*?)\s*<br \/>.*?/s) {
$args{'Bust'} = $1;
}
if ($con =~ /.*?<b>WAIST:<\/b>\s*(.*?)\s*<br \/>.*?/s) {
$args{'Waist'} = $1;
}
if ($con =~ /.*?<b>HIPS:<\/b>\s*(.*?)\s*<br \/>.*?/s) {
$args{'Hips'} = $1;
}
if ($con =~ /.*?<b>HEIGHT:<\/b>\s*(.*?)\s*<br \/>.*?/s) {
$args{'Height'} = $1;
}
if ($con =~ /.*?<b>WEIGHT:<\/b>\s*(.*?)\s*<br \/>.*?/s) {
$args{'Weight'} = $1;
}
my $self = { %args };
bless $self, $class;
return $self;
}
--------------------------8<------------------------- (cut here!)