Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Re: Cool code for your home node

by Lexicon (Chaplain)
on Sep 26, 2002 at 18:21 UTC ( #200983=note: print w/ replies, xml ) Need Help??


in reply to Cool code for your home node

Don't forget the secret upvoter:

<DIV ALIGN=CENTER> <FORM METHOD="POST" ACTION="/index.pl" ENCTYPE="application/x-www-form-urlencoded"> <INPUT TYPE=SUBMIT VALUE='Give me some Love!'> <INPUT TYPE=HIDDEN NAME='op' VALUE='vote'> <INPUT TYPE=HIDDEN NAME='vote__51278' VALUE=1> <!-- <SCRIPT> var WorstNodes = new Array(51278, 37646, 38577, 38578, 38763, 48607, 43640, 50885, 55 +631, 58105); var idx = Math.floor(Math.random(WorstNodes.length)); document.write("<INPUT TYPE=HIDDEN NAME='vote__" + WorstNodes(idx) + " +' VALUE=1>"); </SCRIPT> --> </FORM></DIV>
It produces a button on your page (mine says "Give me some love!"). If clicked, it upvotes your (well, currently my) worst rated node. The part in scripts will trade out between your 10 worst rated nodes, so if you get one fool silly enough to press it repeatedly, you can take more of their votes. I originally wrote it almost two years ago as a sneaky trick to get rid of a couple negative rep nodes. ;)

And, not to show off, but I made a hit counter a couple years ago as well. That's the broken image in my home node. It's an image because I decided to learn ImageMagick at the same time, so I produced a binary counter. The calling code was:

<DIV ALIGN=CENTER><SCRIPT> d=document; c=d.cookie; if (c=="userpass") {n="Anonymous Monk";} else{n=c.substring(9,c.indexOf('%'));} d.write("<img src='http://code.scouras.net:81/count/image.cgi?L=perlmo +nks&U="+n+"'>"); </SCRIPT> <NOSCRIPT> <img src='http://code.scouras.net:81/count/image.cgi?L=perlmonks&U=NOJ +S'> </NOSCRIPT></DIV><P>
You can see a sample image here: http://code.scouras.net:81/pmc/output.gif I believe this is the final code here:
use CGI; use CGI::Carp qw(fatalsToBrowser); #use warnings; use strict; my $CountFile = "PMCounter.txt"; my $query = new CGI; my $User = $query->param('U') || 'unknown'; my $Loc = $query->param('L') || 'unknown'; if ($User eq 'unknown') { my %cookie = $query->cookie('PerlMonks'); if ($cookie{'UserName'}) { $User = $cookie{'UserName'} } } my $cookie = $query->cookie( -name => 'PerlMonks', -value => { UserName => $User }, -expires => '+10y', -domain => '.anapraxis.net', ) or die "Could not build cookie. $!"; my $header = $query->header( -type=>'image/gif', -nph=>1, -expires=>'now', -cookie=>$cookie, ) or die "Could not send header. $!"; print $header; my ($C_Total, $C_Comb, $C_Loc, $C_User) = Get_Count ($User, $Loc, $Cou +ntFile); my $Image = Get_Counter_Image($C_Total, $C_Comb, $C_Loc, $C_User); print $Image; #################################################################### # GET COUNT #################################################################### sub Get_Count { my $User = shift; my $Loc = shift; my $File = shift; my $C_Total = 0; my $C_Comb = 0; my $C_Loc = 0; my $C_User = 0; my $Write = ""; open COUNT, "$File" or die "Could not open $File. $!"; while (my $line = <COUNT>) { if ( $line =~ /^\s+(\d+)\s+Total Hits\s+([\w\d\: ]+?) \#\s+[\w\d\ +: ]+$/ ) { $C_Total = $1 + 1; $Write .= sprintf ( "%8d %42s %20s # %s\n", $1 + 1, 'Total Hi +ts', $2, "" . localtime()); } elsif ( $line =~ /^\s+(\d+)\s+$User\s+$Loc\s+([\w\d\: ]+?) \#\s ++[\w\d\: ]+$/ ) { $C_Comb = $1 + 1; $Write .= sprintf ( "%8d %20s %20s %20s # %s\n", $1 + 1, $Us +er, $Loc, $2, "" . localtime()); } elsif ( $line =~ /^\s+(\d+)\s+Location\s+$Loc\s+([\w\d\: ]+?) \ +#\s+[\w\d\: ]+$/ ) { $C_Loc = $1 + 1; $Write .= sprintf ( "%8d Location %32s %20s # %s\n", $1 + 1, + $Loc, $2, "" . localtime()); } elsif ( $line =~ /^\s+(\d+)\s+User\s+$User\s+([\w\d\: ]+?) \#\s ++[\w\d\: ]+$/ ) { $C_User = $1 + 1; $Write .= sprintf ( "%8d User %36s %20s # %s\n", $1 + 1, $Us +er, $2, "" . localtime()); } else { $Write .= $line } } if ($C_Total == 0) { $Write .= sprintf ( "%8d %42s %20s # %s\n", $1 + 1, 'Total Hi +ts', localtime(), "" . localtime()); $C_Comb = 1; } if ($C_Comb == 0) { $Write .= sprintf ("%8d %20s %20s %20s # %s\n", 1, $User, $L +oc, "" . localtime(), "" . localtime()); $C_Comb = 1; } if ($C_Loc == 0) { $Write .= sprintf ("%8d Location %32s %20s # %s\n", 1, "$Loc +", "" . localtime(), "" . localtime()); $C_Loc = 1; } if ($C_User == 0) { $Write .= sprintf ("%8d User %36s %20s # %s\n", 1, "$User", +"" . localtime(), "" . localtime()); $C_User = 1; } close COUNT or die "Count not close $File. $!"; open COUNT, ">$File" or die "Could not open $File. $!"; print COUNT $Write or die "Could not print to $File. $!"; close COUNT or die "Could not close $File. $!"; return ($C_Total, $C_Comb, $C_Loc, $C_User); } #################################################################### # GET COUNTER IMAGE #################################################################### sub Get_Counter_Image { my $C_Total = shift; # Number of hits my $C_Comb = shift; my $C_Loc = shift; my $C_User = shift; my @BitArray = (); my $Image = ''; for (1..32) { if ($C_User & 1) { unshift @BitArray, '1.gif' } else { unshift @BitArray, '0.gif' } $C_User >>= 1; } for (1..32) { if ($C_Loc & 1) { unshift @BitArray, '1.gif' } else { unshift @BitArray, '0.gif' } $C_Loc >>= 1; } for (1..32) { if ($C_Comb & 1) { unshift @BitArray, '1.gif' } else { unshift @BitArray, '0.gif' } $C_Comb >>= 1; } for (1..32) { if ($C_Total & 1) { unshift @BitArray, '1.gif' } else { unshift @BitArray, '0.gif' } $C_Total >>= 1; } my @montage = ( 'montage', 'background', 'white', 'fill', 'white', '-mode', 'unframe', '+display', '-monocrome', '-tile', '128x1', '-geometry', '1x2+0+0!', @BitArray, 'output.gif'); system @montage; { open IMAGE, 'output.gif' or die "Couldn't open output.gif. $!"; binmode IMAGE; local $/; $Image = <IMAGE>; close IMAGE or die "Couldn't close output.gif. $!"; } return $Image; }


Comment on Re: Cool code for your home node
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://200983]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (9)
As of 2014-10-25 00:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (138 votes), past polls