Webwatcher

Da ich von Natur aus ein recht neugieriger Mensch bin, will ich sehr zeitnah über Änderungen auf Webseiten informiert werden. Aktuelles Beispiel ist der Livegang von Google Base.

Man könnte sich quick and dirty einen cronjob zusammenzimmern, der regelmäßig per wget, curl oder was auch immer eine Seite abholt und auf Änderungen parst. Hmm… das Problem muss schonmal jmd vor mir gehabt haben. Google war mein Freund und stieß mich auf den Webwatcher.
Dies ist ein recht schlankes Perlskript, dass genau das tut und zusätzlich ein funktionales WebFrontend mitbringt.

Das ganze wird per crontab regelmäßig abgefackelt und bei Änderungen der entsprechenden Seite erhält man eine Mail mit dem diff! 😉

So sieht das Teil aus:

Und hier kommt das Skript:


[geshi lang=perl]
#!/usr/bin/perl -w
##################################################
# Michael Schilli, 1999 (mschilli@perlmeister.com)
##################################################

use Algorithm::Diff qw/diff/;
use LWP::UserAgent;
use Storable;
use HTML::Entities;
use CGI 2.38 qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;

my $DB = "/tmp/controlletti.dat";
my $EMAIL_TO = "user\@domain.com";
my $EMAIL_FROM = "user\@domain.com";

my $CHANGED = "CHANGED";
my $UNCHANGED = "unchanged";

sub esc { encode_entities($_[0]); };

if (-r $DB) {
my $store = retrieve($DB) ||
die("$DB: Cannot restore");
@STORE = @$store;
} else {
@STORE = ();
}

if(!$ENV{'REMOTE_ADDR'}) { # Command line call
foreach $r (@STORE) { run_test($r); }
store(\@STORE, $DB) || die "Store $DB failed";
exit(0);

} elsif(param('runall')) { # Run all tests
foreach $r (@STORE) { run_test($r); }

} elsif(param('new')) { # Insert new record
push(@STORE,
{url => param('url'), rgx => param('rgx'),
status => '?', id => time . $$});

} elsif(param('del')) { # Delete record
@STORE = grep { $_->{id} != param('id') } @STORE;

} elsif(param('upd')) { # Update record
($r) = grep { $_->{id} == param('id') } @STORE;
$r->{url} = param('url');
$r->{rgx} = param('rgx');

} elsif(param('run')) { # Run test now
($r) = grep { $_->{id} == param('id') } @STORE;
run_test($r);

} elsif(param('cpdown') || param('id')) {
# Copy record to edit fields
($r) = grep { $_->{id} == param('id') } @STORE;
param('url', $r->{url});
param('rgx', $r->{rgx});
}

# Display list
print header(), start_html(-BGCOLOR => 'white'),
h1("Web Watcher"), "

";
print "
",
TR(map { th($_) } qw/URL Regex Checked
Status Comment LstChange Commands/);
foreach $r (@STORE) {
my $chktime = $r->{checked} ?
scalar localtime($r->{checked}) :
"Not Yet";
print TR(
td(a({href => $r->{url}}, $r->{url})),
td(esc($r->{rgx}) || " "),
td($chktime),
td($r->{status}),
td($r->{comment}),
td(scalar localtime $r->{lstchange}),
td(a({href => url() . "?cpdown=1&id=$r->{id}"},
"CpDown"), " ",
a({href => url() . "?del=1&id=$r->{id}"},
"Del"), " ",
a({href => url() . "?run=1&id=$r->{id}"},
"Run"), " ",
));
}
print "
";

# Link for running all tests
print p, a({href => url() . "?runall=1"},
"Run all tests");

# Form for new entries
print h2("New Entry"), start_form(),
table(
TR(td("URL:"),
td(textfield(-size => 80, -name => 'url'))),
TR(td("Regex:"),
td(textfield(-name => 'rgx'))),
),
submit(-name => 'new',
-value => 'Add URL');

# Hidden ID field in case it's there
if(param('id')) {
print hidden(-name => 'id',
-value => param('id')),
}
if(param('upd') || param('cpdown')) {
print submit(-name => 'upd',
-value => 'Update');
}

print end_form(), end_html();

store(\@STORE, $DB) || die "Store to $DB failed";

##################################################
sub page_snippet {
##################################################
my ($url, $rgx) = @_;

my $req = HTTP::Request->new('GET', $url);
my $resp = LWP::UserAgent->new->request($req);

if($resp->is_error()) {
return [$resp->code, $resp->message];
}

if($rgx) {
$resp->content() =~ /$rgx/si || return 0;
return $&;
}

return $resp->content();
}

##################################################
sub mkdiff {
##################################################
my ($t1, $t2) = @_;
my $r = "";

my $diffs = diff([split(/\n/, $t1)],
[split(/\n/, $t2)]);

return "" unless @$diffs;

foreach $chunk (@$diffs) {
foreach $line (@$chunk) {
my ($sign, $nu, $text) = @$line;
$r .= sprintf("%4d$sign %s\n", $nu+1, $text);
}
$r .= "-------------";
}

return($r);
}

##################################################
# alert by email
##################################################
sub email {
my ($r) = @_;
my $days = $diff = "";

my $text = <{url}\n\nA diff to the previous content reads:
\n$r->{diff}\n\nGreetings from Planet Perl!\n\n
Your humble WebWatch program.
EOT

open(PIPE, "| /usr/lib/sendmail -t") ||
die("Cannot connect to sendmail");
print PIPE "From: $EMAIL_FROM\n";
print PIPE "To: $EMAIL_TO\n";
print PIPE "Subject: WebWatch Alert\n\n";
print PIPE "$text\n.\n";
close(PIPE) || die "Sendmail failed";
}

##################################################
sub run_test {
##################################################
my $r = shift;

my $match = page_snippet($r->{url}, $r->{rgx});
my $last_time_error = $r->{error};

$r->{comment} = $match ? " " : "No match";
$r->{error} = "";
$r->{checked} = time;

if(ref($match)) {
# There's an error
$r->{error} = $match->[0];
$r->{comment} = "$match->[0]: $match->[1]";
$r->{diff} = "Error: $r->{comment}";
if($last_time_error eq $match->[0] ||
$r->{status} eq "?") {
# Same error as last time or first time call
$r->{status} = $UNCHANGED;
} else {
#
$r->{status} = $CHANGED;
email($r);
}
return;
}

if($last_time_error) {
$r->{status} = $CHANGED;
$r->{lstchange} = time;
$r->{match} = $match;
$r->{diff} = "Recovered from $last_time_error";
email($r);
} elsif($r->{match} eq $match) {
$r->{status} = $UNCHANGED;
} else {
$r->{match} = $match;
if($r->{status} eq '?') {
$r->{status} = $UNCHANGED;
return;
} else {
$r->{status} = $CHANGED;
}
$r->{lstchange} = time;
$r->{diff} = mkdiff($r->{match}, $match);
$r->{match} = $match;
email($r);
}

return;
}

[/geshi]