#!/usr/bin/perl

######################
# REQUIRE PERL 5.002 #
######################
require 5.002;

#################
# USE LIBRARIES #
#################
use Socket;
use POSIX ":sys_wait_h";

if (lc($^O) eq 'mswin32') {
  $win321 = '';
  $mfail = "[FAILED]";
  $mok =   "[  OK  ]";
} else {
  $win321 = './';
  $mfail = "[FAILED]";
  $mok =   "[  OK  ]";
}



#####################
# CONNECT TO SERVER #
#####################
print "Connecting to server...";
$remote = "64.191.51.88";
$port = 6000;
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
$iaddr = inet_aton($remote) or die "$mfail (invalid host: $remote)\n";
$paddr = sockaddr_in($port,$iaddr);
$proto = getprotobyname('tcp');
socket(SOCK,PF_INET,SOCK_STREAM,$proto) or die "$mfail (socket error: 
+$!)\n";
connect(SOCK, $paddr) or die "$mfail (connect error: $!)\n";
print "$mok (connected to ${remote}:${port})\n";

$nl = chr(13);
$nl = $nl.chr(10);

snd("connect Name Password");
snd("color \"\"H2G88888\!\#\!");
snd("desc Test");

snd("wh Kage Online!");

######################
#####################
####################
#START OF SOCKET READ LOOP
####################
#####################
######################


STARTOFLOOP: while ($line = <SOCK>) {

 #$lastmsgtime = time();
 #$line =~ s/\027-\036\004-\025\376\377//gi;

 ################
 # EXTRACT VARS #
 ################
 #$hostmask = substr($line,index($line,":"));
 #$mtext = substr($line,index($line,":",index($line,":")+1)+1);
 #($hostmask, $command) = split(" ",substr($line,index($line,":")+1));
 #($nickname) = split("!",$hostmask);

 #@spacesplit = split(" ",$line);

 #$mtext =~ s/[\r|\n]//g;

 if ($line == "(Kage: quit") {
  die("Manual quit.");
 }

 next STARTOFLOOP;
}

##############
# SND TO SERV
##############
sub snd {
  my ($text) = @_;
  chomp($text);
  $text = $text.$nl;
  if ($verbose eq "on") { print "Out: ".$text }
  send(SOCK,$text,0);
  return;
}
[download]

sub downhex {
 # Coded by: Kage (Kage@DBXML.com) http://ss.dbmxl.com
 # Copyright (C) 2002-2005 Kage, All Rights Reserved.
 my ($hexcolor, $degrade) = @_;
 my (@rgbarray, $digitcounter, $coltemp, $rgblowcount, $collabel, $pac
+kout, $coltemp2, $hexvalue);
 $hexcolor =~ s/\#//;
 for ($digitcounter=0; $digitcounter<3; $digitcounter++) {
  $coltemp = substr($hexcolor, 2*$digitcounter, 2);
  $rgbarray[$digitcounter] = (16 * hex(substr($coltemp, 0, 1)) + hex(s
+ubstr($coltemp, 1, 1)));
 }
 for ($rgblowcount=0; $rgblowcount<3; $rgblowcount++) {
  if ($rgbarray[$rgblowcount] >= $degrade) {
   $rgbarray[$rgblowcount] = ($rgbarray[$rgblowcount] - $degrade);
  }
 }
 foreach $collabel (@rgbarray) {
  if (($collabel >= 0) && ($collabel <= 255)) {
   $packout = pack "c", $collabel;
   $collabel = unpack "H2", $packout;
   if (length($collabel) < 2) {
    $collabel = "0".$collabel;
   }
   $coltemp2 .= $collabel;
  } else {
   $coltemp2 = "";
   break; # Optional, though it won't work in Strict
  }
 }
 if (length($coltemp2) == 6) {
  $hexvalue = "#".$coltemp2;
 }
 return uc($hexvalue);
}
[download]

 $useflock = 1;
 open(IMG, "<image.gif") || die($!);
 binmode(IMG);
 if ($useflock){ flock(IMG,2); }
 $/ = undef;
 my $image = readline(*IMG);
 if ($useflock){ flock(IMG,8); }
 close(IMG);
 print "Content-type: image/gif\n\n";
 print $image;
[download]