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

Re: Cool code for your home node

by Lexicon (Chaplain)
on Sep 26, 2002 at 18:21 UTC ( [id://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; }

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2024-03-29 11:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found