# 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 {
	    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="@@MV_PAGE@@"]">
	<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
