#!/usr/bin/env perl # <<Simple CGI Captcha # 20110619 #!# script perl captcha # an example perl cgi. # should be read as a use case of the perl CGI module # for forming and reading html forms. # Internalizing that logic might also be done # via shell scripting... # this example should NOT be read as a programming example, # except... use strict; use warnings; # Do this, all the time, and modify code to eliminate all warnings. # Elsewise, my brain is not wired for programming. # Demonstration at rguest.freeshell.org/commenting/commenting.cgi use Captcha::reCAPTCHA; #use CGI::Simple; use CGI; use Text::Markdown 'markdown'; use feature 'switch'; my $privkey; my $pubkey; given ($ENV{'SERVER_NAME'}) {; # Your reCAPTCHA keys from # https://admin.recaptcha.net/recaptcha/createsite/ when ('<your.domain>') { $pubkey = '<your_recaptcha_public_key>'; $privkey = '<your_recaptcha_PRIVATE_key'; } } $| = 1; my $realquery = 1; my $comrows = 10; my $comcols = 80; my $onefilepath = './artcom'; #my $q = CGI::Simple->new; my $q = new CGI; my %cboxopts = ( 'pass', "simulate pass", 'nopass', "simulate fail", ); my $c = Captcha::reCAPTCHA->new; my $error = undef; =pod get a page from somewhere display it with a comment button if (param('recaptcha_response_field') param('pfail') param('combody') =cut # let there be page HTML print $q->header; # page title print $q->start_html('comment!'); # first line displayed print $q->h2('Comment!'); # TODO: a link to the preceding page # this could be unique'id' query back to a search # print $m->a({href=>"index.html"}, "back"); print $q->p; ### # Check response if ( $q->param( 'recaptcha_response_field' ) ) { my $result = $c->check_answer( $privkey, $ENV{'REMOTE_ADDR'}, $q->param( 'recaptcha_challenge_field' ), $q->param( 'recaptcha_response_field' ) ); if ( $result->{is_valid} ) { # print "Yes! (" . $result->{is_valid}; $q->param('start', 'nocomment'); if ($q->param('combody')) {addcomment ($q->param('combody'), $onefilepath) } } else { $error = $result->{error}; $q->param('start', 'notrans'); print "Please try again ($error error)."; } } elsif ($q->param('pfail')) { if ($q->param('pfail') eq 'pass') { # print 'yes'; $q->param('start', 'nocomment'); if ($q->param('combody')) {addcomment ($q->param('combody'), $onefilepath) } } else { $q->param('start', 'notrans'); print 'no'; } } if (!$q->param('start') or $q->param('start') eq 'nocomment') { printart(1); print $q->hr; print $q->p; print $q->start_form; print $q->submit(-name=>'start', -label=>'comment'); print $q->end_form; print $q->end_html; exit; } # form a form comform(); sub comform { printart(1); print $q->hr; print $q->start_form; print $q->textarea( -name=>'combody', # -value=>'comments?', -rows=>$comrows, -columns=>$comcols ); # Generate the form if ($realquery) { print $c->get_html( $pubkey, $error ) } else { print $q->radio_group(-name=>'pfail', -values=>['pass', 'nopass'], -default=>'pass', -labels=>\%cboxopts, # -linebreak=>'true', ); } print $q->p; print $q->submit(-name=>'submit'); print $q->end_form; print $q->end_html; } sub addcomment { # my $body = shift; my $body = printart(0); my $comment = shift; $body .= "\n" . $comment . "\n"; open my $outhand, '>', $_[0] or die ("unable to open $onefilepath to write: $!"); print $outhand $body; close $outhand; print $q->p; } sub printart { my $inbody; my $outbody; open my $bodyhand, '<', $onefilepath or die ("unable to open $onefilepath: $!"); for (<$bodyhand>) {$inbody .= $_}; close $bodyhand; return $inbody if ($_[0] == 0); $outbody = markdown ($inbody); print $outbody; return 0; }