Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Kage's scratchpad

by Kage (Scribe)
on Jun 04, 2004 at 18:06 UTC ( #361066=scratchpad: print w/ replies, xml ) Need Help??

Geigh Socket tutorial I found
#!/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; }


Method to take a Hex color value, such as FF9944, turn it to Decimal, chop down the color by X, and return the new color in Hex:
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); }


Binmode Image Reader/Printer somethingorother (Help thanks to BrowserUk):
$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;
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (8)
As of 2014-07-11 00:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (217 votes), past polls