kink.pl

#!/usr/bin/env perl

########################################################################
#
# One hot night in Taichung, I read some intorductions to `kink.com`
# Video clips in this site are pretty great, so I try to do some hack to the site.
#
# Happy hacking,
# - xatier
#
# License: [WTFPL](http://www.wtfpl.net/)
#
# Usage: ./kink.pl > foo.html && chromium foo.html
#
########################################################################

use 5.014;

use WWW::Mechanize;
use List::MoreUtils qw(uniq);
use utf8;

# extract from `footerSitesList`, delete some bad items
my %networks = (
    # BDSM/Bondage
    "Device Bondage"          => "devicebondage",
    "Hogtied"                 => "hogtied",
    "Public Disgrace"         => "publicdisgrace",
    "Water Bondage"           => "waterbondage",
    "Hardcore Gangbang"       => "hardcoregangbang",
    "Sex And Submission"      => "sexandsubmission",
    "The Training Of O"       => "thetrainingofo",
    "Bound Gang Bangs"        => "boundgangbangs",
    "The Upper Floor"         => "theupperfloor",
    # Fetish
    "Everything Butt"         => "everythingbutt",
    "Fucking Machines"        => "fuckingmachines",
    "TS Seduction"            => "tsseduction",
    "TS Pussy Hunters"        => "tspussyhunters",
    "Foot Worship"            => "footworship",
    "Ultimate Surrender"      => "ultimatesurrender",
    "Pissing"                 => "pissing",
    # Gay
    "Bound in Public"         => "boundinpublic",
    "Men On Edge"             => "menonedge",
    "30 Minutes of Torment"   => "30minutesoftorment",
    "Bound Gods"              => "boundgods",
    "Naked Kombat"            => "nakedkombat",
    "Butt Machine Boys"       => "buttmachineboys",
    # Femdom
    "Divine Bitches"          => "divinebitches",
    "Electro Sluts"           => "electrosluts",
    "Men In Pain"             => "meninpain",
    "Whipped Ass"             => "whippedass",
    "Wired Pussy"             => "wiredpussy",
    # Twisted Factory
    "Sadistic Rope"           => "sadisticrope",
);


# oh, yes, pissing girls!
my $DOMAIN = "pissing";

# or randomly choose one, baby
my $description = (keys %networks)[rand keys %networks];
$DOMAIN = $networks{$description};

# basically, they use the same template for all sites
my $url = "http://www.$DOMAIN.com/site/shoots.jsp?orderBy=highRating";

my $mech = WWW::Mechanize->new();
$mech->add_header('User-agent' => 'Chrome/35.0.1916.114');

$mech->get($url);
my $doc = $mech->content();

# url scheme: http://www.pissing.com/site/shoot/5896-Penny-Play-Wolf-Hudson-Lobo.html
# extract video id and title
#             {site/shoot/}(5896)-(Penny-Play-Wolf-Hudson-Lobo).html
my @lines = split '\n', $doc;
my @videos = ();
for my $line (@lines) {
    if ($line =~ /\/site\/shoot\/(\d+)-(.*)\.html/) {
        push @videos, ($1 . " => " . $2);
    }
}


# uniq duplicated videos and replace `-`s with spaces
@videos = uniq(@videos);
$_ =~ s/-/ /g for (@videos);


# output a HTML file
say "<h1>Today's Topic: $description</h1>";
for (@videos) {
    my ($id, $title) = split / => /;
    # they use highwinds CDNs for content.$DOMAIN.com, great!
    # http://www.highwinds.com/
    say "<h2><a href=" .
        "\"http://content.$DOMAIN.com/imagedb/$id/v/h/320/hires/$id\_7.mp4\"" .
        " target=\"_blank\">$title</a></h2><br>";

    # show the preview images
    say "<img src=\"http://content.$DOMAIN.com/imagedb/$id/i/h/830/$_.jpg\">" for (0 .. 15);
}