view release on metacpan or  search on metacpan

lib/Apache/MONITOR.pm  view on Meta::CPAN

	open(LOCK,">$dir/lock") || die("unable to open $dir/lock, $!");
	flock(LOCK,2);	

	dbmopen( %uris , "$dir/uris", 0666) || die("unable to open $dir/uris, $!");	
	if(! exists $uris{$uri})
	{
		my $now = time();
		my $value = join(' ', ($uri,$mon_string,$now,$state) );
		$uris{$uri} = $value;
	}
	dbmclose(%uris);

	dbmopen( %monitors , "$dir/monitors", 0666) || die("unable to open $dir/monitors, $!");	
	foreach my $muri (keys %monitors)
	{
		my $value = $monitors{$muri};
		my ($u,$re) = split (/ /,$value);
		if( ($u eq $uri) && ($re eq $reply_to) )
		{
			
			dbmclose(%monitors);
			close(LOCK);
			return ($muri,SUBSCRIBE_ALREADY);
		}
	}
	my $id = time() . $$;	
	$monitor_url .= $id;
	$monitors{$monitor_url} = "$uri $reply_to";
	dbmclose(%monitors);
	close(LOCK);


	return ($monitor_url,SUBSCRIBE_OK);
}
 

sub get_monitor_code
{
	my ($r,$monitored_uri) = @_;
	return undef;
	return "checker";
}





sub SUBSCRIBE
{
	require LWP::UserAgent;
	@Apache::MONITOR::ISA = qw(LWP::UserAgent);

	my $ua = __PACKAGE__->new;
	
	my $args = @_ ? \@_ : \@ARGV;

	my ($url,$reply_to,$proxy) = @$args;
	$ua->proxy(['http'], $proxy ) if(defined $proxy);
	my $req = HTTP::Request->new('MONITOR' => $url );

	$req->header('Reply_To' => $reply_to );
	#$req->header('Accept' => 'text/plain' );
	my $res = $ua->request($req);

	if($res->is_success)
	{
		print $res->as_string();
		print "Monitor created at: ",$res->header('Location') , "\n";
	}
	else
	{
		print $res->as_string();
	}

}
sub UNSUBSCRIBE
{
	require LWP::UserAgent;
	@Apache::MONITOR::ISA = qw(LWP::UserAgent);

	my $ua = __PACKAGE__->new;
	
	my $args = @_ ? \@_ : \@ARGV;

	my ($mon_url) = @$args;
	my $req = HTTP::Request->new('DELETE' => $mon_url );

	my $res = $ua->request($req);

	if($res->is_success)
	{
		print $res->as_string();
		#print $res->content;
		print "Monitor deleted\n";
	}
	else
	{
		print $res->as_string();
	}

}

sub NOTIFY
{
	require LWP::UserAgent;
	@Apache::MONITOR::ISA = qw(LWP::UserAgent);
	my $ua = __PACKAGE__->new;
	my $args = @_ ? \@_ : \@ARGV;

	my ($dir) = @$args;

	my %uris;
	my %monitors;

	open(LOCK,">$dir/lock") || die("unable to open $dir/lock, $!");
	flock(LOCK,2);	

	dbmopen( %uris , "$dir/uris" , 0040) || die("unable to open $dir/uris, $!");	
	dbmopen( %monitors , "$dir/monitors" , 0040) || die("unable to open $dir/monitors, $!");	
	foreach my $monitored_uri ( keys %uris )
	{
		my $value = $uris{$monitored_uri};
		my ($u,$mon_string,$lastmod,$state) = split(/ /,$value);
		my $modified_time = $lastmod;
		#print "--$u $mon_string $lastmod\n";
		print "*--------------------------------------------------\n";

		if( $mon_string =~ /^apply:(.+)$/ )
		{
			# apply code
			my $code = $1; 
			require "/tmp/" . $code;
			$modified_time = $code->check($u);
		}
		elsif( $mon_string =~ /^mtime:(.+)$/ )
		{	
			my $filename = $1;	
			print "$monitored_uri: checking file mtime of $filename\n";	
			my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                     	 $atime,$mtime,$ctime,$blksize,$blocks) = stat($filename);
			$modified_time = $mtime;
		}
		else
		{
			my $old_checksum = $state;
			print "$monitored_uri: checking checksum via HTTP GET\n";	
			my ($checksum,$rv,$msg) = poll_to_checksum($monitored_uri);
			if($rv)
			{
				print "$monitored_uri: ",$msg, "\n";
				next;
			}
			print " ....old checksum $old_checksum\n";
			print " ....new checksum $checksum\n";
			if( $checksum != $old_checksum)
			{
				$modified_time = time();
				$state = $checksum;
			}
		}
	
		next unless ($modified_time > $lastmod);	

		print "...$monitored_uri has changed, getting monitors\n";

		# updating record with new lastmod

		$uris{$monitored_uri} = "$u $mon_string $modified_time $state";

		foreach my $muri (keys %monitors)
		{
			my $value = $monitors{$muri};
			my ($u,$re) = split(/ / , $value);
			next unless ($u eq $monitored_uri);

			#my $req = HTTP::Request->new('GET' => $monitored_uri);
			#my $res = $ua->request($req);
			#my $body;
			#if($res->is_success)
			#{
			#	$body = $res->content;
			#}
			#else
			#{
			#	$body = $res->as_string();
			#}
			#$req->header('Reply_To' => $reply_to );

			if( $re =~ /^mailto:(.*)$/ )
			{
				my $to = $1;
				open(MAIL,"|mail $to -s \"Resource $monitored_uri has changed\"");
				print MAIL "Resource state has changed at ". localtime($modified_time) ."\n";
				print MAIL "View the monitored resource: $monitored_uri\n";
				print MAIL "Edit your monitor: $muri\n";
				close(MAIL);
				print "   notified $re\n";	
			}
		}
		
	}
	dbmclose(%uris);
	dbmclose(%monitors);

	close(LOCK);

}
sub poll_to_checksum
{
	require LWP::UserAgent;
	@Apache::MONITOR::ISA = qw(LWP::UserAgent);
	my $ua = __PACKAGE__->new;
	my $args = @_ ? \@_ : \@ARGV;

	my ($uri) = @$args;

	my $req = HTTP::Request->new('GET' => $uri);
	my $res = $ua->request($req);
	if($res->is_success)
	{
		my $s = $res->content;
		$s =~ s/<meta[^>]+>//gi;
		my $cs = cksum($s);
		return ($cs,0,'');
	}
	else
	{
		return (0,1,'GET error');
	}
}

1;
__END__

=head1 NAME

Apache::MONITOR - Implementation of the HTTP MONITOR method

=head1 SYNOPSIS

=head1 DESCRIPTION

This module implements a MONITOR HTTP method, which adds notifications to the
World Wide Web.

=head1 CONFIGURATION

httpd.conf:

  PerlSetVar MonitorDataDir /home/httpd/monitors
  PerlSetVar MonitorUrlPrefix http://myserver/monitors/
 
  PerlPostReadRequestHandler Apache::MONITOR
  PerlHeaderParserHandler Apache::MONITOR::hp_handler
 
  <Location /monitors/>
    SetHandler perl-script
    PerlHandler Apache::MONITOR::moo
  </Location>


crontab:

  # check for changes every 30 minutes
  0,30 * * * * perl -MApache::MONITOR -e NOTIFY /home/httpd/monitors &>/dev/null


=head1 COMMANDLINE TOOLS

Subscribe:

  perl -MApache::MONITOR -e SUBSCRIBE http://www.mopo.de mailto:joe@the.org

Show all subscriptions:

  perl -MApache::MONITOR -e SHOW /path/to/monitors