The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
#
# TODO: Add unit tests for this example.
#
# This program is designed as corporate store-locator.
#
# It can be called in one of three ways:  as a form, where values can be
# entered to search for in the database; as an error page when an error
# condition occurs (for example, no matches); and as a list of matching
# records.

use CGI                  qw( :standard );
use Text::TagTemplate qw( :standard :config );
use strict;
use 5.004;
use CGI::Carp qw( fatalsToBrowser );
use English;

# Config (for anything more than trivial applications, I usually put this in
# another file and `require' it in).
sub HTML_DIR() { '../html'            }
sub DATAFILE() { '../data/stores.txt' }

# Find the templates.  Which templates we use depends on what call-type we
# have.
my $call_type = path_info;
$call_type =~ s/[^a-z]//g;
$call_type = 'default' unless $call_type;

my @errors = ();
if ( $call_type eq 'default' ) {
	# Don't need to do much, just display the correct template.
	
	# We'll help them by making them a convenient tag for the start of the
	# form, with the URL including the path info we're going to use.
	add_tag(
		START_FORM => start_form(
			-action => "http://@{[ server_name ]}:"
			         . "@{[ server_port ]}@{[ script_name ]}/"
				 . "search"
		)
	);

} elsif ( $call_type eq 'search' ) {
	# See which values we have to search on.

	SEARCH : {
		# Firstly, we need to open the data file and read in the first
		# line so we know what fields we can search.
		open DATA, DATAFILE or die "open @{[ DATAFILE ]} failed: $ERRNO";
		my $fields = <DATA>;
		chomp $fields;

		my @fields = split /\|/, $fields;

		# Now we find the fields supplied to us that match the fields
		# in the database and assume they're the search functions.
		my %params = map { $ARG => 1 } param;
		my %search = ();
		foreach my $field ( @fields ) {
			$search{ $field } = param( $field )
			   if exists $params{ $field };
		}

		unless ( %search ) {
			push @errors, 'No search parameters supplied.';
			last SEARCH;
		}

		# Now we search through the database looking for matches.
		my $line;
		my @matched_lines = ();
		while ( defined( $line = <DATA> ) ) {
			chomp $line;
			my @line = split /\|/, $line;
			my %line = ();
			for ( my $f = 0; $f < @fields; ++$f ) {
				$line{ $fields[ $f ] } = $line[ $f ];
				}
			my $matched = 0;
			foreach my $search_field ( keys %search ) {
				$matched = 1
				   if $search{ $search_field }
				   =~ /^\Q$line{ $search_field }\E$/i;
			}
			push @matched_lines, \%line if $matched;
		}

		if ( @matched_lines == 0 ) {
			push @errors, 'No records matched your query.';
			last SEARCH;
		}

		# Set the list of elements to the matches (we'd
		# probably sort it first if we were being tidy).
		list( @matched_lines );

		# Now we build the parsed list.  Firstly, we make the callback.
		entry_callback( sub {
			my( $line ) = @_;
			my $tags = +{};
			foreach my $field ( keys %$line ) {
				$tags->{ $field } = $line->{ $field };
			}
			return $tags;
		} );

		entry_file( HTML_DIR . '/search-entry.htmlf' );
		join_file(  HTML_DIR . '/search-join.htmlf'  );
		# We have the fragment files.  We just need to make
		# a new tag with the list.
		add_tag( RESULTS_LIST => parse_list_files );
		close DATA or die "close DATA failed: $ERRNO";
	}
}

if ( @errors ) {
	$call_type = 'error';
	list( @errors );
	entry_callback( sub {
		my( $error ) = @_;
		my $tags = +{};
		$tags->{ ERROR } = $error;
		return $tags;
	} );
	entry_file( HTML_DIR . '/error-entry.htmlf' );
	join_file(  HTML_DIR . '/error-join.htmlf'  );
	add_tag( ERROR_LIST => parse_list_files );
}

my $filename = HTML_DIR . "/$call_type.html";
# Just print a Content-type and the parsed template now.
print header;
print parse_file( $filename );