#!/usr/bin/perl

use strict;
use threads;
use WWW::Curl::Easy;
use WWW::Curl::Share;
use Thread::Queue::Any;

my $MAX_THREADS = 2;
my $itemQueue = Thread::Queue::Any->new;
my $curlShare = new WWW::Curl::Share;
my $threads;

my @items = qw(
http://www.tribalwar.com/
http://pagead2.googlesyndication.com/pagead/show_ads.js
http://cetrk.com/pages/scripts/0004/7020.js
http://static.robotreplay.com/nitobi.replay.js
http://www.tribalwar.com/includes/css/twMarkup.css
http://www.tribalwar.com/includes/css/lightbox.css
http://www.tribalwar.com/includes/css/twMobile.css
http://www.tribalwar.com/includes/js/ddmenu.js
http://www.tribalwar.com/includes/js/prototype.js
http://www.tribalwar.com/includes/js/scriptaculous.js?load=effects,controls
http://www.tribalwar.com/includes/js/tw.js
http://www.tribalwar.com/includes/js/aurora.js
http://www.tribalwar.com/includes/js/lightbox.js
http://www.tribalwar.com/images/search_btn.gif
http://www.tribalwar.com/images/branlogo.gif
http://www.tribalwar.com/images/paypaldonate.gif
http://www.tribalwar.com/images/rss_small.gif
http://www.tribalwar.com/images/atom_small.gif
http://www.tribalwar.com/includes/js/wz_tooltip.js
http://www.tribalwar.com/WRa.js
http://www.google-analytics.com/urchin.js
);

# Start threads
for(my $i = 0; $i < $MAX_THREADS; $i++) {
    $threads->[$i] = new threads(\&downloadThread, $itemQueue);
}

# Download the items
foreach my $item (@items) {
    $itemQueue->enqueue($item);
}

# Kill threads
for(my $i = 0; $i < $MAX_THREADS; $i++) {
    $itemQueue->enqueue(undef);
}

sleep 10;

#-------------------------------------------------------------------------------

# Handle threads
sub downloadThread {
    my ($itemQueue) = @_;

    # Create a new curl object per thread
    my $curl = WWW::Curl::Easy->new() or print STDERR "Unable to create curl object";
    $curl->setopt(CURLOPT_SHARE, $curlShare);
    my $id = threads->self->tid();

    while(1) {
        my ($item) = $itemQueue->dequeue;

        # When an undef is found, that means we're done
        if(!defined $item) {
            return;
        }

        my $pagetimeout = 30;
        my $startTime = time;

        my $results = getPage($item, $pagetimeout, $curl);
    }
}

# Do the item download
sub getPage {
    my ($url, $clientSetTimeout, $curl) = @_;

    ## Set up the standard GET/POST request options
    $curl->setopt(CURLOPT_VERBOSE, 0);                  # Disable verbosity
    $curl->setopt(CURLOPT_HEADER, 0);                   # Don't include header in body 
    $curl->setopt(CURLOPT_NOPROGRESS, 1);               # Disable internal progress meter
    $curl->setopt(CURLOPT_FOLLOWLOCATION, 0);           # Disable automatic location redirects
    $curl->setopt(CURLOPT_FAILONERROR, 0);              # Setting this to true fails on HTTP error
    $curl->setopt(CURLOPT_SSL_VERIFYPEER, 0);           # Ignore bad SSL
    $curl->setopt(CURLOPT_SSL_VERIFYHOST, 0);           # Ignore bad SSL
    $curl->setopt(CURLOPT_NOSIGNAL, 1);                 # To make thread safe, disable signals
    $curl->setopt(CURLOPT_ENCODING, 'gzip');            # Allow gzip compressed pages
    $curl->setopt(CURLOPT_URL, $url);                   # Specify path to get/post

    # Redirect output to a dummy function
    #$curl->setopt(CURLOPT_WRITEFUNCTION, \&callback);

    # Do the download
    my $response = $curl->perform();

    # Get the results
    my $location = $curl->getinfo(CURLINFO_EFFECTIVE_URL);
    my $responseCode =  $curl->getinfo(CURLINFO_HTTP_CODE);
    my $loadTime = $curl->getinfo(CURLINFO_TOTAL_TIME);
    my $connectTime = $curl->getinfo(CURLINFO_CONNECT_TIME);
    my $dnsTime = $curl->getinfo(CURLINFO_NAMELOOKUP_TIME);
    my $protocolTime = $curl->getinfo(CURLINFO_PRETRANSFER_TIME);
    my $pageSize = $curl->getinfo(CURLINFO_SIZE_DOWNLOAD);
    my $firstPacketTime = abs($curl->getinfo(CURLINFO_STARTTRANSFER_TIME) - $dnsTime);
    my $ipAddress = $curl->getinfo(CURLINFO_PRIMARY_IP);
   
    # Output our debug info
    print STDERR "# $location: $ipAddress\n"; 
}

# Used to keep the data from printing out to screen
sub callback {
    my ($chunk,$context)=@_;
    push @{$context}, $chunk;
    return length($chunk);
}