3714l1.orig100640 1061 330 10533 6776152366 11147 0ustar mlrljedit#!/usr/bin/perl -w use strict; use diagnostics; use LWP::RobotUA; use HTML::LinkExtor; use URI::URL; # Are we debugging? my $DEBUGGING = 1; # Start with the first argument, or my home page by default my $origin = $ARGV[0] || "http://www.lerner.co.il/"; # What is the base URL? my $base; # Into which directory should output go? my $output_directory = "/tmp/atf"; # How old can a file be, in seconds? (Two days is our initial stab) my $maximum_age = 60 * 60 * 24 * 2; # Remove the umask umask 000; # Create two hashes, one for URLs we have seen and # another for those we haven't my %already_retrieved = (); my %to_be_retrieved = ($origin => 1); # Create a new user agent my $ua = new LWP::RobotUA "ATF/1.0", 'reuven@lerner.co.il'; # If we are debugging, remove the delay between retrievals $ua->delay(0) if $DEBUGGING; # ------------------------------------------------------------ # Main loop: Retrieve sites while some remain while (my $url = (keys %to_be_retrieved)[0]) { # Create a new HTTP request my $request = new HTTP::Request('GET', $url); # Move this URL from %to_be_retrieved to %already_retrieved delete $to_be_retrieved{$url}; $already_retrieved{$url} = 1; # Indicate what we are retrieving print "Retrieving $url..."; # Hand $request to $ua, and get an HTTP # response back in return my $response = $ua->request($request); # Complete printout print ".\n"; # If there was a problem, send a report to STDERR and # go to the next URL if (!$response->is_success) { print STDERR qq{Error retrieving "$url":}, $response->status_line , "\n"; next; } # Ignore documents that are too old my $document_age = time - $response->last_modified; if ($document_age > $maximum_age) { print "\tAge of document: $document_age\n" if $DEBUGGING; next; } # Get the base URL, which is used in the callback $base = $response->base; # Create an instance of HTML::LinkExtor, # making links relative to $url my $parser = HTML::LinkExtor->new(\&callback, $url); # Parse the output $parser->parse($response->content); # ------------------------------------------------------------ # Once the callback has run, write the content to disk # Get the output filename from the URL my $output_filename = $output_directory . $base->path; $output_filename .= "index.html" if (substr($output_filename, -1) eq "/"); # Print the filename print "\tFilename = $output_filename\n" if $DEBUGGING; # Make sure that the directory exists, by splitting it up # and checking that each individual component exists my @output_directory = split /\//, $output_filename; pop @output_directory; my $output_directory = ""; while (@output_directory) { my $new_component = shift @output_directory; next unless $new_component; # Get the next component of the directory $output_directory = "$output_directory/$new_component"; # If the directory doesn't exist, then create it -d $output_directory or mkdir $output_directory, 0755 or die "Cannot mkdir $output_directory: $! "; } print "\tDirectory = $output_directory\n" if $DEBUGGING; # Now write the file open FILE, ">$output_filename" or die "Cannot write to \"$output_filename\": $! "; print "\tWriting $output_filename..." if $DEBUGGING; print FILE $response->content; print ".\n"; close FILE; } # ------------------------------------------------------------ # Define our callback, which is passed scalar and a hash sub callback { # Get the tag and its associated attributes my ($tag, %attributes) = @_; # We only care about anchor tags return unless ($tag eq "a"); # Iterate through the attributes foreach my $name (sort keys %attributes) { # If this is a link, then put the URL in the queue if ($name eq "href") { # Get the URL for this anchor my $url = $attributes{$name}; # Only accept URLs with HTTP from the same host if ($url =~ m|^http://([-\w.]+)|i) { # Get the hostname in the new URL my $host = $1; # Only add the new URL if it is on our requested host return unless ($host eq $base->host); # Indicate that we should retrieve this URL in the future, # unless we have already retrieved it $to_be_retrieved{$url} = 1 unless $already_retrieved{$url}; } } } } 3714l2.orig100640 1061 330 12402 6776152510 11134 0ustar mlrljedit#!/usr/bin/perl -w use strict; use diagnostics; use LWP::RobotUA; use HTML::LinkExtor; use URI::URL; # Are we debugging? my $DEBUGGING = 1; # Set the origin, unless we were passed a URL $ARGV[0] = "http://www.lerner.co.il/" unless $ARGV[0]; # What is the base URL? my $base; # Into which directory should output go? my $output_directory = "/tmp/atf"; # How old can a file be, in seconds? my $one_day = 60 * 60 * 24; my $two_days = 60 * 60 * 24 * 2; my $three_days = 60 * 60 * 24 * 3; my $four_days = 60 * 60 * 24 * 4; my $maximum_age = $two_days; # Remove the umask umask 000; # Create two hashes, one for URLs we have seen and # another for those we haven't my %already_retrieved = (); my %to_be_retrieved; foreach my $url (@ARGV) { print "\tAdding $url to the list...\n" if $DEBUGGING; $to_be_retrieved{$url} = 1; } # Get the phrases for matching my $phrase_file = "phrase-file.txt"; my @phrases; open PHRASES, $phrase_file or die "Cannot read $phrase_file: $! "; while () { chomp; push @phrases, $_; } close PHRASES; # Create a new user agent my $ua = new LWP::RobotUA "ATF/1.0", 'reuven@lerner.co.il'; # If we are debugging, remove the delay between retrievals $ua->delay(0) if $DEBUGGING; # ------------------------------------------------------------ # Main loop: Retrieve sites while some remain while (my $url = (keys %to_be_retrieved)[0]) { # Create a new HTTP request my $request = new HTTP::Request('GET', $url); # Move this URL from %to_be_retrieved to %already_retrieved delete $to_be_retrieved{$url}; $already_retrieved{$url} = 1; # Indicate what we are retrieving print "Retrieving $url..."; # Hand $request to $ua, and get an HTTP # response back in return my $response = $ua->request($request); # Complete printout print ".\n"; # If there was a problem, send a report to STDERR and # go to the next URL if (!$response->is_success) { print STDERR qq{Error retrieving "$url":}, $response->status_line , "\n"; next; } # Ignore documents that are too old -- but only if the server # reports such information! if ($response->last_modified) { my $document_age = time - $response->last_modified; if ($document_age > $maximum_age) { print "\tDocument too old: $document_age\n" if $DEBUGGING; next; } } # Get the base URL, which is used in the callback $base = $response->base; # Create an instance of HTML::LinkExtor, # making links relative to $url my $parser = HTML::LinkExtor->new(\&callback, $url); # Parse the output $parser->parse($response->content); # Remove HTML tags from the content my $content = $response->content; $content =~ s|<.+?>||gs; # Does the document match one or more of the phrases? my $did_match = 0; foreach my $phrase (@phrases) { if ($content =~ m/\b$phrase\b/i) { # Did we match? $did_match = 1; print "\tMatched $phrase\n"; # Exit from the foreach if we found a match last; } } next unless $did_match; # ------------------------------------------------------------ # Once the callback has run, write the content to disk # Get the output filename from the URL my $output_filename = $output_directory . $base->path; $output_filename .= "index.html" if (substr($output_filename, -1) eq "/"); # Print the filename print "\tFilename = $output_filename\n" if $DEBUGGING; # Make sure that the directory exists, by splitting it up # and checking that each individual component exists my @output_directory = split /\//, $output_filename; pop @output_directory; my $output_directory = ""; while (@output_directory) { my $new_component = shift @output_directory; next unless $new_component; # Get the next component of the directory $output_directory = "$output_directory/$new_component"; # If the directory doesn't exist, then create it -d $output_directory or mkdir $output_directory, 0755 or die "Cannot mkdir $output_directory: $! "; } print "\tDirectory = $output_directory\n" if $DEBUGGING; # Now write the file open FILE, ">$output_filename" or die "Cannot write to \"$output_filename\": $! "; print "\tWriting $output_filename..." if $DEBUGGING; print FILE $response->content; print ".\n"; close FILE; } # ------------------------------------------------------------ # Define our callback, which is passed scalar and a hash sub callback { # Get the tag and its associated attributes my ($tag, %attributes) = @_; # We only care about anchor tags return unless ($tag eq "a"); # Iterate through the attributes foreach my $name (sort keys %attributes) { # If this is a link, then put the URL in the queue if ($name eq "href") { # Get the URL for this anchor my $url = $attributes{$name}; # Only accept URLs with HTTP from the same host if ($url =~ m|^http://([-\w.]+)|i) { # Get the hostname in the new URL my $host = $1; # Only add the new URL if it is on our requested host return unless ($host eq $base->host); # Indicate that we should retrieve this URL in the future, # unless we have already retrieved it $to_be_retrieved{$url} = 1 unless $already_retrieved{$url}; } } } }