example/modules/TemplateToolkit.pm

#=======================================================================
#  Module for using Template-Toolkit for generating output
#    $Id: TemplateToolkit.pm,v 1.2 2001/12/08 21:48:00 whmoseley Exp $
#
#=======================================================================
package TemplateToolkit;
use strict;

use Template;
use vars '$Template';


sub show_template {
    my ( $class, $template_params, $results ) = @_;

    my $cgi = $results->CGI;


    #/* Cached if running under mod_perl */
    $Template ||= Template->new( $template_params->{options} );


    die $Template->error() unless $Template;


    print $cgi->header;

    my $subclass = TemplateToolkit::Helpers->new( $results );

    my $vars = {
        search  => $subclass,
        CGI     => $results->CGI,
    };

    $Template->process( $template_params->{file}, $vars )
        || die "Template process failed for page '$template_params->{file}' ", $Template->error(), "\n";
}


#==================================================================
#  Form setup for sorts and metas
#
#  This could be methods of $results object
#  (and then available for Template-Toolkit)
#  But that's too much HTML in the object, perhaps.
#
#
#==================================================================
package TemplateToolkit::Helpers;
use strict;

sub new {
    my ( $class, $results ) = @_;


    @TemplateToolkit::Helpers::ISA = ref $results;  # that doesn't look right.

    return bless $results, $class;
}

sub get_meta_name_limits {
    my ( $results ) = @_;

    my $metanames = $results->config('metanames');
    return '' unless $metanames;

    
    my $name_labels = $results->config('name_labels');
    my $q = $results->CGI;


    return join "\n",
        'Limit search to:',
        $q->radio_group(
            -name   =>'metaname',
            -values => $metanames,
            -default=>$metanames->[0],
            -labels =>$name_labels
        ),
        '<br>';
}

sub get_sort_select_list {
    my ( $results ) = @_;

    my $sort_metas = $results->config('sorts');
    return '' unless $sort_metas;

    
    my $name_labels = $results->config('name_labels');
    my $q = $results->CGI;


    return join "\n",
        'Sort by:',
        $q->popup_menu(
            -name   =>'sort',
            -values => $sort_metas,
            -default=>$sort_metas->[0],
            -labels =>$name_labels
        ),
        $q->checkbox(
            -name   => 'reverse',
            -label  => 'Reverse Sort'
        );
}


sub get_index_select_list {
    my ( $results ) = @_;
    my $q = $results->CGI;


    my $indexes = $results->config('swish_index');
    return '' unless ref $indexes eq 'ARRAY';

    my $select_config = $results->config('select_indexes');
    return '' unless $select_config && ref $select_config eq 'HASH';


    # Should return a warning, as this might be a likely mistake
    # This jumps through hoops so that real index file name is not exposed
    
    return '' unless exists $select_config->{labels}
              && ref $select_config->{labels} eq 'ARRAY'
              && @$indexes == @{$select_config->{labels}};


    my @labels = @{$select_config->{labels}};
    my %map;

    for ( 0..$#labels ) {
        $map{$_} = $labels[$_];
    }

    my $method = $select_config->{method} || 'checkbox_group';
    my @cols = $select_config->{columns} ? ('-columns', $select_config->{columns}) : ();

    return join "\n",
        '<br>',
        ( $select_config->{description} || 'Select: '),
        $q->$method(
        -name   => 'si',
        -values => [0..$#labels],
        -default=> 0,
        -labels => \%map,
        @cols );
}


sub get_limit_select {
    my ( $results ) = @_;
    my $q = $results->CGI;


    my $limit = $results->config('select_by_meta');
    return '' unless ref $limit eq 'HASH';

    my $method = $limit->{method} || 'checkbox_group';

    my @options = (
        -name   => 'sbm',
        -values => $limit->{values},
        -labels => $limit->{labels} || {},
    );

    push @options, ( -columns=> $limit->{columns} ) if $limit->{columns};
    

    return join "\n",
        '<br>',
        ( $limit->{description} || 'Select: '),
        $q->$method( @options );
}

sub stopwords_removed {
    my $results = shift;
    
    my $swr = $results->header('removed stopwords');
    my $stopwords = '';


    if ( $swr && ref $swr eq 'ARRAY' ) {
        $stopwords = @$swr > 1
        ? join( ', ', map { "<b>$_</b>" } @$swr ) . ' are very common words and were not included in your search'
        : join( ', ', map { "<b>$_</b>" } @$swr ) . ' is a very common word and was not included in your search';
    }

    return $stopwords;
}


1;

1	adcroft	1.1	#=======================================================================
2			# Module for using Template-Toolkit for generating output
3			# $Id: TemplateToolkit.pm,v 1.2 2001/12/08 21:48:00 whmoseley Exp $
4			#
5			#=======================================================================
6			package TemplateToolkit;
7			use strict;
8
9			use Template;
10			use vars '$Template';
11
12
13			sub show_template {
14			my ( $class, $template_params, $results ) = @_;
15
16			my $cgi = $results->CGI;
17
18
19			#/* Cached if running under mod_perl */
20			$Template \|\|= Template->new( $template_params->{options} );
21
22
23			die $Template->error() unless $Template;
24
25
26			print $cgi->header;
27
28			my $subclass = TemplateToolkit::Helpers->new( $results );
29
30			my $vars = {
31			search => $subclass,
32			CGI => $results->CGI,
33			};
34
35			$Template->process( $template_params->{file}, $vars )
36			\|\| die "Template process failed for page '$template_params->{file}' ", $Template->error(), "\n";
37			}
38
39
40			#==================================================================
41			# Form setup for sorts and metas
42			#
43			# This could be methods of $results object
44			# (and then available for Template-Toolkit)
45			# But that's too much HTML in the object, perhaps.
46			#
47			#
48			#==================================================================
49			package TemplateToolkit::Helpers;
50			use strict;
51
52			sub new {
53			my ( $class, $results ) = @_;
54
55
56			@TemplateToolkit::Helpers::ISA = ref $results; # that doesn't look right.
57
58			return bless $results, $class;
59			}
60
61			sub get_meta_name_limits {
62			my ( $results ) = @_;
63
64			my $metanames = $results->config('metanames');
65			return '' unless $metanames;
66
67
68			my $name_labels = $results->config('name_labels');
69			my $q = $results->CGI;
70
71
72			return join "\n",
73			'Limit search to:',
74			$q->radio_group(
75			-name =>'metaname',
76			-values => $metanames,
77			-default=>$metanames->[0],
78			-labels =>$name_labels
79			),
80			'<br>';
81			}
82
83			sub get_sort_select_list {
84			my ( $results ) = @_;
85
86			my $sort_metas = $results->config('sorts');
87			return '' unless $sort_metas;
88
89
90			my $name_labels = $results->config('name_labels');
91			my $q = $results->CGI;
92
93
94
95			return join "\n",
96			'Sort by:',
97			$q->popup_menu(
98			-name =>'sort',
99			-values => $sort_metas,
100			-default=>$sort_metas->[0],
101			-labels =>$name_labels
102			),
103			$q->checkbox(
104			-name => 'reverse',
105			-label => 'Reverse Sort'
106			);
107			}
108
109
110
111
112			sub get_index_select_list {
113			my ( $results ) = @_;
114			my $q = $results->CGI;
115
116
117			my $indexes = $results->config('swish_index');
118			return '' unless ref $indexes eq 'ARRAY';
119
120			my $select_config = $results->config('select_indexes');
121			return '' unless $select_config && ref $select_config eq 'HASH';
122
123
124			# Should return a warning, as this might be a likely mistake
125			# This jumps through hoops so that real index file name is not exposed
126
127			return '' unless exists $select_config->{labels}
128			&& ref $select_config->{labels} eq 'ARRAY'
129			&& @$indexes == @{$select_config->{labels}};
130
131
132			my @labels = @{$select_config->{labels}};
133			my %map;
134
135			for ( 0..$#labels ) {
136			$map{$_} = $labels[$_];
137			}
138
139			my $method = $select_config->{method} \|\| 'checkbox_group';
140			my @cols = $select_config->{columns} ? ('-columns', $select_config->{columns}) : ();
141
142			return join "\n",
143			'<br>',
144			( $select_config->{description} \|\| 'Select: '),
145			$q->$method(
146			-name => 'si',
147			-values => [0..$#labels],
148			-default=> 0,
149			-labels => \%map,
150			@cols );
151			}
152
153
154			sub get_limit_select {
155			my ( $results ) = @_;
156			my $q = $results->CGI;
157
158
159			my $limit = $results->config('select_by_meta');
160			return '' unless ref $limit eq 'HASH';
161
162			my $method = $limit->{method} \|\| 'checkbox_group';
163
164			my @options = (
165			-name => 'sbm',
166			-values => $limit->{values},
167			-labels => $limit->{labels} \|\| {},
168			);
169
170			push @options, ( -columns=> $limit->{columns} ) if $limit->{columns};
171
172
173			return join "\n",
174			'<br>',
175			( $limit->{description} \|\| 'Select: '),
176			$q->$method( @options );
177			}
178
179			sub stopwords_removed {
180			my $results = shift;
181
182			my $swr = $results->header('removed stopwords');
183			my $stopwords = '';
184
185
186			if ( $swr && ref $swr eq 'ARRAY' ) {
187			$stopwords = @$swr > 1
188			? join( ', ', map { "<b>$_</b>" } @$swr ) . ' are very common words and were not included in your search'
189			: join( ', ', map { "<b>$_</b>" } @$swr ) . ' is a very common word and was not included in your search';
190			}
191
192			return $stopwords;
193			}
194
195
196
197			1;
198