Re: Cool code for your home node

[Lexicon]

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;
}

Lexicon