Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
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 rifling through the Monastery: (3)
As of 2015-07-06 08:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (70 votes), past polls