#!/usr/local/bin/perl

use URI::URL;
use LWP::RobotUA;
use LWP::MediaTypes;
use HTML::LinkExtor;
use Pg;
use Socket;

$| = 1;

$verbose = 1;

# read configure file
if ($#ARGV == -1) {
    $config = "config" ;
} else {
    $config = $ARGV[0];
}
require $config;

# define user agent
$ua = new LWP::RobotUA 'URL_LOOPER/0.1', '$email_adr';
$rules = $ua->rules();
$ua->delay($delay);			# delay time (minites)
$ua->timeout($timeout);			# time out (seconds)

# connect DB
$conn = Pg::connectdb("dbname = $dbname");
die "DBconnect fail.\n" if (!($conn->status eq PGRES_CONNECTION_OK));

# push start_urls

foreach $start_url (@start_urls) {
    $sqlstr = sprintf("SELECT url FROM urlpool WHERE url = '%s'", $start_url);
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);
    if ($result->ntuples == 0)
    {
	push_url($start_url, 0);
    }
}

$c = 0;
while ($c < $count)
{
    $url = pop_nexturl();
    printf("next target url is %s\n", $url) if ($verbose == 1);
    die "Found no URL to be fetch.\n" if ($url eq "");
    $r = fetch_resource($url);
    if ($r == 1) { $c++; }
}

# subroutines
sub scorepoint
{
    local($u) = @_;
    local($slashcnt, $digitcnt, $fnamecnt, $usercnt);
    local($point);

    $slashcnt = ($u =~ tr/\//\//);
    $slashcnt += 0;
    $digitcnt = ($u =~ s/(\d\d[^\/]*)$/$1/g);
    $digitcnt += 0;
    if ($u =~ /\/$/ || $u =~ /\/index.html?$/ || $u =~ /\/default.html?$/) {
	$fnamecnt = 0;
    } else {
	$fnamecnt = 2;
    }
    if ($u =~ /\/~/) {
	$usercnt = 0;
    } else {
	$usercnt =1;
    }
    $point = $slashcnt + $digitcnt + $fnamecnt + $usercnt;
    return $point;
}

sub loc2ipaddr
{
    local($loc) = @_;
    local($ntuples, $nfields);
    local($sqlstr,$result);
    local($ipaddr, $ip);


    $ipaddr = "";
    $sqlstr = "BEGIN WORK";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    $sqlstr = sprintf("DECLARE host2ip_cursor CURSOR FOR SELECT ip FROM host2ip WHERE host='%s'", $loc);
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);

    $sqlstr = "FETCH FORWARD NEXT IN host2ip_cursor";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);

    $ntuples = $result->ntuples;
    $nfields = $result->nfields;
    printf("ntuples:%d ntields:%d\n", $ntuples, $nfields) if ($verbose == 1);
    if ($ntuples == 1) {
	$ipaddr = $result->getvalue(0, 0);
    } else {
	$ipaddr = "";
    }

    $sqlstr = "CLOSE host2ip_cursor";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    $sqlstr = "COMMIT WORK";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    if ($ipaddr eq "") {
	printf("gethostbyname %s\n",$loc) if ($verbose == 1);
	$ip = gethostbyname($loc);
	if ($ip ne "") {
	    $ipaddr = inet_ntoa($ip);

	    $sqlstr = sprintf("INSERT INTO host2ip(host, ip) values ('%s', '%s')", $loc, $ipaddr);
	    printf("%s\n",$sqlstr) if ($verbose == 1);
	    $result = $conn->exec($sqlstr);
	    print_result() if ($verbose == 1);


	    $sqlstr = sprintf("SELECT host FROM ip2host WHERE ip = '%s'", $ipaddr);
	    printf("%s\n",$sqlstr) if ($verbose == 1);
	    $result = $conn->exec($sqlstr);
	    print_result() if ($verbose == 1);
	    if ($result->ntuples == 0)
	    {
		$sqlstr = sprintf("INSERT INTO ip2host(ip, host) values ('%s', '%s')", $ipaddr, $loc);
		printf("%s\n",$sqlstr) if ($verbose == 1);
		$result = $conn->exec($sqlstr);
		print_result() if ($verbose == 1);
	    }
	}
    }
    return $ipaddr;
}

sub ipaddr2loc
{
    local($ipaddr) = @_;
    local($ntuples, $nfields);
    local($sqlstr,$result);
    local($loc);


    $loc = "";
    $sqlstr = "BEGIN WORK";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    $sqlstr = sprintf("DECLARE ip2host_cursor CURSOR FOR SELECT host FROM ip2host WHERE ip='%s'", $ipaddr);
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);

    $sqlstr = "FETCH FORWARD NEXT IN ip2host_cursor";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);

    $ntuples = $result->ntuples;
    $nfields = $result->nfields;
    printf("ntuples:%d ntields:%d\n", $ntuples, $nfields) if ($verbose == 1);
    if ($ntuples == 1) {
	$loc = $result->getvalue(0, 0);
    } else {
	$loc = "";
    }

    $sqlstr = "CLOSE ip2host_cursor";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    $sqlstr = "COMMIT WORK";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    return $loc;
}

sub conv_url
{
    local(*url) = @_;
    local($uriurl, $urischeme, $urinetloc, $uriepath);
    local($ipaddr);
    local($loc);

    $uriurl = new URI::URL $url;
    $urischeme = $uriurl->scheme;
    $urinetloc = $uriurl->netloc;
    $uriepath = $uriurl->epath;

    $ipaddr = loc2ipaddr($urinetloc);
    $loc = ipaddr2loc($ipaddr);
    $urinetloc = $loc if ($loc ne "");
    $url = "$urischeme"."://$urinetloc$uriepath";
}

sub push_url
{
    local($url, $point) = @_;
    local($sqlstr, $retult);

    conv_url(*url);

    if ($#_ == 0) {
	$point = scorepoint($url);
    }

    # allow or not allow
    $allowflag = 0;
    foreach $allowpat (@fetch_allow) {
	$allowflag = 1 if ($url =~ /$allowpat/);
    }
    foreach $denypat (@fetch_deny) {
	$allowflag = 0 if ($url =~ /$denypat/);
    }
    if ($allowflag == 0) {
	return;
    }

    $sqlstr = sprintf("SELECT url FROM urlpool WHERE url = '%s'", $url);
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);
    if ($result->ntuples == 0)
    {
	$sqlstr = sprintf("INSERT INTO urlpool(url, pushdate, score) values ('%s', (abstime('now'::datetime)), %d)", $url, $point);
	printf("%s\n",$sqlstr) if ($verbose == 1);
	$result = $conn->exec($sqlstr);
	print_result() if ($verbose == 1);
    }
    else
    {
    }
}

sub pop_nexturl
{
    local($ntuples, $nfields);
    $sqlstr = "BEGIN WORK";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    $sqlstr = "DECLARE url_cursor CURSOR FOR SELECT url FROM urlpool WHERE fetchdate ISNULL ORDER BY score";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);

    $sqlstr = "FETCH FORWARD NEXT IN url_cursor";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);
    print_result() if ($verbose == 1);

    $ntuples = $result->ntuples;
    $nfields = $result->nfields;
    printf("ntuples:%d ntields:%d\n", $ntuples, $nfields) if ($verbose == 1);
    if ($ntuples == 1) {
	$return_url = $result->getvalue(0, 0);
    } else {
	$return_url = "";
    }

    $sqlstr = "CLOSE url_cursor";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    $sqlstr = "COMMIT WORK";
    printf("%s\n",$sqlstr) if ($verbose == 1);
    $result = $conn->exec($sqlstr);

    return $return_url;
}

sub callback
{
    local($tag, %attr) = @_;
    local(@linkurls) = ();
    local($linkurl);
    local($linkurl2);
    local($linkurl3);
     foreach $key (keys %attr) {
	 if ($key eq "src" || $key eq "href"){
	     push(@linkurls, $attr{$key});
	 }
     }
    # href or src
    foreach $lu (@linkurls) {
	$linkurl = new URI::URL $lu;

	$linkscheme = $linkurl->scheme;
	$linknetloc = $linkurl->netloc;
	$linkepath = $linkurl->epath;

	$linkurl = "$linkscheme"."://$linknetloc$linkepath";
	push_url($linkurl);
    }
}

sub fetch_resource
{
    local($url) = @_;
    local($fetch_url);

    $fetch_url = $url;

    # check last-modified 
    $req = HTTP::Request->new(HEAD => $url);
    $res = $ua->request($req);

    if ($res->is_success && $res->last_modified != 0)
    {
	local($uriurl) = new URI::URL $url;
	$urischeme = $uriurl->scheme;
	$urinetloc = $uriurl->netloc;
	$uriepath = $uriurl->epath;
	$uriepath .= $defaultfname if ($uriepath =~ /\/$/);
	$savepath = "$downdir/$urinetloc/$uriepath";
	if (-e $savepath) {
	    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	     $atime,$mtime,$ctime,$blksize,$blocks)
		= stat($savepath);

	    # local file is newer than url
	    if ($res->last_modified <= $mtime)
	    {
		# translate http:// -> file://
		foreach $s (keys %tran_pat) {
		    $fetch_url =~ s#$tran_pat{$s}#$s#;
		}
		if ($fetch_url =~ m#file://.*/$#i) {
		    $fetch_url .= $defaultfname;
		}
	    }
	} 
    }
    else
    {
    	print "$url\n";
	print $res->error_as_HTML;

	# update table
	$sqlstr = sprintf("UPDATE urlpool SET fetchdate = (abstime('now'::datetime)), errorcode = 1 where url = '%s'", $url);
	printf("%s\n",$sqlstr) if ($verbose == 1);
	$result = $conn->exec($sqlstr);
	print_result() if ($verbose == 1);
	return 0;
    }

    # get resource
    print "Try getting $fetch_url\n" if ($verbose == 1);
    $req = HTTP::Request->new(GET => $fetch_url);
    $res = $ua->request($req);

    if ($res->is_success)
    {

	$doc = $res->content;
	$ct = $res->content_type;
	$name = $res->request->url;
	$geturl = url($name);

	save_resource($geturl, $doc);

	$path = $geturl->path;

	$path =~ s|.*/||;
	$path =~ s|\..*||;
	$path = "index" unless length($path);
	$suffix = media_suffix($ct);
	$newpath = "$path.$suffix";

	$p = HTML::LinkExtor->new(\&callback, "$url");
	$p->parse($doc);

	# update table
	$sqlstr = sprintf("UPDATE urlpool SET fetchdate = (abstime('now'::datetime)), errorcode = 0  where url = '%s'", $url);
	printf("%s\n",$sqlstr) if ($verbose == 1);
	$result = $conn->exec($sqlstr);
	print_result() if ($verbose == 1);

	return 1;
    }
    else
    {
    	print "$url\n";
	print $res->error_as_HTML;

	# update table
	$sqlstr = sprintf("UPDATE urlpool SET fetchdate = (abstime('now'::datetime)), errorcode = 2 where url = '%s'", $url);
	printf("%s\n",$sqlstr) if ($verbose == 1);
	$result = $conn->exec($sqlstr);
	print_result() if ($verbose == 1);

	return 0;
    }
}

sub save_resource {
    local($url, $doc) = @_;
    local($linkurl) = new URI::URL $url;

    $allowflag = 0;
    # allow or not allow
    # (not save if url=~m#file://#)
    foreach $allowpat (@save_allow) {
	$allowflag = 1 if ($linkurl =~ /$allowpat/);
    }
    if ($allowflag == 1) {
	$linkscheme = $linkurl->scheme;
	$linknetloc = $linkurl->netloc;
	$linkepath = $linkurl->epath;

	$linkepath .= $defaultfname if ($linkepath =~ /\/$/);
	$savepath = "$downdir/$linknetloc/$linkepath";
	@dirs = split('/', $savepath);
	$p = "";
	for ($i=0; $i<$#dirs; $i++) {
	    if ($i == 0) {
		$p = "$dirs[$i]";
	    }else{
		$p .= "/$dirs[$i]";
	    }
	    mkdir($p, 0755);
	}

	open(SAVE, ">>$savepath") || die "Can't open $savepath\n"; 
	print SAVE "$doc";
	close(SAVE);
    }
}

sub print_result
{
    if ($result->resultStatus eq PGRES_EMPTY_QUERY) {
	print "PGRES_EMPTY_QUERY";
    }elsif ($result->resultStatus eq PGRES_COMMAND_OK) {
	print "PGRES_COMMAND_OK";
    }elsif ($result->resultStatus eq PGRES_TUPLES_OK) {
	print "PGRES_TUPLES_OK";
    }elsif ($result->resultStatus eq PGRES_COPY_OUT) {
	print "PGRES_COPY_OUT";
    }elsif ($result->resultStatus eq PGRES_COPY_IN) {
	print "PGRES_COPY_IN";
    }elsif ($result->resultStatus eq PGRES_BAD_RESPONSE) {
	print "PGRES_BAD_RESPONSE";
    }elsif ($result->resultStatus eq PGRES_NONFATAL_ERROR) {
	print "PGRES_NONFATAL_ERROR";
    }elsif ($result->resultStatus eq PGRES_FATAL_ERROR) {
	print "PGRES_FATAL_ERROR";
    }
    print "\n";
}


