#!/usr/bin/perl -w
#
# $Id: //pentools/main/dslrim/dslrim.p#2 $
#
# written by:	Stephen J. Friedl (DSLR: "S J Friedl")
#		Software Consultant
#		steve@unixwiz.net
#		2001/12/11
#
#	==========================================================
#	==NOTE: this program is in the public domain. Have fun. ==
#	==========================================================
#
#	This is a DSL Reports Instant Messager checker. We run in
#	the background and check DSLR regularly: when an unread IM
#	is detected, we somehow notify the user synchronously.
#
#	This relies on Justin's way cool /instantcheck mechanism.
#	When fetching the page
#
#		http://www.dslreports.com/instantcheck/######
#
#	where ###### is the DSLR user number. It returns a very small
#	web page with just a single image icon: either a small envelope
#	or the big flashing one. We determine whether we have IMs
#	by searching for the image in the page. The images are:
#
#	http://i.dslr.net/bb/imsg1.gif		No unread PMs
#	http://i.dslr.net/bb/imsg.gif		You have PMs
#
#	This page request appears to be very lightweight, and it
#	does not require that anybody be logged in to use it. So
#	we can run it in the background and let it spend time looking
#	for IMs instead of our having to visit the web page itself
#	all the time. This has been a real time saver.
#
# COMMAND LINE
# ------------
#
#	--user=######		DSLR Reports user number (all digits)
#
#	--msg="XX"		specify the popup message
#
# USER NOTIFICTIONS
# -----------------
#
#	Once we detect that PMs are waiting, we have to tell the
#	user. This is done in a user-selected method. See the last
#	subroutine in the file for full info.
#
# REVISION HISTORY
# ----------------
#
#	v1.00 (2001/12/12) - initial release
#
#	v1.01 (2001/12/13) - fixed tiny error reporting problem
#
#	v1.02 (2001/12/13) - added --proxy=XXX
#
#	v1.03 (2001/12/13) - made --proxy work correctly this time
#
#	v1.04 (2001/12/15) - added --msg="XXX" option
#
#	v1.05 (2001/12/16) - now take suffixes on interval: s/m/h (sec/min/hr)
#
#	v1.06 (2001/12/24) - no longer bail out on socket errors
#

use HTTP::Request;
use LWP::UserAgent;
use strict;

my $version  = "1.06 2001/12/24";

my $interval = 60;			# once a minute
my $user     = undef;
my $verbose  = 0;			# --verbose
my $proxy    = undef;			# --proxy
my $msg      = "You have DSLR IM!";	# --msg=MSG

my $COMPUTER = $ENV{'COMPUTERNAME'};

foreach ( @ARGV )
{
	if ( m/^--help/ )
	{
		print STDERR <<EOF;

usage: imcheck --user=#### [--interval=##] [--verbose]

  --user=NUM        NUM is the DSLR user ID (required)
  --interval=##     ## is the interval in seconds between checks
  --verbose         show a little more debugging
  --proxy=PXY       specify a proxy server in "http://proxy.url.com:8080/" format
  --msg="MSG"       specify the message to display during popup

EOF
		exit 1;
	}
	elsif ( m/^--verbose/ )
	{
		$verbose = 1;
	}
	elsif ( m/^--user=(\d+)/ )		# --user-###
	{
		$user = $1;
	}
	elsif ( m/^--interval=(.+)/ )		# --interval=##
	{
		$interval = $1;
	}
	elsif ( m/^--proxy=(.+)/ )		# --proxy=PXY
	{
		$proxy = $1;
	}
	elsif ( m/^--msg=(.+)/ )
	{
		$msg = $1;
	}
	else
	{
		die "ERROR: {$_} is an invalid cmdline param (try --help)\n";
	}
}

$msg =~ s/"//g;		# dump the quotes

# ------------------------------------------------------------------------
# SANITY CHECKING OF PARAMETERS
#
# If the user gave a proxy parameter, fix it up a little bit
#

die "ERROR: no --user selected\n"		if not $user;
die "ERROR: no --interval selected\n"		if not $interval;

if ( $interval =~ m/^\d+s?$/ )			# SECONDS
{
	# OK, just seconds
}
elsif ( $interval =~ m/^(\d+)m$/i )		# MINUTES
{
	$interval = $1 * 60;
}
elsif ( $interval =~ m/^(\d+)h$/i )		# HOURS
{
	$interval = $1 * 60 * 60;
}
else
{
	die "ERROR: interval {$interval} is in bad format\n";
}

# ------------------------------------------------------------------------

if ( $proxy )
{
	$proxy =~ s|^http:*||;		# dump leading http:
	$proxy =~ s|^//||;		# dump leading //

	$proxy = "http://$proxy";	# insure leading http://

	$proxy =~ s|/*$|/|;		# insure trailing slash
}



print "unixwiz.net DSLR IM checker, v$version (user# $user, interval $interval)\n";


#------------------------------------------------------------------------
# Create the UserAgent object that will be talking to the other end to
# fetch our pages. We want to provide a unique browser string so Justin
# can see just how popular my program is :-)
#
# Then create the URL we're fetching repeatedly.
#

my $ua = new LWP::UserAgent;

$ua->agent('unixwiz.net DSLR IM checker');

my $url = "http://www.dslreports.com/instantcheck/$user";

if ( $proxy )
{
	$ua->proxy('http', $proxy );
}


my $request = HTTP::Request->new(GET => $url);

print STDERR "Sending HTTP request to:\n"	if $verbose;
print STDERR $request->as_string, "\n"		if $verbose;


#------------------------------------------------------------------------
# Now start the big loop checking for IMs. We keep track of whether we
# saw IMs on the last round, and only from the transition from "no IMs"
# to "you have IMs" do we notify the user. 
#

my $lastround = 0;

while ( 1 )
{
	my $thisround = 0;

	# ----------------------------------------------------------------
	# Fetch the page! If we can't do so we report an error to the user:
	# this might happen if the local DSL goes down or we have a problem
	# getting to the other end. We should probably 
	#
	my $result = $ua->request($request);


	if ( not $result->is_success )
	{
		my $err = $result->error_as_HTML;

		$err =~ s|.*</h1>\s*||is;	# dump leading error part
		$err =~ s|\s*</body>.*||is;	# dump trailing part


		print STDERR "ERROR: cannot fetch page: ", scalar localtime, "\n";

		print STDERR $err, "\n";


	}
	elsif ( $result->content =~ m/imsg\.gif/ )
	{
		# Only notify on no-msgs to yes-msgs transition

		$thisround = 1;

		notify_user()	if not $lastround;
	}

	$lastround = $thisround;

	sleep($interval);
}

#
# notify_user
#
#	This is called when we have detected that there is a
#	DSLR IM waiting for us, and we want to notify the user
#	synchronously. We have several notification methods, and
#	they really ought to be selected automatically.
#

sub notify_user {

	my $cmd;

	print "You have DSLR IM! at ", scalar localtime, "\n";

	# ----------------------------------------------------------------
	# WINPOPUP
	#
	# When we use NET SEND, we can make a small message appear in a
	# little dialog box.
	#
	#	NET SEND mypcname "You have DLSR IM!"
	#

	$cmd = qq{NET SEND $COMPUTER "$msg"};

	system($cmd);
}