Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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; }


In reply to Re: Cool code for your home node by Lexicon
in thread Cool code for your home node by BigLug

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • 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 musing on the Monastery: (5)
    As of 2014-07-30 22:24 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (241 votes), past polls