File Coverage

blib/lib/Text/NeatTemplate.pm
Criterion Covered Total %
statement 9 303 2.9
branch 0 176 0.0
condition 0 30 0.0
subroutine 3 13 23.0
pod 10 10 100.0
total 22 532 4.1


line stmt bran cond sub pod time code
1             package Text::NeatTemplate;
2             $Text::NeatTemplate::VERSION = '0.1400';
3 1     1   71889 use strict;
  1         12  
  1         30  
4 1     1   5 use warnings;
  1         2  
  1         1480  
5              
6             =head1 NAME
7              
8             Text::NeatTemplate - a fast, middleweight template engine.
9              
10             =head1 VERSION
11              
12             version 0.1400
13              
14             =head1 SYNOPSIS
15              
16             use Text::NeatTemplate;
17              
18             my $tobj = Text::NeatTemplate->new();
19              
20             $result = $tobj->fill_in(data_hash=>\%data,
21             show_names=>\%names,
22             template=>$text);
23              
24             =head1 DESCRIPTION
25              
26             This module provides a simple, middleweight but fast template engine,
27             for when you need speed rather than complex features, yet need more features
28             than simple variable substitution.
29              
30             =head2 Markup Format
31              
32             The markup format is as follows:
33              
34             =over
35              
36             =item {$varname}
37              
38             A variable; will display the value of the variable, or nothing if
39             that value is empty.
40              
41             =item {$varname:format}
42              
43             A formatted variable; will apply the formatting directive(s) to
44             the value before displaying it.
45              
46             =item {?varname stuff [$varname] more stuff}
47              
48             A conditional. If the value of 'varname' is not empty, this will
49             display "stuff value-of-variable more stuff"; otherwise it displays
50             nothing.
51              
52             {?var1 stuff [$var1] thing [$var2]}
53              
54             This would use both the values of var1 and var2 if var1 is not
55             empty.
56              
57             =item {?varname stuff [$varname] more stuff!!other stuff}
58              
59             A conditional with "else". If the value of 'varname' is not empty, this
60             will display "stuff value-of-variable more stuff"; otherwise it displays
61             "other stuff".
62              
63             This version can likewise use multiple variables in its display parts.
64              
65             {?var1 stuff [$var1] thing [$var2]!![$var3]}
66              
67             =item {&funcname(arg1,...,argN)}
68              
69             Call a function with the given args; the return value of the
70             function will be what is put in its place.
71              
72             {&MyPackage::myfunc(stuff,[$var1])}
73              
74             This would call the function myfunc in the package MyPackage, with the
75             arguments "stuff", and the value of var1.
76              
77             Note, of course, that if you have a more complicated function and
78             are processing much data, this will slow things down.
79              
80             =back
81              
82             =head2 Limitations
83              
84             To make the parsing simpler (and therefore faster) there are certain
85             restrictions in what this module can do:
86              
87             =over
88              
89             =item *
90              
91             One cannot escape '{' '}' '[' or ']' characters. However, the substitution
92             is clever enough so that you may be able to use them inside conditional
93             constructs, provided the use does not resemble a variable.
94              
95             For example, to get a value surrounded by {}, the following
96             will not work:
97              
98             {{$Var1}}
99              
100             However, this will:
101              
102             {?Var1 {[$Var1]}}
103              
104             =item *
105              
106             One cannot have nested variables.
107              
108             =item *
109              
110             Conditionals are limited to testing whether or not the variable
111             has a value. If you want more elaborate tests, or tests on more
112             than one value, you'll have to write a function to do it, and
113             use the {&function()} construct.
114              
115             =item *
116              
117             Function arguments (as given with the {&funcname(arg1,arg2...)} format)
118             cannot have commas in them, since commas are used to separate the
119             arguments.
120              
121             =back
122              
123             =head2 Justification For Existence
124              
125             When I was writing SQLite::Work, I originally tried using L
126             (my favourite template engine) and also tried L. Both
127             of them had some lovely, powerful features. Unfortunately, they were
128             also relatively slow. In testing them with a 700-row table, using
129             Text::Template took about 15 seconds to generate the report, and using
130             Text::FillIn took 45 seconds! Rolling my own very simple template
131             engine cut the time down to about 7 seconds.
132              
133             The reasons for this aren't that surprising. Because Text::Template
134             is basically an embedded Perl engine, it has to run the interpreter
135             on each substitution. And Text::FillIn has a lot to do, what with being
136             very generic and very recursive.
137              
138             The trade-off for the speed-gain of Text::NeatTemplate is that
139             it is quite simple. There is no nesting or recursion, there are
140             no loops. But I do think I've managed to grab some of the nicer features
141             of other template engines, such as limited conditionals, and formatting,
142             and, the most powerful of all, calling external functions.
143              
144             This is a middleweight engine rather than a lightweight one, because
145             I needed more than just simple variable substitution, such as one
146             has with L. I consider the trade-off worth it,
147             and others might also, so I made this a separate module.
148              
149             =head1 FORMATTING
150              
151             As well as simple substitution, this module can apply formatting
152             to values before they are displayed.
153              
154             For example:
155              
156             {$Money:dollars}
157              
158             will give the value of the I variable formatted as a dollar value.
159              
160             Formatting directives are:
161              
162             =over
163              
164             =item alpha
165              
166             Convert to a string containing only alphanumeric characters
167             (useful for anchors or filenames)
168              
169             =item alphadash
170              
171             Convert to a string containing alphanumeric characters, dashes
172             and underscores; spaces are converted to underscores.
173             (useful for anchors or filenames)
174              
175             =item alphahash
176              
177             Convert to a string containing only alphanumeric characters
178             and then prefix with a hash (#) character
179             (useful for anchors or tags)
180              
181             =item alphahyphen
182              
183             Convert to a string containing alphanumeric characters, dashes
184             and underscores; spaces are converted to hyphens.
185             (useful for anchors or filenames)
186              
187             =item comma_front
188              
189             Put anything after the last comma at the front (as with an author name)
190             For example, "Smith,Sarah Jane" becomes "Sarah Jane Smith".
191              
192             =item dollars
193              
194             Return as a dollar value (float of precision 2)
195              
196             =item email
197              
198             Convert to a HTML mailto link.
199              
200             =item float
201              
202             Convert to float.
203              
204             =item hmail
205              
206             Convert to a "humanized" version of the email, with the @ and '.'
207             replaced with "at" and "dot". This is useful to prevent spambots
208             harvesting email addresses.
209              
210             =item html
211              
212             Convert to simple HTML (simple formatting)
213              
214             =item int
215              
216             Convert to integer
217              
218             =item itemI
219              
220             Assume that the value is multiple values separated by the "pipe" symbol (|) and
221             select the item with an index of I (starting at zero)
222              
223             =item items_I
224              
225             Assume that the value is multiple values separated by the "pipe" symbol (|) and
226             split the values into an array, apply the I directive to them, and
227             join them together with a space.
228              
229             =item itemsjslash_I
230              
231             Like items_I, but the results are joined together with a slash between them.
232              
233             =item itemslashI
234              
235             Assume that the value is multiple values separated by the "slash" symbol (/) and
236             select the item with an index of I (starting at zero)
237             Good for selecting out components of pathnames.
238              
239             =item lower
240              
241             Convert to lower case.
242              
243             =item month
244              
245             Convert the number value to an English month name.
246              
247             =item namedalpha
248              
249             Similar to 'alpha', but prepends the 'name' of the value.
250             Assumes that the name is only alphanumeric.
251              
252             =item nth
253              
254             Convert the number value to a N-th value. Numbers ending with 1 have 'st'
255             appended, 2 have 'nd' appended, 3 have 'rd' appended, and everything
256             else has 'th' appended.
257              
258             =item percent
259              
260             Show as if the value is a percentage.
261              
262             =item pipetocomma
263              
264             Assume that the value is multiple values separated by the "pipe" symbol (|) and replace
265             those with a comma and space.
266              
267             =item pipetoslash
268              
269             Assume that the value is multiple values separated by the "pipe" symbol (|) and replace
270             those with a forward slash (/).
271              
272             =item proper
273              
274             Convert to a Proper Noun.
275              
276             =item string
277              
278             Return the value with no change.
279              
280             =item title
281              
282             Put any trailing ",The" ",A" or ",An" at the front (as this is a title)
283              
284             =item truncateI
285              
286             Truncate to I length.
287              
288             =item upper
289              
290             Convert to upper case.
291              
292             =item url
293              
294             Convert to a HTML href link.
295              
296             =item wikilink
297              
298             Format the value as the most common kind of wikilink, that is [[I]]
299              
300             =item wordsI
301              
302             Give the first I words of the value.
303              
304             =back
305              
306             =cut
307              
308              
309             =head1 CLASS METHODS
310              
311             =head2 new
312              
313             my $tobj = Text::NeatTemplate->new();
314              
315             Make a new template object.
316              
317             =cut
318              
319             sub new {
320 0     0 1   my $class = shift;
321 0           my %parameters = @_;
322 0   0       my $self = bless ({%parameters}, ref ($class) || $class);
323              
324 0           return ($self);
325             } # new
326              
327              
328             =head1 METHODS
329              
330             =head2 fill_in
331              
332             Fill in the given values.
333              
334             $result = $tobj->fill_in(data_hash=>\%data,
335             show_names=>\%names,
336             template=>$text);
337              
338             The 'data_hash' is a hash containing names and values.
339              
340             The 'show_names' is a hash saying which of these "variable names"
341             ought to be displayed, and which suppressed. This can be useful
342             if you want to use a more generic template, and then dynamically
343             suppress certain values at runtime.
344              
345             The 'template' is the text of the template.
346              
347             =cut
348             sub fill_in {
349 0     0 1   my $self = shift;
350 0           my %args = (
351             data_hash=>undef,
352             show_names=>undef,
353             template=>undef,
354             @_
355             );
356              
357 0           my $out = $args{template};
358 0           $out =~ s/{([^}]+)}/$self->do_replace(data_hash=>$args{data_hash},show_names=>$args{show_names},targ=>$1)/eg;
  0            
359              
360 0           return $out;
361             } # fill_in
362              
363             =head2 get_varnames
364              
365             Find variable names inside the given template.
366              
367             @varnames = $tobj->get_varnames(template=>$text);
368              
369             =cut
370             sub get_varnames {
371 0     0 1   my $self = shift;
372 0           my %args = (
373             template=>undef,
374             @_
375             );
376 0           my $template = $args{template};
377              
378 0 0         return '' if (!$template);
379              
380 0           my %varnames = ();
381             # { (the regex below needs matching)
382 0           while ($template =~ m/{([^}]+)}/g)
383             {
384 0           my $targ = $1;
385              
386 0 0         if ($targ =~ /^\$(\w+[-:\w]*)$/)
    0          
    0          
    0          
387             {
388 0           my $val_id = $1;
389 0           $varnames{$val_id} = 1;
390             }
391             elsif ($targ =~ /^\?([-\w]+)\s(.*)!!(.*)$/)
392             {
393 0           my $val_id = $1;
394 0           my $yes_t = $2;
395 0           my $no_t = $3;
396              
397 0           $varnames{$val_id} = 1;
398              
399 0           foreach my $substr ($yes_t, $no_t)
400             {
401 0           while ($substr =~ /\[(\$[^\]]+)\]/)
402             {
403 0           $varnames{$1} = 1;
404             }
405             }
406             }
407             elsif ($targ =~ /^\?([-\w]+)\s(.*)$/)
408             {
409 0           my $val_id = $1;
410 0           my $yes_t = $2;
411              
412 0           $varnames{$val_id} = 1;
413 0           while ($yes_t =~ /\[(\$[^\]]+)\]/)
414             {
415 0           $varnames{$1} = 1;
416             }
417             }
418             elsif ($targ =~ /^\&([-\w:]+)\((.*)\)$/)
419             {
420             # function
421 0           my $func_name = $1;
422 0           my $fargs = $2;
423 0           while ($fargs =~ /\[(\$[^\]]+)\]/)
424             {
425 0           $varnames{$1} = 1;
426             }
427             }
428             }
429 0           return sort keys %varnames;
430             } # get_varnames
431              
432             =head2 do_replace
433              
434             Replace the given value.
435              
436             $val = $tobj->do_replace(targ=>$targ,
437             data_hash=>$data_hashref,
438             show_names=>\%show_names);
439              
440             Where 'targ' is the target value, which is either a variable target,
441             or a conditional target.
442              
443             The 'data_hash' is a hash containing names and values.
444              
445             The 'show_names' is a hash saying which of these "variable names"
446             ought to be displayed, and which suppressed.
447              
448             This can do templating by using the exec ability of substitution, for
449             example:
450              
451             $out =~ s/{([^}]+)}/$tobj->do_replace(data_hash=>$data_hash,targ=>$1)/eg;
452              
453             =cut
454             sub do_replace {
455 0     0 1   my $self = shift;
456 0           my %args = (
457             targ=>'',
458             data_hash=>undef,
459             show_names=>undef,
460             @_
461             );
462 0           my $targ = $args{targ};
463              
464 0 0         return '' if (!$targ);
465 0 0         if ($targ =~ /^\$(\w+[-:\w]*)$/)
    0          
    0          
    0          
466             {
467             my $val = $self->get_value(val_id=>$1,
468             data_hash=>$args{data_hash},
469 0           show_names=>$args{show_names});
470 0 0         if (defined $val)
471             {
472 0           return $val;
473             }
474             else # not a variable -- return nothing
475             {
476 0           return '';
477             }
478             }
479             elsif ($targ =~ /^\?([-\w]+)\s(.*)!!(.*)$/)
480             {
481 0           my $val_id = $1;
482 0           my $yes_t = $2;
483 0           my $no_t = $3;
484             my $val = $self->get_value(val_id=>$val_id,
485             data_hash=>$args{data_hash},
486 0           show_names=>$args{show_names});
487 0 0         if ($val)
488             {
489 0           $yes_t =~ s/\[(\$[^\]]+)\]/$self->do_replace(data_hash=>$args{data_hash},show_names=>$args{show_names},targ=>$1)/eg;
  0            
490 0           return $yes_t;
491             }
492             else # no value, return alternative
493             {
494 0           $no_t =~ s/\[(\$[^\]]+)\]/$self->do_replace(data_hash=>$args{data_hash},show_names=>$args{show_names},targ=>$1)/eg;
  0            
495 0           return $no_t;
496             }
497             }
498             elsif ($targ =~ /^\?([-\w]+)\s(.*)$/)
499             {
500 0           my $val_id = $1;
501 0           my $yes_t = $2;
502             my $val = $self->get_value(val_id=>$val_id,
503             data_hash=>$args{data_hash},
504 0           show_names=>$args{show_names});
505 0 0         if ($val)
506             {
507 0           $yes_t =~ s/\[(\$[^\]]+)\]/$self->do_replace(data_hash=>$args{data_hash},show_names=>$args{show_names},targ=>$1)/eg;
  0            
508 0           return $yes_t;
509             }
510             else # no value, return nothing
511             {
512 0           return '';
513             }
514             }
515             elsif ($targ =~ /^\&([-\w:]+)\((.*)\)$/)
516             {
517             # function
518 0           my $func_name = $1;
519 0           my $fargs = $2;
520             # split the args first, and replace each one separately
521             # just in case the data values have commas
522 0           my @fargs = split(/,/,$fargs);
523 0           my @processed = ();
524 0           foreach my $fa (@fargs)
525             {
526 0           $fa =~ s/\[(\$[^\]]+)\]/$self->do_replace(data_hash=>$args{data_hash},show_names=>$args{show_names},targ=>$1)/eg;
  0            
527 0           push @processed, $fa;
528             }
529             {
530 1     1   9 no strict('refs');
  1         2  
  1         3073  
  0            
531 0           return &{$func_name}(@processed);
  0            
532             }
533             }
534             else
535             {
536 0           print STDERR "UNKNOWN ==$targ==\n";
537             }
538 0           return '';
539             } # do_replace
540              
541             =head2 get_value
542              
543             $val = $tobj->get_value(val_id=>$val_id,
544             data_hash=>$data_hashref,
545             show_names=>\%show_names);
546              
547             Get and format the given value.
548              
549             =cut
550             sub get_value {
551 0     0 1   my $self = shift;
552 0           my %args = (
553             val_id=>'',
554             data_hash=>undef,
555             show_names=>undef,
556             @_
557             );
558 0           my ($varname, @formats) = split(':', $args{val_id});
559              
560 0           my $value;
561 0 0         if (exists $args{data_hash}->{$varname})
562             {
563 0 0 0       if (!$args{show_names}
564             or $args{show_names}->{$varname})
565             {
566 0           $value = $args{data_hash}->{$varname};
567             }
568             else
569             {
570 0           return '';
571             }
572             }
573             else
574             {
575 0           return undef;
576             }
577              
578             # we have a value to format
579 0           foreach my $format (@formats) {
580 0           $value = $self->convert_value(value=>$value,
581             format=>$format,
582             name=>$varname);
583             }
584 0 0 0       if ($value and $self->{escape_html})
585             {
586             # filter out some HTML stuff
587 0           $value =~ s/ & / & /g;
588             }
589 0           return $value;
590             } # get_value
591              
592             =head2 convert_value
593              
594             my $val = $tobj->convert_value(value=>$val,
595             format=>$format,
596             name=>$name);
597              
598             Convert a value according to the given formatting directive.
599              
600             See L for details of all the formatting directives.
601              
602              
603             =cut
604             sub convert_value {
605 0     0 1   my $self = shift;
606 0           my %args = @_;
607 0           my $value = $args{value};
608 0           my $style = $args{format};
609 0           my $name = $args{name};
610              
611 0   0       $value ||= '';
612 0 0         ($_=$style) || ($_ = 'string');
613             SWITCH: {
614 0 0         /^upper/i && (return uc($value));
  0            
615 0 0         /^lower/i && (return lc($value));
616 0 0         /^int/i && (return (defined $value ? int($value) : 0));
    0          
617 0 0 0       /^float/i && (return (defined $value && sprintf('%f',($value || 0))) || '');
618 0 0         /^string/i && (return $value);
619 0 0 0       /^trunc(?:ate)?(\d+)/ && (return substr(($value||''), 0, $1));
620 0 0 0       /^dollars/i &&
621             (return (defined $value && length($value)
622             && sprintf('%.2f',($value || 0)) || ''));
623 0 0 0       /^percent/i &&
624             (return (($value<0.2) &&
625             sprintf('%.1f%%',($value*100))
626             || sprintf('%d%%',int($value*100))));
627 0 0         /^url/i && (return "$value");
628 0 0         /^wikilink/i && (return "[[$value]]");
629 0 0         /^email/i && (return "$value");
630 0 0         /^hmail/i && do {
631 0           $value =~ s/@/ at /;
632 0           $value =~ s/\./ dot /g;
633 0           return $value;
634             };
635 0 0         /^html/i && (return $self->simple_html($value));
636 0 0         /^title/i && do {
637 0           $value =~ s/(.*)[,;]\s*(A|An|The)$/$2 $1/;
638 0           return $value;
639             };
640 0 0         /^comma_front/i && do {
641 0           $value =~ s/(.*)[,]([^,]+)$/$2 $1/;
642 0           return $value;
643             };
644 0 0         /^proper/i && do {
645 0           $value =~ s/(^w|\b\w)/uc($1)/eg;
  0            
646 0           return $value;
647             };
648             # YYYY-MM-DD dates
649 0 0         /^date_year/i && do {
650 0 0         return $value if !$value;
651 0           $value =~ s/^([0-9]+)-.*/$1/;
652 0           return $value;
653             };
654 0 0         /^date_mth/i && do {
655 0 0         return $value if !$value;
656 0           $value =~ s/^([0-9]+)-([0-9]+)-([0-9]+)/$2/;
657 0           return $value;
658             };
659 0 0         /^date_day/i && do {
660 0 0         return $value if !$value;
661 0           $value =~ s/^([0-9]+)-([0-9]+)-([0-9]+)/$3/;
662 0           return $value;
663             };
664 0 0         /^date_month/i && do {
665 0 0         return $value if !$value;
666 0 0         if ($value =~ /^([0-9]+)-([0-9]+)-([0-9]+)/)
667             {
668 0           my $mth = $2;
669 0           $value = $self->number_to_month($mth);
670             }
671 0           return $value;
672             };
673 0 0         /^month/i && do {
674 0           return $self->number_to_month($value);
675             };
676 0 0         /^nth/i && do {
677 0 0         return $value if !$value;
678 0 0         return ($value =~ /1[123]$/
    0          
    0          
    0          
679             ? "${value}th"
680             : ($value =~ /1$/
681             ? "${value}st"
682             : ($value =~ /2$/
683             ? "${value}nd"
684             : ($value =~ /3$/
685             ? "${value}rd"
686             : "${value}th"
687             )
688             )
689             )
690             );
691             };
692 0 0         /^facettag/i && do {
693 0           $value =~ s!/! !g;
694 0           $value =~ s/^\s+//;
695 0           $value =~ s/\s+$//;
696 0           $value =~ s/[^\w\s:_-]//g;
697 0           $value =~ s/\s\s+/ /g;
698 0           $value =~ s/ /_/g;
699 0           $value = join(':', $name, $value);
700 0           return $value;
701             };
702 0 0         /^namedalpha/i && do {
703 0           $value =~ s/[^a-zA-Z0-9]//g;
704 0           $value = join('_', $name, $value);
705 0           return $value;
706             };
707 0 0         /^alphadash/i && do {
708 0           $value =~ s!/! !g;
709 0           $value =~ s/[^a-zA-Z0-9_\s-]//g;
710 0           $value =~ s/^\s+//;
711 0           $value =~ s/\s+$//;
712 0           $value =~ s/\s\s+/ /g;
713 0           $value =~ s/ /_/g;
714 0           return $value;
715             };
716 0 0         /^alphahyphen/i && do {
717 0           $value =~ s!/! !g;
718 0           $value =~ s/[^a-zA-Z0-9_\s-]//g;
719 0           $value =~ s/^\s+//;
720 0           $value =~ s/\s+$//;
721 0           $value =~ s/\s\s+/ /g;
722 0           $value =~ s/ /-/g;
723 0           return $value;
724             };
725 0 0         /^alphahash/i && do {
726 0           $value =~ s/[^a-zA-Z0-9]//g;
727 0           $value = "#${value}";
728 0           return $value;
729             };
730 0 0         /^alpha/i && do {
731 0           $value =~ s/[^a-zA-Z0-9]//g;
732 0           return $value;
733             };
734 0 0         /^pipetocomma/i && do {
735 0           $value =~ s/\|/, /g;
736 0           return $value;
737             };
738 0 0         /^pipetoslash/i && do {
739 0           $value =~ s/\|/\//g;
740 0           return $value;
741             };
742 0 0         /^words(\d+)/ && do {
743 0           my $ct = $1;
744 0 0         ($ct>0) || return '';
745 0           my @sentence = split(/\s+/, $value);
746 0           my (@words) = splice(@sentence,0,$ct);
747 0           return join(' ', @words);
748             };
749 0 0         /^wlink_(\w+)/ && do {
750 0           my $prefix = $1;
751 0           return "[[$prefix/$value]]";
752             };
753 0 0         /^tagify/i && do {
754 0           $value =~ s/\|/,/g;
755 0           $value =~ s!/! !g;
756 0           $value =~ s/!/ /g;
757 0           $value =~ s/^\s+//;
758 0           $value =~ s/\s+$//;
759 0           $value =~ s/[^\w,\s_-]//g;
760 0           $value =~ s/\s\s+/ /g;
761 0           $value =~ s/ /_/g;
762 0           return $value;
763             };
764 0 0         /^item(\d+)/ && do {
765 0           my $ct = $1;
766 0 0         ($ct>=0) || return '';
767 0           my @items = split(/\|/, $value);
768 0           return $items[$ct];
769             };
770 0 0         /^itemslash(\d+)/ && do {
771 0           my $ct = $1;
772 0 0         ($ct>=0) || return '';
773 0           my @items = split(/\//, $value);
774 0           return $items[$ct];
775             };
776 0 0         /^items_(\w+)/ && do {
777 0           my $next = $1;
778 0           my @items = split(/[\|,]\s*/, $value);
779 0           my @next_items = ();
780 0           foreach my $item (@items)
781             {
782 0           push @next_items, $self->convert_value(%args, value=>$item, format=>$next);
783             }
784 0           return join(' ', @next_items);
785             };
786 0 0         /^itemsjslash_(\w+)/ && do {
787 0           my $next = $1;
788 0           my @items = split(/[\|,]\s*/, $value);
789 0           my @next_items = ();
790 0           foreach my $item (@items)
791             {
792 0           push @next_items, $self->convert_value(%args, value=>$item, format=>$next);
793             }
794 0           return join(' / ', @next_items);
795             };
796 0 0         /^itemsjcomma_(\w+)/ && do {
797 0           my $next = $1;
798 0           my @items = split(/[\|,]\s*/, $value);
799 0           my @next_items = ();
800 0           foreach my $item (@items)
801             {
802 0           push @next_items, $self->convert_value(%args, value=>$item, format=>$next);
803             }
804 0           return join(',', @next_items);
805             };
806              
807             # otherwise, give up
808 0           return " {{{ style $style not supported }}} ";
809             }
810             } # convert_value
811              
812             =head2 simple_html
813              
814             $val = $tobj->simple_html($val);
815              
816             Do a simple HTML conversion of the value.
817             bold, italic,
818              
819             =cut
820             sub simple_html {
821 0     0 1   my $self = shift;
822 0           my $value = shift;
823              
824 0           $value =~ s#\n[\s][\s][\s]+#
\n    #sg;
825 0           $value =~ s#\s*\n\s*\n#

\n#sg;
826 0           $value =~ s#\*([^*]+)\*#$1#sg;
827 0           $value =~ s/\^([^^]+)\^/$1<\/b>/sg;
828 0           $value =~ s/\#([^#<>]+)\#/$1<\/b>/sg;
829 0           $value =~ s/\s&\s/ & /sg;
830 0           return $value;
831             } # simple_html
832              
833             =head2 number_to_month
834              
835             $val = $tobj->number_to_month($val);
836              
837             Give the month name for this month-number.
838              
839             =cut
840             sub number_to_month {
841 0     0 1   my $self = shift;
842 0           my $value = shift;
843              
844 0 0         return $value if !$value;
845 0 0         return ($value == 1
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
846             ? 'January'
847             : ($value == 2
848             ? 'February'
849             : ($value == 3
850             ? 'March'
851             : ($value == 4
852             ? 'April'
853             : ($value == 5
854             ? 'May'
855             : ($value == 6
856             ? 'June'
857             : ($value == 7
858             ? 'July'
859             : ($value == 8
860             ? 'August'
861             : ($value == 9
862             ? 'September'
863             : ($value == 10
864             ? 'October'
865             : ($value == 11
866             ? 'November'
867             : ($value == 12
868             ? 'December'
869             : $value
870             )
871             )
872             )
873             )
874             )
875             )
876             )
877             )
878             )
879             )
880             )
881             );
882             # fallthrough
883 0           return $value;
884             } # number_to_month
885              
886             =head1 Callable Functions
887              
888             =head2 safe_backtick
889              
890             {&safe_backtick(myprog,arg1,arg2...argN)}
891              
892             Return the results of a program, without risking evil shell calls.
893             This requires that the program and the arguments to that program
894             be given separately.
895              
896             =cut
897             sub safe_backtick {
898 0     0 1   my @prog_and_args = @_;
899 0           my $progname = $prog_and_args[0];
900              
901             # if they didn't give us anything, return
902 0 0         if (!$progname)
903             {
904 0           return '';
905             }
906             # call the program
907             # do a fork and exec with an open;
908             # this should preserve the environment and also be safe
909 0           my $result = '';
910 0           my $fh;
911 0           my $pid = open($fh, "-|");
912 0 0         if ($pid) # parent
913             {
914             {
915             # slurp up the result all at once
916 0           local $/ = undef;
  0            
917 0           $result = <$fh>;
918             }
919 0 0         close($fh) || warn "$progname program script exited $?";
920             }
921             else # child
922             {
923             # call the program
924             # force exec to use an indirect object,
925             # so that evil shell stuff will die, even
926             # for a program with no arguments
927 0 0         exec { $progname } @prog_and_args or die "$progname failed: $!\n";
  0            
928             # NOTREACHED
929             }
930 0           return $result;
931             } # safe_backtick
932              
933             =head2 format_items
934              
935             {&format_items(fieldname,value,delim,outdelim,format,prefix,suffix)}
936              
937             Format a field made of multiple items.
938              
939             =cut
940             sub format_items {
941 0     0 1   my $fieldname = shift;
942 0           my $value = shift;
943 0           my @args = @_;
944              
945             # if they didn't give us anything, return
946 0 0         if (!$fieldname)
947             {
948 0           return '';
949             }
950 0 0         if (!$value)
951             {
952 0           return '';
953             }
954              
955 0   0       my $delim = $args[0] || '|';
956 0   0       my $outdelim = $args[1] || ' ';
957 0   0       my $format = $args[2] || 'raw';
958 0   0       my $prefix = $args[3] || '';
959 0   0       my $suffix = $args[4] || '';
960 0           $delim =~ s/comma/,/g;
961 0           $delim =~ s/pipe/|/g;
962 0           $delim =~ s!slash!/!g;
963 0           $outdelim =~ s/comma/,/g;
964 0           $outdelim =~ s/pipe/|/g;
965 0           $outdelim =~ s!slash!/!g;
966 0           my @items = split(/\Q$delim\E\s*/, $value);
967 0           my @next_items = ();
968 0           foreach my $item (@items)
969             {
970 0           push @next_items,
971             Text::NeatTemplate->convert_value(name=>$fieldname,
972             value=>$item,
973             format=>$format);
974             }
975 0           return $prefix . join($outdelim, @next_items) . $suffix;
976             } # format_items
977              
978              
979             =head1 REQUIRES
980              
981             Test::More
982              
983             =head1 INSTALLATION
984              
985             To install this module, run the following commands:
986              
987             perl Build.PL
988             ./Build
989             ./Build test
990             ./Build install
991              
992             Or, if you're on a platform (like DOS or Windows) that doesn't like the
993             "./" notation, you can do this:
994              
995             perl Build.PL
996             perl Build
997             perl Build test
998             perl Build install
999              
1000             In order to install somewhere other than the default, such as
1001             in a directory under your home directory, like "/home/fred/perl"
1002             go
1003              
1004             perl Build.PL --install_base /home/fred/perl
1005              
1006             as the first step instead.
1007              
1008             This will install the files underneath /home/fred/perl.
1009              
1010             You will then need to make sure that you alter the PERL5LIB variable to
1011             find the module.
1012              
1013             Therefore you will need to change the PERL5LIB variable to add
1014             /home/fred/perl/lib
1015              
1016             PERL5LIB=/home/fred/perl/lib:${PERL5LIB}
1017              
1018             =head1 SEE ALSO
1019              
1020             L
1021             L
1022             L
1023             L
1024             L
1025             L
1026              
1027             =head1 BUGS
1028              
1029             Please report any bugs or feature requests to the author.
1030              
1031             =head1 AUTHOR
1032              
1033             Kathryn Andersen (RUBYKAT)
1034             perlkat AT katspace dot com
1035             http://www.katspace.org/tools
1036              
1037             =head1 COPYRIGHT AND LICENCE
1038              
1039             Copyright (c) 2006 by Kathryn Andersen
1040              
1041             This program is free software; you can redistribute it and/or modify it
1042             under the same terms as Perl itself.
1043              
1044             =cut
1045              
1046             1; # End of Text::NeatTemplate
1047             __END__