Erogeekなりたい

erogeek

http://erogeek.org/

Erogeekなりたいので、コード書いた。

VchatサイトACAMのオンラインの女の子の無料ライブを見る

#!/opt/local/bin/perl

use Data::Dumper;
my $girls = Net::Acam::Girls->get();

print "Content-type: text/html\n\n";
print q|<html><head><base href="http://acam.jp/"> </head><body>|;

for my $girl ( @{ $girls } )  {
    next unless $girl->{status} eq 'online';
print <<"__HTML__";    
<object
classid="clsid:d27cdb6e-ae6d-11cf-96b8-444553540000"
codebase="http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,0,0"
width="320" height="240" id="video_chat" align=""><param
name="allowScriptAccess" value="sameDomain" /><param name="movie"
value="/flash/acam/freePreview20.swf" /><param name=FlashVars
value="channel=&performerID=$girl->{id}&userType=&sessionType=110&langID=jp&webID=7AAC5B5FDDBCD0941E72524F40AFF958&userSiteID=1005732&skinName=skin0&skinType=default&ban=0&photo=http://image.acam.jp/WebArchive/u$girl->{id}/flash/SelectedImage.jpg&emailNotice=null"
/><param name="quality" value="high" /><param name="bgcolor" value="#000000"
/><param name="salign" value="LT" />
<embed src="/flash/acam/freePreview20.swf"
salign="LT"
FlashVars="channel=&performerID=$girl->{id}&userType=&sessionType=110&langID=jp&webID=7AAC5B5FDDBCD0941E72524F40AFF958&userSiteID=1005732&skinName=skin0&skinType=default&ban=0&photo=http://image.acam.jp/WebArchive/u$girl->{id}/flash/SelectedImage.jpg&emailNotice=null"
quality="high" bgcolor="#000000" width="320" height="240" name="video_chat"
align="" allowScriptAccess="sameDomain" type="application/x-shockwave-flash"
pluginspage="http://www.macromedia.com/go/getflashplayer" />

</object>
__HTML__
}

print "</body></html>";

package Net::Acam::Girls;

use strict;
use warnings;

use URI;
use Web::Scraper;
use Encode;

sub get {
my $girls = scraper {
    process "div table.NeoOnGirl_table" , 'items[]' => scraper {
        process "div.NeoOnGirl_oncheck img", 'status' => sub {
            my $src = $_->attr('src') ;
            $src =~ /icon_(\w+)n\./;
            return $1;
        };
        process "td.NeoOnGirl_Name", 'name' => sub {
            my $text = $_->as_text();
            encode( 'utf-8' ,$text );
        };
        process "a" ,'id' => sub {
            my $text = $_->attr('onclick');
            $text =~ /(\d+)/;
            return $1;
        };
    };
}->scrape( URI->new('http://acam.jp/acam/home1.jsp') );
    return $girls->{items};
}

1;


超重いけど以下で動作確認できる。(Firefoxで確認済み & しばらくしたら消すと思う)