#!/usr/bin/perl

# TODO:
#   - be able to load from multiple TGP's at once (load the pages in parallel)
#   - remember links we've previously seen (though some of the thumbnails may disappear at some point...)

    use strict;
    use warnings;
    use CGI::Carp qw(fatalsToBrowser);

    use FindBin;
    use lib "$FindBin::Bin/";

    use Porn;
    use URLMetadata;

    use LWP::UserAgent;
    use CGI;
    use Data::Dumper;
    use CGI::Util;
    use URI;
    use URI::QueryParam;

    my $ua = new LWP::UserAgent;
    $ua->agent("Mozilla/5.0 (Windows; U; Win98; en-US; rv:1.4) Gecko Netscape/7.1 (ax)");

    my $cgi = new CGI;

    (my $zero = $ENV{SCRIPT_NAME}) =~ s#^.*/##;


my ($site_order, %sites) = ordered_hash(
    "restrainedmaidens.com" => {
        thumbs_path => "/st/thumbs/",
        link_redirector => "/st/st.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*?url=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            my $frag = (split '/', $path)[4];
            $frag =~ s/\..*//;
            #print "Fragment: $frag\n";
            return $frag;
        },
    },

    "fetishcabin.com" => {
        thumbs_path => "/fetishcabin/",
        link_redirector => "/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*?\bu=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },


    "brutaltgp.com" => {
        thumbs_path => "/t/",
        link_redirector => "/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            return unless ($url =~ /link=ID-/);
            $url =~ s#^.*?url=http#http#;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },

    "bdsmnewlife.com" => {
        thumbs_path => "/htm3/content/",
        link_redirector => "/cgi-bin/at3/out.cgi",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*?\bu=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
        thumbID_sort_type => 'string',
    },


    "bondagehotporn.com" => {
        thumbs_path => "/st/thumbs/",
        link_redirector => "/st/st.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*?\burl=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },


    "pain-vids.com" => {
        thumbs_path => "/streamrotator/thumbs/",
        link_redirector => "/streamrotator/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*?(?:%0[ad])+##sig;      # bah... why does the page include newlines in the friggin URL?
            $url =~ s#&#&#sig;
            return $url;
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },


    "harassedslavegirl.com" => {
        thumbs_path => "/streamrotator/thumbs/",
        link_redirector => "/streamrotator/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*?(?:%0[ad])+##sig;      # bah... why does the page include newlines in the friggin URL?
            $url =~ s#&#&#sig;
            return $url;
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },


    "brutalfetish.com" => {
        thumbs_path => "/st/thumbs/",
        link_redirector => "/st/st.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*?url=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },

    "worldofbdsm.net" => {
        thumbs_path => "/sr/thumbs/",
        link_redirector => "/sr/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*\bu=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },

    "5bdsm.com" => {
        thumbs_path => "/r/thumbs/",
        link_redirector => "/r/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*\burl=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },

    'imaginations-bdsm.com' => {
        thumbs_path => "/streamrotator/thumbs/",
        link_redirector => "/streamrotator/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*\bu=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },

    'freeporndream.com' => {
        thumbs_path => "/streamrotator/thumbs/",
        link_redirector => "/streamrotator/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*\bu=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },

    'wildbdsm.com' => {
        thumbs_path => "/stream/thumbs/",
        link_redirector => "/stream/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*\bu=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },

    'cruelbdsm.in' => {
        thumbs_path => "/cruelbdsm/",
        link_redirector => "/out.php",
        unobfuscate_url => sub {
            my $url = shift;
            $url =~ s#^.*\bu=##;
            $url =~ s#&.*##;
            return CGI::Util::unescape($url);
        },
        thumbID_sortable => sub {
            my $path = URI->new(shift)->path;
            $path =~ s#^.*/|\.jpg$##sig;
            return $path;
        },
    },


);


my $list;
if (@ARGV && $ARGV[0] eq '--list') {         # provide a minimal command-line mode, so that other scripts can easily process our data
    shift @ARGV;
    $list++;
}

my $site = $cgi->param('site') || $ARGV[0];
my $sort = $cgi->param('sort') || $ARGV[1] || 'domain';

$list or print "Content-type: text/html\n\n";

if (!$site) {
    print "Choose a site to view:\n";
    if ($list) {
        print join("\n", @$site_order), "\n";
        exit;
    }

    print "<ul>\n";
    #foreach my $site (keys %sites) {
    foreach my $site (@$site_order) {
        printf "<li><a href='$zero?site=%s'>%s</a>\n",
                CGI::Util::escape($site),
                CGI::escapeHTML($site);
    }
    exit;
}
die unless ($sites{$site});
my %s = %{$sites{$site}};

$list or print <<"EOF";
<style>
    img.movies {border:4px solid #f00}
    span.utils {font-size:80%; color:#999}
    span.utils a {color:#999; text-decoration:none}
    span.utils a:hover {text-decoration:underline}
</style>
<div style="float:right"><a href="http://paperlined.org/src/pl/porn/cgi/tgp_condom/">view source code</a></div>

You must turn off referer-sending (if using Firefox, <a href='http://prefbar.mozdev.org/'>prefbar</a> is a great way to do this).  (though if someone could write up an extension that <a href="http://www.paperlined.org/apps/porn/project_proposals/2007.11.05__referer_specifier">triggers off the referer="..." attributes</a> in the HTML on this page, that'd be even better)</p>

EOF


# when running this from the command-line, fill in some xtra stuff, to avoid undef errors
if (!$ENV{REQUEST_METHOD}) {
    $ENV{REQUEST_URI} = '/cgi-bin/cgiwrap/interiot/porn/tgp_condom';
    $ENV{HTTP_X_FORWARDED_HOST} = 'paperlined.org';
}

$ENV{REQUEST_URI} =~ s#^/cgi-bin/cgiwrap/([^/]*)/#/cgi-bin/#si;      # fix up the apparent mod_rewrite rule
my $sortless_url = URI->new("http://$ENV{HTTP_X_FORWARDED_HOST}$ENV{REQUEST_URI}");
$sortless_url->query_param_delete('sort');
$sortless_url = $sortless_url->as_string;

$sort = 'domain' if (!$s{thumbID_sortable});
if (!$list) {
    if ($s{thumbID_sortable}) {
        if ($sort eq 'time') {
            print "Sort by: <b>time</b>, <a href='$sortless_url&sort=domain'>domain</a></p>\n";
        } else {
            print "Sort by: <a href='$sortless_url&sort=time'>time</a>, <b>domain</b></p>\n";
        }
    }

    print <<"EOF";
Legend: <span style='border:2px solid #f00'>movies</span> <span style='border:2px solid #0000fc'>images</span></p>
EOF
}




my $start_url = "http://$site/";
my $res = $ua->get($start_url);
$res->is_success or die $res->status_line;

my @links = Porn::parse_linked_images($res->content, $start_url);
#print Dumper \@links, $start_url; exit;
my @final_list;
foreach my $link (@links) {
    my ($a, $img) = ($link->[1]{href}, $link->[2]{src});

    (my $img_path = $img) =~ s#^[^/]*//[^/]*/#/#si;
    (my $a_path = $a) =~ s#^[^/]*//[^/]*/#/#si;

    next unless (substr($img_path, 0, length($s{thumbs_path})) eq $s{thumbs_path});
    next unless (substr($a_path, 0, length($s{link_redirector})) eq $s{link_redirector});

    my $linkto = $a;
    if ($s{unobfuscate_url}) {
        $linkto = $s{unobfuscate_url}->( $a );
    }
    $linkto = URLMetadata::strip_extra_redirectors($linkto);
    $linkto = URLMetadata::strip_affiliate_id($linkto);
    $linkto = URLMetadata::make_canonical($linkto);
    next unless ($linkto =~ m#^[^/]*//[^/]*/[^/?]*[/?]#);       # skip it if it's just a link to the root page of a domain
    next if (URLMetadata::is_mostly_bad_domain($linkto));

    #print "$img_path\t$linkto\n";
    push(@final_list, {
        linkto=>$linkto,
        img=>$img,
        hosted_for=>URLMetadata::domain_hosted_for_another($linkto),
        });

    $final_list[-1]{hosted_for} =~ s#^www\.##si;
    $final_list[-1]{hosted_for} =~ s#^\d+\.##si;
}

# sort by domain
if ($sort eq 'domain') {
        sub flip_domain {join(".", reverse split /\./, $_[0])}
    @final_list = sort {flip_domain($a->{hosted_for}) cmp flip_domain($b->{hosted_for})} @final_list;
} else {
    # sort by thumb ID (eg. most recently-posted pictures on top)
    if ($s{thumbID_sort_type} && $s{thumbID_sort_type} eq 'string') {
        @final_list = sort {$s{thumbID_sortable}->($b->{img}) cmp $s{thumbID_sortable}->($a->{img})} @final_list;
    } else {
        @final_list = sort {$s{thumbID_sortable}->($b->{img}) <=> $s{thumbID_sortable}->($a->{img})} @final_list;
    }
}

my $lasthost = '';
foreach my $l (@final_list) {
    #my ($linkto, $img) = @$l;
    #my $host = URI->new($l->{linkto})->host;
    my $host = $l->{hosted_for};
    (my $h = $host) =~ s/\(.*?\)//sig;

    if (!$list) {
        if ($sort eq 'domain' && $host ne $lasthost) {
            printf "<br>%s <span class='utils'><a href='%s'>[magicteapot]</a> <a href='%s'>[google]</a></span><br>\n",
                CGI::escapeHTML($host),
                "http://www.magicteapot.com/search.php?ob=&promodomain=&fromdomain=&q=for%3A$h&galt=pm&t=on&x=0&y=0",
                "http://www.google.com/search?q=site:$h&hl=en&safe=off&filter=0";
            $lasthost = $host;
        }
        my $class = "";
        $class = "class='movies'" if (URLMetadata::is_TGP_movie_page($l->{linkto}));
        printf "<a href='%s'><img %s src='%s' referer='%s'></a>\n",
                $l->{linkto},
                $class,
                $l->{img},
                $start_url,
    } else {
        my $thumbID = "-";
        if ($s{thumbID_sortable}) {
            $thumbID = $s{thumbID_sortable}->( $l->{img} );
        }
        print join("\t", 
                $host,
                $thumbID,
                $l->{img},
                $l->{linkto},
            ), "\n";
    }
}





sub ordered_hash { my $n; my @order = grep {!($n++ % 2)} @_; return (\@order, @_) }