#!/usr/local/bin/perl -w
# need version 5 or higher for [] array formation operator

# crawl through web pages collecting a list of pictures, starting
# from a list of URL's or HTML files.  do it in breadth-first order.
#
# Paul Heckbert	23 Apr 01

# usage: crawl.pl [LEVELMAX] FILE...
# FILE can be a regular filename on the local machine, or a URL
# LEVELMAX sets the depth of graph traversal:
# LEVELMAX=1 reads one level of HTML file, looking for pictures linked by it
# LEVELMAX=2 reads two levels of HTML
#
# output contains lines of the form
#   pic-{jpg|gif} WIDTH HEIGHT {rgb|gray} URL
# e.g.
# pic-jpg 150 130 rgb http://www.animalpicturesarchive.com/animal/PIX/Badger.jpg

$levelmax = 3;
if ($ARGV[0] =~ /^\d*$/) {	# if first arg is an integer
    $levelmax = $ARGV[0];
    shift;
}

# list[i] is a list of level i files (or URL's)
# list[i][j] is the jth file at level i
# lists of lists in Perl are tricky, see
# ftp://ftp.oleane.net/pub/mirrors/CPAN/doc/manual/html/pod/perllol.html

for ($j=0; $j<=$#ARGV; $j++) {
    &add_to_list(0, $ARGV[$j]);
}

for ($i=0; $i<=$levelmax; $i++) {
    print "========================================== level $i has ", $#{$list[$i]}+1, "\n";
    for ($j=0; $j<=$#{$list[$i]}; $j++) {
	# print "list[$i][$j]=", $list[$i][$j], "\n";
	$file = $list[$i][$j];
	&crawlfile($i, $file);
    }
}


sub crawlfile {
    local($level, $file) = @_;

    local($ext) = $file;	# now calculate file extension (if any)
    $ext =~ s|.*/||;		# take away everything before /
    $ext =~ s/.*\.//;		# take away everything before .

    print "--------------------------------\n";
    if ($ext =~ /^jp[e]?g$/i || $ext =~ /^gif$/i) {	# a picture?
	&picture($level, $file, $ext);
	return;
    }

    local(*IN);			# make a local filehandle
    local($nbytes) = 0;

    if ($file =~ m|tp://|) {	# if filename starts with "http or ftp"
	print "$level url $file\n";
	# note: single quotes are necessary on the following GET because URL
	# sometimes contains ampersands, and the command below (because
	# it's a pipe) is interpreted by the shell, causing ampersands to do
	# magic things
	open(IN, "GET -u '$file' 2>&1 |")
	    || die "can't GET $file\n";
	# 2>&1 above is critical, so that if URL is bad, we can read stdout

	# check google for Perl FAQ on
	# How can I capture STDERR from an external command?

	# GET's -u option, e.g.
	# "GET -u http://www.cs.cmu.edu/~ph" causes first line of output like
	# GET http://www.cs.cmu.edu/~ph/
	# which appends a "/" if the last part of URL is a dir, not a file.

	# Read that first line
	$_ = <IN>;
	if (/GET (.*)\n/) {
	    $file = $1;		# update $file, possibly appending a "/"
	}
	# else the line is probably "<HTML>" from an error message

	if ($file !~ m|//.*/|) {	# if there is no / after //
					# e.g. http://foo.com
	    $file .= "/";		# then add a "/" (GET -u didn't)
	}
    }
    else {
	print "$level file ($file) ($ext)\n";
	if (!open(IN, "<$file")) {
	    print "can't read $file\n";
	    return;
	}
    }

    local($error) = 0;
    while (<IN>) {
	$nbytes += length($_);
	chop;
	# print "$. [$_]\n";
	if ($.==2 && $_ eq '<HEAD><TITLE>An Error Occurred</TITLE></HEAD>') {
	    # GET returned an error
	    $error = 1;
	}
	if ($error && $.==5) {		# if error, line 5 is error message
	    print "Error: $_\n";
	    close(IN);			# quit early
	    return;
	}

	# samples of the variety of A HREF and IMG SRC formats you encounter:
	# <a href="http://media.exchange-it.com/click.go?b123988=1" target="_top">
	# <img src="http://media.exchange-it.com/image.go?b123988=1" width=468 height=60 border=1 ALT="Click to Visit">
	# <a target=_top href=/animal/>
	# <a href=/animal/APAsrch3.cgi?qt=African+porcupine><img alt="Click me to search" src=/animal/PIX/AfricanPorcupine.jpg></a>
	# note the last one, in which two links occur on one input line

	foreach $str (split('[<>]+', $_)) {	# in case there's more than one
	    if ($str =~  /a.* href="?([^" ]*)"?/i
	     || $str =~ /img.* src="?([^" ]*)"?/i) {
		# if input line contains "A HREF" or "IMG SRC"

		local($subfile) = $1;
		$subfile =~ s/#.*//;	# take away everything after #
		if ($subfile =~ m|tp://|) {	# absolute path
		    &add_to_list($level+1, $subfile);
		}
		else {			# relative path
		    local($dir) = $file;
		    $dir =~ s|[^/]*$||;	# chop trailing filename off of $dir
		    # print "coming from file=($file) dir=($dir)\n";
		    if ($subfile =~ m|^/|) {# if subfile begins with /
			# shorten dir to be just the machine name (no subdirs)
			# e.g. from http://foo.com/one/two/ to http://foo.com
			$dir =~ s|([^/]*//[^/]*).*|$1|;
		    }
		    &add_to_list($level+1, $dir . $subfile);
		}
	    }
	}
    }

    print "$nbytes bytes\n";

    close(IN);
    print "done with $file\n";
}

sub add_to_list {
    # add $file to list at level $level, if it's new
    local($level, $file) = @_;

    if ($file =~ m/mailto:.*@/) {	# URL to send email - ignore
	return;
    }

    local($ext) = $file;	# now calculate file extension (if any)
    $ext =~ s|.*/||;		# take away everything before /
    $ext =~ s/.*\.//;		# take away everything before .

    if ($ext =~ /^jp[e]?g$/i || $ext =~ /^gif$/i || $level<$levelmax) {
	# if file is a picture, or level isn't at max, explore this new file
	if (defined($filelist{$file})) {
	    # print "  already visited $file\n";
	    return;
	}
	print "  add_to_list $level $file\n";
	$filelist{$file} = $level;	# add this filename to associative array
	push @{$list[$level]}, $file;
	# the @{ and } above are necessary but pretty stupid, aren't they?
	# Perl is such a mess!
    }
}

sub picture {
    # read picture in $file, print its size
    local($level, $file, $ext) = @_;

    local(*IN);
    # print "picture ($file)\n";

    local($convert, $type);
    if ($ext =~ /jp[e]?g/i) {
	$convert = "jpegtopnm";
	$type = "jpg";
    }
    else {
	$convert = "giftopnm";
	$type = "gif";
    }

    if ($file =~ m|tp://|) {	# if filename starts with "http"
	open(IN, "GET '$file' 2>&1 | $convert | pnmfile |")
	    || die "can't GET $file\n";
    }
    else {
	if (!open(IN, "<$file | $convert | pnmfile |")) {
	    print "can't read $file\n";
	    return;
	}
    }

    local($sizeknown) = 0;
    while (<IN>) {
	# stdin: PGM raw, 544 by 900 maxval 255
	# stdin: PPM raw, 640 by 600 maxval 255
	if (/(P.M).* (\d*) by (\d*)/) {
	    local($format) = "gray";
	    if ($1 eq "PPM") {$format = "rgb";}
	    print "pic-$type $2 $3 $format $file\n";
	    $sizeknown = 1;
	}
    }

    if (!$sizeknown) {
	print "unknown picture format $file\n";
    }
    close(IN);
}
