view release on metacpan or  search on metacpan

lib/DemoGuestBook.pm  view on Meta::CPAN

=head2 Perl Version

	5.004

=head2 Standard Modules

	Fcntl
	Symbol
	Net::SMTP 2.15 (earlier versions may work)

=head2 Nonstandard Modules

	CGI::Portable 0.50
	CGI::Portable::AppStatic 0.50
	CGI::MultiValuedHash 1.09
	HTML::FormTemplate 2.021

=cut

######################################################################

use Fcntl qw(:DEFAULT :flock);
use Symbol;
use CGI::Portable 0.50;
use CGI::Portable::AppStatic 0.50;
@ISA = qw(CGI::Portable::AppStatic);
use CGI::MultiValuedHash 1.09;
use HTML::FormTemplate 2.021;

######################################################################

=head1 SYNOPSIS

=head2 Use Default Question

	#!/usr/bin/perl
	use strict;
	use warnings;

	require CGI::Portable;
	my $globals = CGI::Portable->new();

	use Cwd;
	$globals->file_path_root( cwd() );  # let us default to current working dir
	$globals->file_path_delimiter( $^O=~/Mac/i ? ":" : $^O=~/Win/i ? "\\" : "/" );

	require CGI::Portable::AdapterCGI;
	my $io = CGI::Portable::AdapterCGI->new();
	$io->fetch_user_input( $globals );

	$globals->default_application_title( 'Demo Guest Book' );
	$globals->default_maintainer_name( 'Tony Simons' );
	$globals->default_maintainer_email_address( 'tony@aardvark.net' );

	my %CONFIG = (
		fn_messages => 'guestbook_messages.txt',  # file in simple Boulder format
	);

	$globals->current_user_path_level( 1 );
	$globals->set_prefs( \%CONFIG );
	$globals->call_component( 'DemoGuestBook' );

	$io->send_user_output( $globals );

	1;

=head2 Use Custom Questions Defined Here

	my %CONFIG = (
		fn_messages => 'guestbook_messages.txt',  # file in simple Boulder format
		custom_fd => 1,
		field_defn => [
			{
				visible_title => "What's your age?",
				type => 'textfield',
				name => 'age',
				is_required => 1,
				validation_rule => '\d',
				error_message => 'You must enter a number.',
			}, {
				visible_title => "What's the combination?",
				type => 'checkbox_group',
				name => 'words',
				'values' => ['eenie', 'meenie', 'minie', 'moe'],
				default => ['eenie', 'minie'],
				labels => [qw( This That And Another )],
			}, {
				visible_title => "Who do you love?",
				type => 'textfield',
				name => 'name',
			}, {
				visible_title => "What's your favorite colour?",
				type => 'popup_menu',
				name => 'color',
				'values' => ['red', 'green', 'blue', 'chartreuse'],
			},
		],
	);

=head2 Use Custom Questions Defined In Perl File

	my %CONFIG = (
		fn_messages => 'guestbook_messages.txt',  # file in simple Boulder format
		custom_fd => 1,
		field_defn => 'guestbook_questions.txt',  # do Perl code to make array ref
	);

=head2 Use Custom Questions Defined In simple Boulder File

	my %CONFIG = (
		fn_messages => 'guestbook_messages.txt',  # file in simple Boulder format
		custom_fd => 1,
		field_defn => 'guestbook_questions.txt',  # file in simple Boulder format
		fd_in_seqf => 1,
	);

=head2 Default To Signing Mode When Mode Not Specified In User Path

	my %CONFIG = (
		fn_messages => 'guestbook_messages.txt',

lib/DemoGuestBook.pm  view on Meta::CPAN

		$TOKEN_SIGN => $globals->url_as_string( $VRP_SIGN ),
		$TOKEN_READ => $globals->url_as_string( $VRP_READ ),
	} );
}

######################################################################

sub get_field_definitions {
	my $self = shift( @_ );
	my @field_definitions = ();

	push( @field_definitions, 
		{
			visible_title => "Your Name",
			type => 'textfield',
			name => $FFN_NAMEREAL,
			size => 30,
			is_required => 1,
			error_message => 'You must enter your name.',
			exclude_in_echo => 1,
		}, {
			visible_title => "Your E-mail",
			type => 'textfield',
			name => $FFN_EMAIL,
			size => 30,
			is_required => 1,
			validation_rule => '\S\@\S',
			help_message => 'E-mails are in the form "user@domain".',
			error_message => 'You must enter your e-mail.',
			exclude_in_echo => 1,
		}, {
			visible_title => "Keep A Copy",
			type => 'checkbox',
			name => $FFN_WANTCOPY,
			nolabel => 1,
			help_message => "If checked, a copy of this message is e-mailed to you.",
			exclude_in_echo => 1,
		}, 
	);

	push( @field_definitions, @{$self->get_question_field_defs()} );

	push( @field_definitions, 
		{
			type => 'submit', 
			label => 'Post',
		}, {
			type => 'reset', 
			label => 'Clear',
		},
	);

	return( \@field_definitions );
}

######################################################################

sub get_question_field_defs {
	my $self = shift( @_ );
	my $globals = $self->{$KEY_SITE_GLOBALS};
	my $rh_prefs = $globals->get_prefs_ref();
	
	# check if we are using default or custom questions
	unless( $rh_prefs->{$PKEY_CUSTOM_FD} ) {
		return( \@DEF_FORM_QUESTIONS );  # using default
	}
	
	my $field_defn = $rh_prefs->{$PKEY_FIELD_DEFN};
	
	# check if we have actual custom questions or filename to them
	# check if question file is executable Perl or not
	unless( $rh_prefs->{$PKEY_FD_IN_SEQF} ) {  # it is Perl file
		return( $globals->resolve_prefs_node_to_array( $field_defn ) );
	}
	
	# we will now get questions from a simple Boulder formatted file
	return( $self->fetch_all_records( $field_defn ) || [] );
}

######################################################################

sub no_questions_error {
	my $self = shift( @_ );
	my $globals = $self->{$KEY_SITE_GLOBALS};

	$globals->page_title( "Error Starting GuestBook" );

	$globals->set_page_body( <<__endquote );
<h1>@{[$globals->page_title()]}</h1>

<p>I'm sorry, but an error has occurred while trying to start 
the Guest Book.  We are missing critical settings information 
that is required to operate.  Specifically, we don't know what 
questions we are supposed to ask you.  Here are some details about 
what caused this problem:</p>

<p>@{[$globals->get_error()]}</p>

@{[$self->get_amendment_message()]}
__endquote
}

######################################################################

sub is_in_signing_mode {
	my ($self, $form) = @_;
	my $globals = $self->{$KEY_SITE_GLOBALS};
	my $raw_mode = $globals->current_user_path_element();
	$raw_mode eq $VRP_SIGN and return( 1 );
	$raw_mode eq $VRP_READ and return( 0 );
	return( $globals->pref( $PKEY_SIGN_BY_DEFAULT ) );
}

######################################################################

sub read_guest_book {
	my ($self, $form) = @_;
	my $globals = $self->{$KEY_SITE_GLOBALS};

	my $filename = $globals->pref( $PKEY_FN_MESSAGES );
	my @message_list = $self->fetch_all_records( $filename, 1 );

	if( my $err_msg = $globals->get_error() ) {
		$globals->page_title( "Error Reading GuestBook Postings" );

		$globals->set_page_body( <<__endquote );
<h1>@{[$globals->page_title()]}</h1>

<p>I'm sorry, but an error has occurred while trying to read the 
existing guest book messages from the log file, meaning that I can't 
show you any.</p>

<p>details: $err_msg</p>