scbot ... SHOUTcast to IRC (IRC bot) 

#!/usr/bin/perl
#
# $Id: scbot.pl,v 1.11 2004/01/16 20:55:04 sharl Exp $

use Socket;
use Jcode;	# jcode() for Japanese

$rev = '$Revision: 1.11 $';
$rev =~ s/.*(\d+\.\d+).*/$1/;
$BOT_VERSION = 'SHOUTcast bot rev.' . $rev;
$USER_AGENT = "WatchLynx/$rev/scbot";

$LYNX = "/usr/bin/lynx -source -reload -useragent=$USER_AGENT";

$STREAM_NAME = "";
$SHOUTSERVER = "http://192.168.0.2:8000/";	# SHOUTcast D.N.A.S. Status URI

$IRC_SERVER = 'localhost';			# irc server host
$IRC_PORT = 6667;				# irc service port
$IRC_NICK = 'scbot';				# bot nickname
$IRC_NICK_ONAIR = 'scbot-oa';			# onair nickname
$IRC_NAME = 'scbot';				# full name
$IRC_ONAIR_CHANNEL = '#sc_on_air';		# on air channel
$IRC_NOTICE_CHANNEL = '#live';			# notice channel
@IRC_CHANNEL = ($IRC_ONAIR_CHANNEL,
		$IRC_NOTICE_CHANNEL);		# auto join channel
$IRC_USERINFO = "$SHOUTSERVER [$STREAM_NAME]";	# CTCP USERINFO message
$PROFILE_MSG = $IRC_USERINFO;			# WHOIS message

$DEBUG = 10;
$INTERVAL = 30;
$PREVTIME = time;

$status = "down";

$SIG{'ALRM'} = 'GetTitle';

########
# main #
########

while (1) {
    next if (&Connect);

    print S "NICK $IRC_NICK\r\n";
    print S "USER $IRC_NAME 8 * :$PROFILE_MSG\r\n";

    for $chan (@IRC_CHANNEL) {
	print S "JOIN $chan\r\n";
    }

#
# loop
#
    while (<S>) {
	$DEBUG && print STDERR;
	
	if (/^:\S* 433 \* $IRC_NICK/o) {
	    print STDERR "$IRC_NICK Already in use at $IRC_SERVER.\n";
	    close(S);
	    sleep(120);
	    last;
	}

# PING from server
	(/^PING (\S+)/io && &PongServer($1));

# CTCP PING
	/^:(\S+)\!\S* PRIVMSG (\S+) :\001PING (\d+)/o && &CTCP_Ping($1, $3);
# CTCP VERSION
	/^:(\S+)\!\S* PRIVMSG (\S+) :\001VERSION/o && &CTCP_Version($1);
# CTCP USERINFO
	/^:(\S+)\!\S* PRIVMSG (\S+) :\001USERINFO/o && &CTCP_UserInfo($1);
# CTCP CLIENTINFO
	/^:(\S+)\!\S* PRIVMSG (\S+) :\001CLIENTINFO/o && &CTCP_ClientInfo($1);
	
	if ($status eq "up" && /^:(.*)\!\S* JOIN :(\S+)/o
	    && $1 ne $IRC_NICK && $1 ne $IRC_NICK_ONAIR) {
	    $chan = $2;
	    print S "NOTICE $chan :Now broadcasting. $SHOUTSERVER\r\n";
	    sleep(2);
	}

	if (/^:$IRC_NICK\!\S* JOIN :(\S+)/o) {
	    $STARTFLAG = 1 if (&ChanMatch($1));
	    eval { alarm $INTERVAL; };
	}
	&GetTitle;	# for Windows
    }
}

exit;

#############
# Get title #
#############
sub GetTitle {
    return if (!$STARTFLAG);

    alarm 0;

    my $time = time;
    return if ($time - $PREVTIME < $INTERVAL);

    $DEBUG && print STDERR "status $status\nsearch title... $SHOUTSERVER\n";

    open(FD, "$LYNX $SHOUTSERVER |");
    @buffer = <FD>;
    close(FD);

    for (@buffer) {
	if (/Stream Title: <\/font><\/td><td><font class=default><b>(.*?)<\/b>/o) {
	    $STREAM_NAME = $1;
	    $STREAM_NAME = jcode($STREAM_NAME)->iso_2022_jp;
	}
	if ($status eq "down" && /Server is currently up/o) {
	    $status = "up";
	    print S "NICK $IRC_NICK_ONAIR\r\n";
	    sleep(2);
	    for $chan (@IRC_CHANNEL) {
		print S "NOTICE $chan :[$STREAM_NAME] Broadcast was started. $SHOUTSERVER\r\n";
		sleep(2);
	    }
	}
	if ($status eq "up" && /Server is currently down/o) {
	    $status = "down";
	    for $chan (@IRC_CHANNEL) {
		print S "NOTICE $chan :Broadcast was ended.\r\n";
		sleep(2);
	    }
	    print S "NICK $IRC_NICK\r\n";
	    sleep(2);
	}
	if (/Current Song: <\/font><\/td><td><font class=default><b>(.*?)<\/b>/o) {
	    $newtitle = $1;
	    if ($newtitle ne $oldtitle) {
		$line = jcode($newtitle)->iso_2022_jp;
		print S "NOTICE $IRC_ONAIR_CHANNEL :$line\r\n";
		sleep(2);
		$oldtitle = $newtitle;
	    }
	}
    }
    $DEBUG && print STDERR "search end...\n";

    $PREVTIME = $time;

    eval { alarm $INTERVAL; };
}

###############
# subroutines #
###############

#
# to pong the server back...
#
sub PongServer {
    local($fromhost) = $_[0]; 

    print S "PONG $fromhost\r\n";
    $DEBUG && print STDERR "PONG $fromhost\n";
}

################
# CTCP message #
################

#
# CTCP VERSION
#
sub CTCP_Version {
    local($nick) = $_[0];

    print S "NOTICE $nick :\001VERSION $BOT_VERSION\001\r\n";
}

#
# CTCP USERINFO
#
sub CTCP_UserInfo {
    local($nick) = $_[0];

    print S "NOTICE $nick :\001USERINFO :$IRC_USERINFO \001\r\n";
}

#
# CTCP CLIENTINFO
#
sub CTCP_ClientInfo {
    local($nick) = $_[0];

    print S "NOTICE $nick :\001CLIENTINFO :VERSION USERINFO CLIENTINFO PING\001\r\n";
}

#
# CTCP PING
#
sub CTCP_Ping {
    local($nick, $time) = @_;

    print S "NOTICE $nick :\001PING $time\001\r\n";
}

####################
# channel matching #
####################
sub ChanMatch {
    local($chan) = $_[0];

    $chan =~ tr/A-Z/a-z/;
    for $channel (@IRC_CHANNEL) {
	$channel =~ tr/A-Z/a-z/;
	return 1 if ($channel eq $chan);
    }
    return 0;
}

#####################
# server connection #
#####################
sub Connect {
    $DEBUG && print STDERR "connect...\n";

    socket(S, PF_INET, SOCK_STREAM, 0) || return 1;
    connect(S, pack_sockaddr_in($IRC_PORT, inet_aton($IRC_SERVER))) || return 1;
    select((select(S), $| = 1)[0]);
    return 0;
}

©1999,2003,2004 Kazuya 'Sharl' Masuda <sharl @ hauN.org>
29752 accesses since 2003/11/01.
3 accesses per day.