File Coverage

blib/lib/Text/Merge.pm
Criterion Covered Total %
statement 235 317 74.1
branch 89 170 52.3
condition 147 305 48.2
subroutine 30 37 81.0
pod 8 34 23.5
total 509 863 58.9


line stmt bran cond sub pod time code
1             #!/usr/local/bin/perl -Tw
2 20     20   9908 use strict;
  20         35  
  20         2636  
3              
4             #
5             # Text::Merge.pm - v.0.36 BETA
6             #
7             # (C)1997-2004 by Steven D. Harris.
8             #
9             # This software is released under the Perl Artistic License
10             #
11              
12             =head1 NAME
13              
14             Text::Merge - v.0.36 General purpose text/data merging methods in Perl.
15              
16             =head1 SYNOPSIS
17              
18             $merge = new Text::Merge;
19              
20             $merge->line_by_line(); # query
21             $merge->line_by_line(0); # turn off
22             $merge->line_by_line(1); # turn on
23              
24             $merge->set_delimiters('<<', '>>'); # user defined delims
25              
26             $success = $merge->publish($template, \%data);
27             $success = $merge->publish($template, \%data, \%actions);
28             $success = $merge->publish($template, $item);
29              
30             $success = $merge->publish_to($handle, $template, \%data);
31             $success = $merge->publish_to($handle, $template, \%data, \%actions);
32             $success = $merge->publish_to($handle, $template, $item);
33              
34             $text = $merge->publish_text($template, \%data);
35             $text = $merge->publish_text($template, \%data, \%actions);
36             $text = $merge->publish_text($template, $item);
37              
38             $success = $merge->publish_email($mailer, $headers, $template, \%data);
39             $success = $merge->publish_email($mailer, $headers, $template,
40             \%data, \%actions);
41             $success = $merge->publish_email($mailer, $headers, $template, $item);
42              
43             $datahash = $merge->cgi2data(); # if you used "CGI(:standard)"
44             $datahash = $merge->cgi2data($cgi); # if you just used CGI.pm
45              
46              
47             =head1 DESCRIPTION
48              
49             The C package is designed to provide a quick, versatile, and extensible way to combine presentation
50             templates and data structures. The C package attempts to do this by assuming that templates are
51             constructed with text and that objects consist of data and functions that operate on that data. C
52             is very simple, in that it works on one file and one object at a time, although an extension exists to display
53             lists (C) and C itself could easily be extended further.
54              
55             This is not XML and is intended merely to "flatten" the learning curve for non-programmers who design display
56             pages for programmers or to provide programmers with a quick way of merging page templates with data sets or
57             objects without extensive research.
58              
59             The templates can be interpreted "line by line" or taken as a whole.
60              
61              
62             =head2 Technical Details
63              
64             This object is normally inherited and so the new() function is the constructor. It just blesses an
65             anonymous HASH reference, sets two flags within that HASH, and returns it. I'm am acutely aware
66             of the criticisms of the overuse of OOP (Object Oriented Programming). This module needs to be OO
67             because of its extensibility and encapsulation; I wanted to impose classification of the objects to allow
68             the greatest flexibility in context of implementation. C is generally used on web servers, and
69             can become integrated quickly into the httpd using mod_perl, hence the encapsulation and inheritance provided
70             by the Perl OO model clearly outweighed the constraints thereby imposed. That's my excuse...what's yours?
71              
72             There are four public methods for the C object: C, C, C,
73             C. The first, C, sends output to the currently selected file handle (normally
74             STDOUT). The second method, C, returns the merged output as a text block. The last method,
75             C, sends the merged output as a formatted e-mail message to the designated mailer.
76              
77             Support is provided to merge the data and the functions performed on that data with a text template that
78             contains substitution tag markup used to designate the action or data conversion. Data is stored in a HASH
79             that is passed by reference to the publishing methods. The keys of the data hash correspond to the field
80             names of the data, and they are associated with their respective values. Actions (methods) are similarly
81             referenced in a hash, keyed by the action name used in the template.
82              
83             Here is a good example of a publishing call in Perl:
84              
85             $obj = new Text::Merge;
86             %data = ( 'Name'=>'John Smith', 'Age'=>34, 'Sex'=>'not enough' );
87             %actions = ( 'Mock' => \&mock_person, 'Laud' => \&laud_person );
88             $obj->publish($template, \%data, \%actions);
89              
90             In this example, C and C would be subroutines that took a single hash reference,
91             the data set, as an argument. In this way you can create dynamic or complex composite components and reference
92             them with a single tag in the template. The actions HASH has been found to be useful for default constructs
93             that can be difficult to code manually, giving page designers an option to work with quickly.
94              
95              
96             =head2 Markup Tags
97              
98             Simply put, tags are replaced with what they designate. A tag generally consists of a prefix, followed by a
99             colon, then either an action name or a field name followed by zero or more formatting directives seperated
100             by colons. In addition, blocks of output can be contained within curly brackets
101             in certain contexts for conditional display.
102              
103             =over 4
104              
105             =item REF: tags
106              
107             Simple data substitution is achieved with the C tag. Here is an example of the use of a C tag
108             in context, assume we have a key-value pair in our data HASH associating the key 'Animal' with the value of
109             'turtle':
110              
111             The quick brown REF:Animal jumped over the lazy dog.
112              
113             when filtered, becomes:
114              
115             The quick brown turtle jumped over the lazy dog.
116              
117             The C tag designators may also contain one or more format directives. These are chained left
118             to right, and act to convert the data before it is displayed. For example:
119              
120             REF:Animal:lower:trunc3
121              
122             would result in the first three letters of the SCALAR data value associated with Animal in lower case. See
123             the section, C, for a list of the available SCALAR data formatting directives. Note
124             that some conversions may be incompatible or contradictory. The system will not necessarily warn you of such
125             cases, so be forewarned.
126              
127             Any C tag designator can be surrounded by curly brace pairs containing text that would be included in the
128             merged response only if the result of the designator is not empty (has a length). There must be no spaces between
129             the tag and the curly braced text. If line-by-line mode is turned off, then the conditional text block may span
130             multiple lines. For example:
131              
132             The {quick brown }REF:Animal{ jumps over where the }lazy dog lies.
133              
134             Might result in:
135              
136             The quick brown fox jumps over where the lazy dog lies.
137              
138             or, if the value associated with the data key 'Animal' was undefined, empty, or zero:
139              
140             The lazy dog lies.
141              
142              
143             =item IF: tags
144              
145             The C tag designators performs a conditional display. The syntax is as follows:
146              
147             IF:FieldName:formats{Text to display}
148              
149             This designator would result in the string B being returned if the formatted data value is
150             not empty. The curly braced portion is required, and no curly braces are allowed before the designator.
151              
152              
153             =item NEG: tags
154              
155             The C tag designator is similar to the C tag, but the bracketed text is processed only if the
156             formatted data value is empty (zero length) or zero. Effectively the C can be thought of as B.
157             Here is an example:
158              
159             NEG:FieldName:formats{Text to display if the result is empty.}
160              
161              
162             =item ACT: tags
163              
164             The C tag designates that an action is to be performed (a subroutine call) to obtain the result for
165             substition. The key name specified in the designator is used to look up the reference to the appropriate
166             subroutine, and the data HASH reference is passed as the sole argument to that subroutine. The returned
167             value is the value used for the substition.
168              
169             C is intended to be used to insert programmatic components into the document. It can only specify
170             action key names and has no equivalent tags to C and C. The curly brace rules for the C
171             tag are exactly the same as those for the C tag.
172              
173              
174             =item Conditional Text Braces
175              
176             All tags support conditional text surrounded by curly braces. If the C switch is set, then
177             the entire tag degignator must be on a single line of text, but if the switch is OFF (default) then the
178             conditional text can span multiple lines.
179              
180             The two conditional tags, C and C, require a single conditional text block, surrounded by curly
181             braces, immediately following (suffixing) the field name or format string. For example:
182              
183             IF:SomeField{this text will print}
184              
185             The C and C tags allow for curly braces both at the beginning (prefixing) and at the end
186             (suffixing). For example:
187              
188             {Some optional text }REF:SomeValue{ more text.}
189              
190              
191             =item Command Braces
192              
193             You may bracket entire constructs (along with any conditional text) with double square brackets to set them
194             off from the rest of the document. The square brackets would be removed during substitution:
195              
196             The [[IF:VerboseVar{quick, brown }]]fox jumped over the lazy dog.
197              
198             assuming that 'VerboseVar' represented some data value, the above example would result in one of:
199              
200             The quick, brown fox jumped over the lazy dog.
201             or
202             The fox jumped over the lazy dog.
203              
204              
205             =item Data Conversion Formats
206              
207             Here is a list of the data conversion format and the a summary. Details are undetermined in some cases for
208             exceptions, but all of the conversion to some satisfactory degree. These conversion methods will treat all
209             values as SCALAR values:
210              
211             upper - converts all lowercase letters to uppercase
212             lower - converts all uppercase letters to lower
213             proper - treats the string as a Proper Noun
214             trunc## - truncate the scalar to ## characters (## is an integer)
215             words## - reduce to ## words seperated by spaces (## is an integer)
216             paragraph## - converts to a paragraph ## columns wide
217             indent## - indents plain text ## spaces
218             int - converts the value to an integer
219             float - converts the value to a floating point value
220             string - converts the numeric value to a string (does nothing)
221             detab - replaces tabs with spaces, aligned to 8-char columns
222             html - replaces newlines with HTML B
tags
223             dollars - converts the value to 2 decimal places
224             percent - converts the value to a percentage
225             abbr - converts a time value to m/d/yy format
226             short - converts a time value to m/d/yy H:MMpm format
227             time - converts a time value to H:MMpm (localtime am/pm)
228             24h - converts a time value to 24hour format (localtime)
229             dateonly - converts a time value to Jan. 1, 1999 format
230             date - same as 'dateonly' with 'time'
231             ext - converts a time value to extended format:
232             Monday, Januay 12th, 1999 at 12:20pm
233             unix - converts a time value to UNIX date string format
234             escape - performs a browser escape on the value ({)
235             unescape - performs a browser unescape (numeric only)
236             urlencode - performs a url encoding on the value (%3B)
237             urldecode - performs a url decoding (reverse of urlencode)
238              
239             Most of the values are self-explanatory, however a few may need explanation:
240            
241             The C format must be suffixed with an integer digit to define at most
242             how many characters should be displayed, as in C.
243              
244             The C format just inserts a
construct at every newline in the
245             string. This allows text to be displayed appropriately in some cases.
246              
247             The C format performs an HTML escape on all of the reserved characters
248             of the string. This allows values to be displayed correctly on browsers in
249             most cases. If your data is not prefiltered, it is usually a good idea to
250             use B on strings where HTML formatting is prohibited. For example
251             a '$' value would be converted to '$'.
252              
253             The C format does the reverse of an C format, however it
254             does not operate on HTML mnemonic escapes, allowing special characters to
255             remain intact. This can be used to reverse escapes inherent in the use of
256             other packages.
257              
258             The C and C formats either convert a value (text string)
259             to url encoded format, converting special characters to their %xx equivalent,
260             or converting to the original code by decoding %xx characters respectively from
261             the url encoded value.
262              
263             =back
264              
265              
266             =head2 Item Support
267              
268             The publishing methods all require at the very least a template, a data set, and the action set; although
269             either the data set or the action set or both could be empty or null. You may also B this
270             information into a single HASH (suitable for blessing as a class) with the key 'Data' associated with
271             the data HASH reference, and the key 'Actions' associated with the action HASH reference. A restatement of
272             a previous example might look like this:
273              
274             $obj = new Text::Merge;
275             $data = { 'Name'=>'John Smith', 'Age'=>34, 'Sex'=>'not enough' };
276             $actions = { 'Mock' => \&mock_person, 'Laud' => \&laud_person };
277             $item = { 'Data' => $data, 'Actions' => $actions };
278             $obj->publish($template, $item);
279              
280             In addition, if you specify a key 'ItemType' in your C<$item> and give it a value, then the item reference
281             will be handed to any methods invoked by the C tags, rather than just the data hash. This allows
282             you to construct B that can be merged with templates. For example, the following code is valid:
283              
284             %data = ( 'Author' => 'various', 'Title' => 'The Holy Bible' );
285             %actions = ( 'Highlight' => \&highlight_item );
286             $item = { 'ItemType'=>'book', 'Data'=>\%data, 'Actions'=>\%actions };
287             bless $item, Some::Example::Class;
288             $obj->publish($template, $item);
289              
290             In this last example, the designator C would result in the object C<$item> being passed
291             as the only argument to the subroutine C referenced in the action HASH.
292              
293              
294             =head2 Line by Line Mode
295              
296             By default, the publishing methods slurp in the entire template and process it as a text block. This
297             allows for multi-line conditional text blocks. However, in some cases the resulting output may be very
298             large, or you may want the output to be generated line by line for some other reason (such as unbuffered
299             output). This is accomplished through the C method, which accepts an optional boolean value,
300             which sets the current setting if specified or returns the current settingif not. Note that this has the
301             most notable impact on the C and C methods, since the results of the merge operations
302             are sent to a handle. If the line by line switch is set, then the C method will substitute line
303             by line, but will still return the entire merged document as a single text block (not line by line).
304              
305             This is turned OFF by default.
306              
307              
308             =head2 Templates
309              
310             Templates consist of text documents that contain special substitution designators as described previously. The
311             template arguments passed to the publishing functions can take one of three forms:
312              
313             =over 4
314              
315             =item File Handle
316              
317             This is a FileHandle object not a glob. You must use the C package that comes with the Perl distribution
318             for this type of template argument. Processing begins at the current file position and continues until the end of
319             file condition is reached.
320              
321             =item File Path
322              
323             If the argument is a scalar string with no whitespace, it is assumed to be a file path. The template at that
324             location will be used when merging the document.
325              
326             =item Text Block
327              
328             If the argument is a scalar string that contains whitespace, it is assumed to be the actual text template.
329             Substitution will be performed on a locally scoped copy of this argument.
330              
331             Note that you should not use this type of template argument if your template is very large and you
332             are using line by line mode. In this case you should use a FileHandle or file path argument.
333              
334             =back
335              
336             =head2 Methods
337              
338             =over 4
339              
340             =cut
341              
342             package Text::Merge;
343 20     20   19389 use FileHandle;
  20         440625  
  20         130  
344 20     20   41541 use AutoLoader 'AUTOLOAD';
  20         56891  
  20         129  
345              
346             our $NAME = 'Text::Merge';
347             our $VERSION = '0.36';
348              
349             our @mon = qw(Jan. Feb. Mar. Apr. May June July Aug. Sep. Oct. Nov. Dec.);
350             our @month = qw(January February March April May June July August September October November December);
351             our @weekday = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
352             our @hex = map { ($_<16) && '%0'.sprintf('%X',$_) || sprintf('%%%2X',$_) } ( 0..255 );
353              
354             1;
355              
356              
357             =item new()
358              
359             This method gives us a blessed hash reference, with the following attribute keys:
360              
361             _Text_Merge_LineMode
362              
363             Other keys can be added by objects which inherit C.
364              
365             =cut
366             sub new {
367 19     19 1 56475 my $class = shift;
368 19         49 my $ref = {};
369 19         67 $$ref{_Text_Merge_LineMode} = 0;
370 19         55 $$ref{_Text_Merge_Delimiter1} = quotemeta('[[');
371 19         62 $$ref{_Text_Merge_Delimiter2} = quotemeta(']]');
372 19         86 return bless $ref, $class;
373             };
374              
375              
376             =item line_by_line($setting)
377              
378             This method returns the current setting if the C<$setting> argument is omitted. Otherwise it resets the
379             line-by-line mode to the setting requested. A non-zero value tells the publishing methods to process the
380             template line by line. For those methods that output results to a handle, then those results will also be
381             echoed line by line.
382              
383             =cut
384             sub line_by_line {
385 8     8 1 4024 my ($self, $arg) = @_;
386 8 50       77 $$self{_Text_Merge_LineMode}=$arg if defined $arg;
387 8         30 return $$self{_Text_Merge_LineMode};
388             };
389              
390              
391             =item set_delimiters($start, $end)
392              
393             This method assigns a new command delimiter set for the tags (double
394             square brackets by default). The 'colon' character is not allowed within
395             the delimiter, and the delimiter may not be a single curly bracket. Both
396             the C<$start> and C<$end> delimiters must be provided, and they cannot be
397             identical.
398              
399             =cut
400             sub set_delimiters {
401 2     2 1 46838 my ($self, $start, $end) = @_;
402 2 50 33     87 if (!defined $start || !defined $end ||
      66        
      33        
      66        
      33        
403             ($start && !$end) || (!$start && $end)) {
404 0         0 warn "invalid delimiters provided to Text::Merge::set_delimiters().\n";
405 0         0 return 0;
406             };
407 2 50 33     19 if ($start =~ /\:/ || $end =~ /\:/) {
408 0         0 warn "The 'colon' character (:) is not allowed in Text::Merge delimiters.\n";
409             };
410 2 50 33     29 if ($start =~ /^[\{\}]$/ || $end =~ /^[\{\}]$/) {
411 0         0 warn "Neither primary Text::Merge delimiter can be a curly bracket ({) or (}) in Text::Merge::set_delimiters().\n";
412             }
413 2 50 66     13 if ($start && !($start cmp $end)) {
414 0         0 warn "The start and end Text::Merge delmiters must differ in set_delimiters().\n";
415             };
416 2         19 $$self{_Text_Merge_Delimiter1} = quotemeta($start);
417 2         7 $$self{_Text_Merge_Delimiter2} = quotemeta($end);
418             };
419              
420              
421             #
422             # This is the core filtering engine. It consists of:
423             # text_process() - this method
424             # handle_cond() - for conditional text blocks
425             # convert_value() - for the formatting of values
426             # and assorted subordinate methods to convert_value()
427             #
428             sub text_process {
429 402     402 0 15099 my ($self, $text, $item) = @_;
430 402         607 my $ret = $text;
431 402         870 my ($open, $close) =
432             ($$self{_Text_Merge_Delimiter1},$$self{_Text_Merge_Delimiter2});
433 402 50       855 defined $open || ($open = '\[\[');
434 402 50       676 defined $close || ($close = '\]\]');
435 402 50       795 if (!$item) { warn "Improper call to text_process() in $0. no item.\n"; return $ret; };
  0         0  
  0         0  
436 402 50       687 if (!$ret) { warn "Improper call to text_process() in $0. no text.\n"; return $ret; };
  0         0  
  0         0  
437 402 100 33     4888 $ret && $ret =~ s/$open({(?:[^\{\}]*)\}(?:REF\:|ACT\:)|IF\:|NEG\:)(\w+(?:\:\w+)*)?\{((?:[^\}]|\}(?!$close))*)\}$close/$self->
  317   66     903  
438             handle_cond($1,$2,$3,$item)/eg if $open && $close;
439 402 50       1428 $ret && $ret =~ s/({(?:[^\{\}]*)\}(?:REF\:|ACT\:)|IF\:|NEG\:)(\w+(?:\:\w+)*)?\{([^\{\}]*)\}/$self->
  365         870  
440             handle_cond($1,$2,$3,$item)/oeg;
441 402 100 50     3232 $ret && $ret =~ s/$open(REF|ACT)\:(\w+)((?:\:\w+)*)$close/$self->handle_tag($item,$1,$2,($3 || ''))/eg if $open && $close;
  109   33     582  
      66        
442 402 50 100     1556 $ret && $ret =~ s/\b(REF|ACT)\:(\w+)((?:\:\w+)*)\b/$self->handle_tag($item,$1,$2,($3 || ''))/oeg;
  510         2609  
443 402         2245 return $ret;
444             };
445              
446              
447             sub handle_tag {
448 1187     1187 0 2316 my ($self, $item, $tag, $field, $formats) = @_;
449 1187 100       3006 if ($tag eq 'ACT') {
450 114         237 my $text = $self->handle_action($field, $item);
451 114         608 return $text;
452             };
453 1073 100       3037 $formats && $formats =~ s/^\://g;
454 1073   100     5645 my @formats = split(/\:/, ($formats || ''));
455 1073         1099 my $format;
456 1073   100     4184 my $value = $$item{Data}{$field} || '';
457 1073 100 100     3040 $value=$$value[0] if ref $value eq 'ARRAY' && ((scalar @$value)==1);
458 1073         1539 foreach $format (@formats) {
459 380         921 $value = $self->convert_value($value, $format, $item);
460             };
461 1073         4817 return $value;
462             };
463              
464             sub handle_action {
465 114     114 0 157 my ($self, $field, $item) = @_;
466 114   50     327 my $sub = $$item{Actions}{$field} || return '';
467 114   66     515 my $arg = $$item{ItemType} && $item || $$item{Data};
468 114         119 my $result = &{$sub}($arg);
  114         273  
469 114         668 return $result;
470             };
471              
472             # args are: self, {prefix}TAG:, field+formats, suffix
473             sub handle_cond {
474 682     682 0 2065 my ($self, $pretag, $ident, $suffix, $item) = @_;
475 682         1202 my ($value,$prefix,$tag,$cond) = ('','','','');
476 682 100       2217 if ($pretag =~ /^\{(.*)\}(\w+\:)$/s) { $prefix=$1; $tag = $2; }
  234         960  
  234         1145  
477 448         467 else { $prefix = ''; $tag = $pretag; };
  448         518  
478 682 100       1201 if ($pretag !~ /ACT:/) {
479 568         2122 $value = $self->handle_tag($item, $tag, split(/\:/, $ident, 2));
480             } else {
481 114         212 my $func = $$item{Actions}{$ident};
482 114   50     825 $value = $func && &$func($$item{ItemType} && $item || $$item{Data}) || '';
483             };
484 682         2097 $cond = $value;
485 682 100       1877 $tag eq 'NEG:' && ($cond = !$cond);
486 682 100 100     2353 ($tag eq 'NEG:' || $tag eq 'IF:') && ($value = '');
487 682 100 66     2669 if ((defined $cond) && ($cond || length($cond))) { return $prefix.$value.$suffix; }
  458   33     3576  
488 224         1307 else { return ''; };
489             };
490              
491              
492              
493             =item publish($template, $dataref, $actionref)
494              
495             This is the normal publishing method. It merges the specified template with the data and
496             any provided actions. The output is sent to the currently selected handle, normally STDOUT.
497              
498             =cut
499              
500 0     0 1 0 sub publish { my ($self, @args)=@_; return $self->publish_to('',@args); };
  0         0  
501              
502              
503              
504             =item publish_to($handle, $template, $dataref, $actionref)
505              
506             This is similar to the normal publishing method. It merges the specified template with the data
507             and any provided actions. The output is sent to the specified C<$handle> or to the currently
508             selected handle, normally STDOUT, if the C<$handle> argument is omitted.
509              
510             =cut
511              
512             sub publish_to {
513 17     17 1 7220 my ($self, $handle, $template, $data, $actions) = @_;
514 17         37 my ($fh,$line,$item);
515 17 100 66     298 ($$data{Data} || $$data{Actions}) && ($item=$data) || ($item = { 'Data'=>$data, 'Actions'=>$actions });
      66        
516 17 50 66     547 if (!$template) {
    100 33        
    50 66        
517 0         0 my ($pkg, $fname, $lineno, $sname) = caller;
518 0         0 warn "No template provided to ".(ref $self)."->publish_to.\n";
519 0         0 warn "Called by $pkg\:\:$sname, line #$lineno in $fname.\n";
520 0         0 ($pkg, $fname, $lineno, $sname) = caller(1);
521 0         0 warn "Called by $pkg\:\:$sname, line #$lineno in $fname.\n";
522 0         0 return 0;
523             } elsif ($template =~ /\s/s) {
524 3 50       11 if ($handle) {
525 3         18 print $handle $self->text_process($template, $item);
526 0         0 } else { print $self->text_process($template, $item); };
527 3         23 return 1;
528             } elsif ((ref $template) =~ /FileHandle/ && ($fh=$template)
529             || (-f $template) && ($fh = new FileHandle('<'.$template))) {
530 14 100       757 if ($$self{_Text_Merge_LineMode}) {
531 5         120 foreach $_ (<$fh>) {
532 59 50       112 if ($handle) {
533 59         142 print $handle $self->text_process($_, $item);
534 0         0 } else { print $self->text_process($_, $item); };
535             };
536             } else {
537 9 50       630 if ($handle) {
538 9   50     755 print $handle $self->text_process((join('',<$fh>) || ''), $item);
539 0   0     0 } else { print $self->text_process((join('',<$fh>) || ''), $item); };
540             };
541 14 100       216 ($template ne $fh) && $fh->close;
542 14         265 return 1;
543             };
544 0 0       0 if (length($template)>50) { $template = substr($template, -30, 30); };
  0         0  
545 0         0 warn "Illegal template $template provided to ".(ref $self)."->filter.\n";
546 0         0 return 0;
547             };
548              
549              
550              
551             =item publish_text($template, $dataref, $actionref)
552              
553             This method works similar to the C method, except it returns the filtered output as text
554             rather than sending it to the currently selected filehandle.
555              
556             =cut
557              
558             sub publish_text {
559 81     81 1 370 my ($self, $template, $data, $actions) = @_;
560 81         108 my $text = '';
561 81         88 my ($fh,$line,$item,$ref);
562 81 100 66     501 ($$data{Data} || $$data{Actions}) && ($item=$data) || ($item = { 'Data'=>$data, 'Actions'=>$actions });
      66        
563 81 50 66     3323 if (!$template) {
    100 66        
    50 33        
      33        
      33        
      33        
564 0         0 my ($pkg, $fname, $lineno, $sname) = caller;
565 0         0 warn "No template provided to ".(ref $self)."->publish_text.\n";
566 0         0 warn "Called by $pkg\:\:$sname, line #$lineno in $fname.\n";
567 0         0 ($pkg, $fname, $lineno, $sname) = caller(1);
568 0         0 warn "Called by $pkg\:\:$sname, line #$lineno in $fname.\n";
569 0         0 return 0;
570             } elsif (($template=~/(?:(?:\r?\n)|\r)/) || (!($ref=ref($template)) && !(-f $template)) ) {
571 18         41 return $self->text_process($template, $item);
572             } elsif ( $ref && $ref=~/FileHandle/ && ($fh=$template) ||
573             (-f $template) && ($fh = new FileHandle($template))) {
574 63 100       4539 if ($$self{_Text_Merge_LineMode}) {
575 62         1319 foreach (<$fh>) { $text .= $self->text_process($_, $item); };
  152         415  
576 1   50     74 } else { $text = $self->text_process((join('',<$fh>) || ''), $item); };
577 63 50       341 ($template ne $fh) && $fh->close;
578 63         1163 return $text;
579             };
580 0         0 warn "Invalid template $template provided to ".(ref $self)."->publish_text()\n";
581 0         0 return '';
582             };
583              
584              
585             =item publish_email($mailer, $headers, $filepath, $data, $actions)
586              
587             This method is similar to C but opens a handle to C<$mailer>, and sending the merged data
588             formatted as an e-mail message. C<$mailer> may contain the sequences C and/or C.
589             If either does not exists, it will be echoed at the beginning of the email (in the form of a header), allowing
590             e-mail to be passed preformatted. This is the preferred method; use a mailer that can be told to
591             accept the "To:", "Subject:" and "Reply-To:" fields within the body of the passed message and do
592             not specify the C or C tags in the C<$mailer> string. Returns false if failed,
593             true if succeeded. The recommended mail program is 'sendmail'. C<$headers> is a HASH reference, containing
594             the header information. Only the following header keys are recognized:
595              
596             To
597             Subject
598             Reply-To
599             CC
600             From (works for privileged users only)
601              
602             The values associated with these keys will be used to construct the desired e-mail message header. Secure
603             minded site administrators might put hooks in here, or even better clean the data, to protect access to
604             the system as a precaution, to avoid accidental mistakes perhaps.
605              
606             Note: the C<$mailer> argument string should begin with the type of pipe required for your request. For
607             sendmail, this argument would look something like (note the vertical pipe):
608              
609             '|/usr/bin/sendmail -t'
610              
611             Be careful not to run this with write permission on the sendmail file and forget the process pipe!!!
612              
613             =cut
614             sub publish_email {
615 0     0 1 0 my ($self, $mailer, $headers, $filepath, $data, $actions) = @_;
616 0   0     0 my ($recipient, $subject, $ccaddr, $replyto, $from, $ctype) =
      0        
      0        
      0        
      0        
617             ( ($$headers{To} || ''), ($$headers{Subject} || ''), ($$headers{CC} || ''), ($$headers{ReplyTo}), ($$headers{From} || ''), ($$headers{'Content-type'} || $$headers{'Content-Type'} || $$headers{'ContentType'} || '') );
618 0 0 0     0 $mailer && $recipient || (return '');
619 0         0 my ($toheader, $subheader, $ccheader, $repheader, $fromheader, $typeheader) = ('','','','','','');
620 0 0       0 $subject && $subject =~ s/[^\040-\176].*$//gs; # remove dangerous chars
621 0 0       0 $from && $from =~ s/[^\040-\176].*$//gs; # remove dangerous chars
622 0 0       0 $ccaddr && $ccaddr =~ s/[^\040-\176].*$//gs; # remove dangerous chars
623 0 0       0 $replyto && $replyto =~ s/[^\040-\176].*$//gs; # remove dangerous chars
624 0 0       0 $ctype && $ctype =~ s/[^\040-\176].*$//gs; # remove dangerous chars
625 0 0       0 $subject || ($subject = 'Web Notice');
626 0 0       0 if ($mailer=~/RECIPIENT/) { $mailer =~ s/RECIPIENT/$recipient/g; } else { $toheader = "To: $recipient\n"; };
  0         0  
  0         0  
627 0 0       0 if ($mailer=~/SUBJECT/) { $mailer =~ s/SUBJECT/$subject/g; } else { $subheader = "Subject: $subject\n"; };
  0         0  
  0         0  
628 0 0       0 $from && ($fromheader = "From: $from\n");
629 0 0       0 $ccaddr && ($ccheader="Cc: $ccaddr\n");
630 0 0       0 $replyto && ($repheader="Reply-to: $replyto\n");
631 0 0       0 $ctype && ($typeheader="Content-Type: $ctype\n");
632 0 0       0 if ($mailer eq 'SMTP') {
633             # We will put an SMTP (require Net::SMTP) mailer here
634 0         0 return 0;
635             } else {
636 0         0 my $fh = new FileHandle($mailer);
637 0 0       0 if (!$fh) { return ''; };
  0         0  
638 0 0 0     0 if ($toheader || $subheader || $typeheader || $ccheader) { print $fh $toheader.$fromheader.$subheader.$ccheader.$repheader.$typeheader."\n"; };
  0   0     0  
      0        
639 0         0 $self->publish_to($fh, $filepath, $data, $actions);
640 0         0 $fh->close;
641 0         0 return 1;
642             };
643             };
644              
645             sub enc_char {
646 0     0 0 0 my $c=shift;
647 0         0 my $v=ord($c);
648 0 0       0 ($v<16) && return '%0'.sprintf("%x",$v);
649 0         0 return '%'.sprintf("%x",$v);
650             };
651              
652              
653              
654             =item cgi2data($cgi)
655              
656             This method converts C parameters to a data hash reference suitable
657             for merging. The C<$cgi> parameter is a CGI object and is optional, but
658             you must have imported the C<:standard> methods from C if you omit
659             the C<$cgi> paramter. This method returns a hash reference containing the
660             parameters as data. Basically it turns list values into list references and
661             puts everything in a hash keyed by field name.
662              
663             =cut
664             sub cgi2data {
665 0     0 1 0 my ($self, $cgi) = @_;
666 0         0 my $data = {};
667 0         0 my ($k,$v,@v);
668 0 0       0 my @keys = $cgi ? $cgi->param : param();
669 0         0 foreach $k ($cgi->param) {
670 0 0       0 @v = $cgi ? $cgi->param($k) : param($k);
671 0 0       0 $v = (@v>1) ? [@v] : $v[0];
672 0         0 $$data{$k} = $v;
673             }
674 0         0 return $data;
675             };
676              
677              
678             #
679             # local conversion function for output of each of the various styles
680             # OK, this isn't going to "local" anymore, other programs all want to use
681             # it, so we have to let them. Don't forget to document!
682             #
683             sub convert_value {
684 358     358 0 548 my ($self, $value, $style) = @_;
685 358   50     685 $value ||= '';
686 358 50       770 ($_=$style) || ($_ = 'string');
687 358 50 50     15183 /^upper/i && (return uc($value || '')) ||
    0 100        
      50        
      100        
      33        
      50        
      100        
      33        
      0        
      50        
      33        
      50        
      100        
      33        
      50        
      100        
      33        
      50        
      100        
      33        
      100        
      33        
      0        
      50        
      33        
      100        
      33        
      100        
      33        
      50        
      33        
      50        
      100        
      33        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      100        
      33        
      50        
      33        
      0        
      0        
      0        
688             /^lower/i && (return lc($value || '')) ||
689             /^proper/i && (return propnoun($value || '')) ||
690             /^trunc(?:ate)?(\d+)/ && (return substr(($value||''), 0, $1)) ||
691             /^words(\d+)/ && (return frstword(($value||''), $1)) ||
692             /^para(?:graph)?(\d+)/ && (return paratext(($value||''), $1)) ||
693             /^indent(\d+)/ && (return indtext(($value||''), $1)) ||
694             /^int/i && (return (defined $value ? int($value) : 0)) ||
695             /^float/i && (return (defined $value && sprintf('%f',($value || 0))) || '') ||
696             /^string/i && (return $value) ||
697             /^detab/i && (return de_tab($value)) || # Convert tabs to spaces in a string
698             /^html/i && (return htmlconv($value)) || # Convert text to HTML
699             /^dollars/i && (return (defined $value && length($value) && sprintf('%.2f',($value || 0)) || '')) ||
700             /^percent/i && (return (($value<0.2) && sprintf('%.1f%%',($value*100)) || sprintf('%d%%',int($value*100)))) ||
701             /^abbr/i && (return abbrdate($value)) || # abbreviated date only
702             /^short/i && (return shrtdate($value)) || # short date/time
703             /^time/i && (return timeoday($value)) || # time of day only (localtime am/pm)
704             /^24h/i && (return time24hr($value)) || # time of day 23:59 format (localtime0
705             /^dateonly/i && (return dateonly($value)) || # same as full date, but no meridian time
706             /^date/i && (return fulldate($value)) || # full date
707             /^ext/i && (return extdate($value)) || # extended date
708             /^unix/i && (return scalar localtime($value)) ||
709             /^urlencode/i && (return urlenc($value)) || # URL encoded
710             /^urldecode/i && (return urldec($value)) || # URL decoded
711             /^escape/i && (return brsresc($value)) || # Browser Escape
712             /^unescape/i && (return brsruesc($value)) || # Browser Un-Escape
713             /^list$/ && (return (ref $value) && ' '.join("\n ", @$value)."\n" || ' '.$value."\n") ||
714             return " {{{ style $style not supported }}} ";
715             };
716              
717              
718 0     0 0 0 sub browser_escape { return brsresc(@_); };
719 0     0 0 0 sub browser_unescape { return brsruesc(@_); };
720 0     0 0 0 sub html_convert { return htmlconv(@_); };
721              
722             __END__