File Coverage

blib/lib/Template/Plugin/Wrap.pm
Criterion Covered Total %
statement 27 27 100.0
branch 4 4 100.0
condition 2 2 100.0
subroutine 8 8 100.0
pod 1 3 33.3
total 42 44 95.4


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::Plugin::Wrap
4             #
5             # DESCRIPTION
6             # Plugin for wrapping text via the Text::Wrap module.
7             #
8             # AUTHOR
9             # Andy Wardley
10             #
11             # COPYRIGHT
12             # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
13             #
14             # This module is free software; you can redistribute it and/or
15             # modify it under the same terms as Perl itself.
16             #
17             #============================================================================
18              
19             package Template::Plugin::Wrap;
20              
21 1     1   7 use strict;
  1         2  
  1         50  
22 1     1   9 use warnings;
  1         3  
  1         100  
23 1     1   7 use base 'Template::Plugin';
  1         2  
  1         863  
24 1     1   7 use Text::Wrap;
  1         2  
  1         289  
25              
26             our $VERSION = 2.68;
27              
28             sub new {
29 3     3 1 7 my ($class, $context, $format) = @_;;
30 3         22 $context->define_filter('wrap', [ \&wrap_filter_factory => 1 ]);
31 3         18 return \&tt_wrap;
32             }
33              
34             sub tt_wrap {
35 6     6 0 41 my $text = shift;
36 6   100     21 my $width = shift || 72;
37 6         9 my $itab = shift;
38 6         13 my $ntab = shift;
39 6 100       16 $itab = '' unless defined $itab;
40 6 100       24 $ntab = '' unless defined $ntab;
41 6         10 $Text::Wrap::columns = $width;
42 6         36 Text::Wrap::wrap($itab, $ntab, $text);
43             }
44              
45             sub wrap_filter_factory {
46 4     4 0 209 my ($context, @args) = @_;
47             return sub {
48 5     5   57 my $text = shift;
49 5         17 tt_wrap($text, @args);
50             }
51 4         130 }
52              
53              
54             1;
55              
56             __END__