# Copyright 2006-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: captcha.coretag,v 1.4 2007-03-30 23:55:57 pajamian Exp $

UserTag captcha Order    function
UserTag captcha attrAlias  func function
UserTag captcha addAttr
UserTag captcha Description  Generate captcha codes for authentication check
UserTag captcha Version    $Revision: 1.4 $

UserTag captcha Routine    <<EOR
my $Have_Captcha;
eval {
 require Authen::Captcha;
 $Have_Captcha = 1;
};

sub {
 my ($func, $opt) = @_;

 use vars qw/$Tag/;

 if(! $Have_Captcha) {
   ::logError("Use of captcha tag without Authen::Captcha, skipping");
   return '';
 }
 
 $func = lc($func);
$func =~ s/[^a-z]+//g;
my $result = '';
if($func eq 'code') {
 $result = $Vend::Session->{captcha};
}

$opt->{length} ||= 4;
my $en = $opt->{error_name} || 'captcha';

my $subdir = $opt->{image_subdir}
|| $::Variable->{CAPTCHA_IMAGE_SUBDIR}
|| 'captcha';
my $tmpdir = "$Vend::Cfg->{ScratchDir}/$subdir";

mkdir($tmpdir) unless -d $tmpdir;

my $imgdir = $opt->{image_location} || $::Variable->{CAPTCHA_IMAGE_LOCATION};

unless ($imgdir ) {
if(! $Global::NoAbsolute and $::Variable->{DOCROOT}) {
$imgdir = "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$subdir";
}
else {
$imgdir = "images/$subdir";
}
}

my $imgpath = $opt->{image_path}
      || $::Variable->{CAPTCHA_IMAGE_PATH}
      || "$::Variable->{IMAGE_DIR}/$subdir";


my $captcha = Authen::Captcha->new(
        data_folder => $tmpdir,
         output_folder => $imgdir,
       );

 my $guess   = $opt->{guess} || $CGI::values{mv_captcha_guess};
 my $code    = $opt->{source};

 if($func eq 'check') {

   my $check_against = $code || $Vend::Session->{captcha};
   my $status = $captcha->check_code($guess, $check_against);
   if($status > 0) {
     return $status;
   }
   elsif($status == 0) {
     $Tag->error( { name => $en, set => "Code not checked: error" });
     return 0;
   }
   elsif($status == -1) {
     $Tag->error( { name => $en, set => "Code expired" });
     return 0;
   }
   elsif($status == -2) {
     $Tag->error( { name => $en, set => "Code never generated" });
     return 0;
 }
 elsif($status == -3) {
   $Tag->error( { name => $en, set => "Code doesn't match" });
   return 0;
 }
}
else {
 # Used for [captcha-refresh] if requested
 $::Instance->{last_captcha_build_opt} = { %$opt };

   my $save_u = umask($::Variable->{CAPTCHA_UMASK} || 2);

 if($opt->{reset}) {
   undef $Vend::Captcha;
   delete $Vend::Session->{captcha};
   }

   if($Vend::Captcha) {
     $code ||= $Vend::Session->{captcha};
   }

   if($func eq 'code' and $code) {
     return $code;
   }

    eval {

   unless( Vend::File::allowed_file($imgdir, 1) ) {
     my $msg = errmsg("No permission to write directory '%s'", $imgdir);
     $Tag->error( { name => $en, set => $msg });
     return 0;
   }

   mkdir($imgdir) unless -d $imgdir;

   if(! $code) {
     $code = $Vend::Session->{captcha} = $captcha->generate_code($opt->{length});
     $Vend::Captcha = $code;
   }
   umask $save_u;
    };

   if($@) {
     $Tag->error( { name => $en, set => "Error: $@" });
     return '';
   }

   if($func eq 'code') {
     return $code;
   }
 
   # Now probably an image function.

   unless ($func =~ /ima?ge?/)  {
     $Tag->error({
             name => $en,
             set => errmsg("Unknown function %s", $func),
           });
     return undef;
   }

   my $path = $opt->{relative} ? "$subdir/$code.png" : "$imgpath/$code.png";

   if(! $opt->{name_only}) {
     return   $Tag->image($path);
   }
   else {
     return $path;
   }
 }

}
EOR

UserTag captcha Documentation <<EOD
=head1 NAME

Interchange [captcha] tag

=head1 SYNOPSIS

 [captcha  function="check|code|image|relative_image|image_tag"
           length="4"
           image-subdir="captcha"
           image-location="images/captcha"
           image-path="/standard/images/captcha"
           source="[cgi mv_captcha_source]"
           error-name="captcha"
           guess="[cgi mv_captcha_guess]"
       ]

=head1 DESCRIPTION

This tag generates and/or checks "captcha" images to authenticate user input.
If called for the first time in a page, it generates a code/image pair and
sets the code in the session (at $Vend::Session->{captcha}).

There are several functions.

=over 4

=item check

Checks the captcha source code (presumably from the previous page) against
the guess. If it matches, returns 1. If not, returns 0 and puts error
in $Tag->error.

=item code

Returns the generated code. Generates one if not done previously in session.

=item image

Returns an IMG tag as generated by Interchange's [image] tag. If the
name-only=1 option is passed, no surrounding IMG tag will be generated,
only the image name. If the C<relative=1> option is passed, that name
will not be prefaced with the ImageDir.

=back

The additional options are:

=over 4

=item guess 

The input from the user when the function is C<check>. Default is the
contents of [cgi mv_captcha_guess].

=item image-subdir

The image subdirectory (based in images directory) which will
be used.

=item image-path

The base path for URL generation. Default is the Interchange IMAGE_DIR
variable.

=item image-location

The directory where image files will be generated. Default is the
Interchange IMAGE_DIR variable based in the Interchange DOCROOT
variable, with the subdirectory above, i.e. C<[var DOCROOT][var IMAGE_DIR]/captcha>.

=item length

Length of the input for the captcha. Default is 4 characters.

=item name-only 

When set, tells the image function to not generate an HTML IMG tag.

=item relative 

When set, tells the image function (when in name-only mode) to
return relative path.

=item reset 

Normally only one captcha code / image will be generated per page
transaction. If this is set, you can generate another one -- though
you would have to take care of saving the generated code yourself,
as $Session->{captcha} is overwritten.

=item source 

The captcha base to guess against for the C<check> function. Default is the
contents of the last-generated captcha, or [cgi mv_captcha_source].

=back

=head1 EXAMPLE

 [if cgi mv_captcha_guess]
   [tmp good][captcha check][/tmp]
   [if scratch good]
     You guessed right!
   [else]
     Sorry, try again.
   [/else]
   [/if]
   <br>
 [/if]

 [captcha function=image]

 <form action="[process href="tags/captcha"]">
 <input type=text name=mv_captcha_guess size value="">
 <input type=submit value="Guess">
 </form>

 [error auto=1]

=head1 PREREQUISITES

Authen::Captcha

=head1 AUTHOR

Mike Heins, <mike AT THE DOMAIN perusion.com>.

EOD