1: #!/usr/local/bin/perl
   2: 
   3: # This program uses the LWP module to read a web page
   4: # and store its URL, Title, Description and Keywords in
   5: # a database. It then follows the links on the page and
   6: # processes any other pages it finds. The following 
   7: # switches are used to control how the program operates:
   8: # 	/u specify the url to start at
   9: #	/c continue from the last saved restart point
  10: #	/f follow links on page and process pages found
  11: #	/r write next page to process to a restart file
  12: #	/d update the database
  13: #	/l produce logfile of crawl
  14: #   either /u or /c must be specified.
  15: #
  16: # This is my first attempt at a reasonable program in Perl
  17: # so please feel free to criticise to your hearts content
  18: # (its the only way I will learn).
  19: 
  20: use HTML::TreeBuilder;
  21: use LWP::RobotUA;
  22: use URI::URL;
  23: use DBI;
  24: 
  25: # Setup user agent for robot
  26: 
  27: $ua = LWP::RobotUA->new('ChilliBot/0.1.' . LWP::Version,'ChilliBot@nextmilltech.co.uk');
  28: 
  29: $ua->delay(1);
  30: 
  31: print $ua->agent;
  32: print "\n";
  33: 
  34: # check if any arguements entered
  35: 
  36: if(scalar(@ARGV) > 0)
  37: {
  38: 	my $startpage="";
  39: 
  40: 	local @visitedpages;
  41: 	local $logtofile = 0;
  42: 	local $drilldown = 0;
  43: 	local $usedatabase = 0;
  44: 	local $setforrestart =0;
  45: 	local $continue=0;
  46: 	local $logfilename;
  47: 
  48: 	$|=1; # set autoflush on for logfile
  49: 
  50: 	# check parameters and set appropriate variables.
  51: 
  52: 	for(my $i=0;$i<scalar(@ARGV);$i++)
  53: 	{
  54: 		if($ARGV[$i] eq "/f")
  55: 		{
  56: 			$drilldown = 1;
  57: 		}
  58: 		if($ARGV[$i] eq "/l")
  59: 		{
  60: 			$logtofile = 1;
  61: 			$logfilename=$ARGV[$i+1];
  62: 		}
  63: 		if($ARGV[$i] eq "/u")
  64: 		{
  65: 			$startpage=$ARGV[$i+1];
  66: 		}
  67: 		if($ARGV[$i] eq "/d")
  68: 		{
  69: 			$usedatabase = 1;
  70: 		}
  71: 		if($ARGV[$i] eq "/r")
  72: 		{
  73: 			$setforrestart = 1;
  74: 		}
  75: 		if($ARGV[$i] eq "/c")
  76: 		{
  77: 			$continue= 1;
  78: 		}
  79: 
  80: 	}
  81: 
  82: 	if($logtofile==1)
  83: 	{
  84: 		open(LOGFILE,">$logfilename") || die "Cannot open logfile $logfilename\n";
  85: 		close(LOGFILE);
  86: 	}
  87: 
  88: 
  89: 	# we do not want to visit pages already visited so keep an array
  90: 	# of their URLs
  91: 
  92: 	@visitedpages=();
  93: 
  94: 	if($usedatabase==1)
  95: 	{
  96: 		# if we are using the database then add all URLs from it
  97: 		# to the list of visited pages.
  98: 
  99: 		print "Building visited pages list...";
 100: 
 101: 		my $DSN = "DSN=PageData";
 102: 
 103: 		my $dbh  = DBI->connect("dbi:ODBC:$DSN") || die "$DBI::errstr\n";
 104: 
 105: 		my $sql_handle=$dbh->prepare("SELECT PageURL FROM Page") || die $dbh->errstr;
 106: 
 107: 		$sql_handle->execute() || die $dbh->errstr;
 108: 
 109: 		while ( @row = $sql_handle->fetchrow_array() )
 110: 		{
 111: 			push(@visitedpages,$row[0]);	
 112: 		}
 113: 
 114: 		$dbh->disconnect();
 115: 		
 116: 		print "done\n";
 117: 	}
 118: 
 119: 	if($continue==1)
 120: 	{
 121: 		# if we are continuing then find which page to continue from
 122: 
 123: 		open(CONTINUE,"restartwith.txt") || die "Cannot open restart file\n";
 124: 		my @continueeurl=<CONTINUE>;
 125: 		foreach (@continueeurl)
 126: 		{
 127: 			$startpage=$_;
 128: 		}
 129: 		close(CONTINUE);
 130: 	}
 131: 
 132: 	if($startpage ne "")
 133: 	{
 134: 		&gethtml($startpage);
 135: 	}
 136: 
 137: 
 138: 
 139: 
 140: }
 141: else
 142: {
 143: 	# No parameters entered so printout the usage information
 144: 
 145: 	print "Usage:\n";
 146: 	print "    perl robot.pl [/u start_url] [/f] [/d] [/r] [/c] [/s] [/l logfile]\n";
 147: 	print "        where /u - url to start crawl from\n";
 148: 	print "              /f - follow links on each page\n";
 149: 	print "              /d - add page details to database\n";
 150: 	print "              /r - save last accessed url for restart with /c\n";
 151: 	print "              /c - continue from last restart-saved url\n";
 152: 	print "              /l - output to logfile\n\n";
 153: 	print "	       note: either /u or /c must be specified\n\n";
 154: }
 155: print ("Run Complete\n");
 156: 
 157: 
 158: # main routine
 159: 
 160: sub gethtml
 161: {
 162: 
 163: 	my $html;
 164: 	my $treeparse;
 165: 
 166: 	my $rlink;
 167: 	my @linkarray;
 168: 	my $baseurl;
 169: 	my $pagealreadyvisited;
 170: 	my $pagetoprocess;
 171: 	my $rlinkarray;
 172: 
 173: 	local $pagetitle ="";
 174: 	local $pagedescription = "";
 175: 	local $pagekeywords="";
 176: 	local $pagebaseurl="";
 177: 
 178: 	$pagetoprocess = $_[0];
 179: 
 180: 	if($setforrestart==1)
 181: 	{
 182: 		# write URL to restart file.
 183: 
 184: 		open(RESTARTFILE,">restartwith.txt") || die "Cannot open restart file\n";
 185: 		print RESTARTFILE $pagetoprocess;
 186: 		close(RESTARTFILE);
 187: 	}
 188: 
 189: 	# check we have not already visited this page
 190: 
 191: 	$pagealreadyvisited=0;
 192: 
 193: 	foreach (@visitedpages)
 194: 	{
 195: 		if($_ eq $pagetoprocess)
 196: 		{
 197: 			$pagealreadyvisited=1;
 198: 		}
 199: 
 200: 	}
 201: 
 202: 	if ($pagealreadyvisited == 0)
 203: 	{
 204: 		print "Processing: $_[0]...";
 205: 
 206: 		# request the page
 207: 
 208: 		$request = HTTP::Request->new('GET', $_[0]);		
 209: 		$response = $ua->request($request); 	
 210: 
 211: 		if ($response->is_success) 
 212: 		{		    
 213: 			if($logtofile==1)
 214:      			{
 215: 				open(LOGFILE,">>$logfilename") || die "Cannot open logfile $logfilename\n";
 216:      				print LOGFILE "Processing: $_[0]...Response OK\n";
 217: 				close(LOGFILE);
 218: 		  	}
 219: 			
 220: 			# parse retrieved HTML
 221: 			
 222: 			@linkarray=();
 223: 			$html=$response->content;
 224: 			$treeparse=HTML::TreeBuilder->new;
 225: 			$treeparse->parse($html);
 226: 			
 227: 			# extract anchor links
 228: 
 229: 			$rlinkarray=$treeparse->extract_links("a");
 230: 
 231: 			# call treewalker function to check meta tags
 232: 
 233: 			$treeparse->traverse(\&treewalker);
 234: 			$treeparse->delete();
 235: 			$pagebaseurl=$response->base;
 236: 
 237: 			if($logtofile==1)
 238: 		     			{
 239: 						open(LOGFILE,">>$logfilename") || die "Cannot open logfile $logfilename\n";
 240: 		     				print LOGFILE "    Title: $pagetitle\n";
 241: 		     				print LOGFILE "    Description: $pagedescription\n";
 242: 		     				print LOGFILE "    Keywords: $pagekeywords\n";
 243: 						print LOGFILE "    Base URL: $pagebaseurl\n";
 244: 						close(LOGFILE);
 245: 		     			}
 246: 	
 247: 			if($usedatabase==1)
 248: 			{
 249: 
 250: 				# write page details to database
 251: 
 252: 				# DBI::ODBC falls over with any string
 253: 				# longer than 255
 254: 
 255: 				if(length($pagetitle)>255)
 256: 				{
 257: 					$pagetitle=substr($pagetitle,0,255);
 258: 				}
 259: 
 260: 				if(length($pagedescription)>255)
 261: 				{
 262: 					$pagedescription=substr($pagedescription,0,255);
 263: 				}
 264: 				
 265: 				if(length($pagekeywords)>255)
 266: 				{
 267: 					$pagekeywords=substr($pagekeywords,0,255);
 268: 				}
 269: 								
 270: 				my $DSN = "DSN=PageData";
 271: 
 272: 				my $dbh  = DBI->connect("dbi:ODBC:$DSN") || die "$DBI::errstr\n";
 273: 
 274: 				my $sql_handle=$dbh->prepare(q{
 275: 						INSERT INTO Page (PageURL, Title, Description,Keywords) VALUES (?, ?, ?, ?)
 276: 						}) || die $dbh->errstr;
 277: 
 278: 				$sql_handle->execute("$_[0]","$pagetitle","$pagedescription","$pagekeywords")
 279: 						    || die $dbh->errstr;
 280: 
 281: 				$dbh->disconnect();
 282: 
 283: 			}
 284: 
 285: 			# add page to visited pages array
 286: 
 287: 			push(@visitedpages,$_[0]);	
 288: 
 289: 			print "OK\n";
 290: 
 291: 			# convert links from a referenced array to
 292: 			# a normal array
 293: 			
 294: 			foreach $rlink(@$rlinkarray)
 295: 			{
 296: 	
 297: 				push(@linkarray,$$rlink[0]);	
 298: 			}
 299: 
 300: 			# create full URLs from links
 301: 
 302: 			$baseurl=$response->base;
 303: 			@linkarray = map { $_= url($_, $baseurl)->abs; } @linkarray;
 304: 
 305: 			foreach (@linkarray)
 306: 			{
 307: 				if($logtofile==1)
 308: 		     		{
 309: 					open(LOGFILE,">>$logfilename") || die "Cannot open logfile $logfilename\n";
 310: 		     			print LOGFILE "    $_\n";
 311: 					close(LOGFILE);
 312: 		     		}
 313: 
 314: 			}
 315: 		
 316: 			# put in seperate loop so that printout is correct
 317: 			foreach (@linkarray)
 318: 			{
 319: 				# if link is http and does not contain
 320: 				# any odd charcters then call this function
 321: 				# recursively passing in the link
 322: 
 323: 				if (/http:/i)
 324: 				{
 325: 					if (/[#\@\$]/)
 326: 					{
 327: 					}
 328: 					else
 329: 					{
 330: 						if($drilldown == 1)
 331: 						{
 332: 							&gethtml($_);
 333: 						}
 334: 					}
 335: 				}
 336: 			}
 337: 		} 
 338: 		else 
 339: 		{
 340: 		     print "Failed\n";
 341: 		     if($logtofile==1)
 342:      		     {
 343: 			open(LOGFILE,">>$logfilename") || die "Cannot open logfile $logfilename\n";
 344:      			print LOGFILE "Processing: $_[0]...Failed\n";
 345: 			close(LOGFILE);
 346: 		     }
 347: 		}
 348: 	}
 349: 
 350: }
 351: 
 352: # Used to find title tag, and description and keyword metatags.
 353: sub treewalker
 354: {
 355: 	my ($node, $start, $depth) = @_;
 356:         if (ref $node) 
 357: 	{
 358:              my $tag = $node->tag;
 359: 
 360: 	     if ($tag eq "meta")
 361: 	     {
 362: 		my $metaname=$node->attr("name");
 363: 		if ($metaname ne "")
 364: 		{
 365: 			if ($metaname=~ /description/i)
 366: 			{
 367: 				my $description=$node->attr("content");
 368: 
 369: 				# remove CR and LF from description.
 370: 				$description =~ s/\n/ /sg;
 371: 				$description =~ s/\r/ /sg;
 372: 				$pagedescription = $description;		
 373: 			}
 374: 			if ($metaname=~ /keywords/i)
 375: 			{
 376: 				my $keywords=$node->attr("content");
 377: 
 378: 				# remove CR and LF from description.
 379: 				$keywords =~ s/\n/ /sg;
 380: 				$keywords =~ s/\r/ /sg;
 381: 				$pagekeywords = $keywords;		
 382: 			}
 383: 		}
 384:      	     }     
 385: 	
 386: 	     if ($tag eq "title" && $pagetitle eq "")
 387: 	     {
 388: 		my $contentnodearray=$node->content;
 389: 		foreach my $contentnode(@$contentnodearray)
 390: 		{
 391: 			if (not ref $contentnode)
 392: 			{
 393: 				$pagetitle=$contentnode;		
 394: 			}
 395: 		}
 396: 	     }
 397: 	
 398: 	
 399: 
 400: 	}
 401: 	return 1; # This makes it recurse through all sub nodes
 402: }
 403: