comment on

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>
[download]

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>
[download]

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;
}
[download]

Lexicon

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

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


XP is just a number
	PerlMonks