File Coverage

blib/lib/Text/Variations.pm
Criterion Covered Total %
statement 42 43 97.6
branch 7 10 70.0
condition 2 2 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 60 64 93.7


line stmt bran cond sub pod time code
1             package Text::Variations;
2              
3 5     5   2958 use strict;
  5         6  
  5         139  
4 5     5   18 use warnings;
  5         5  
  5         570  
5              
6             our $VERSION = '0.03';
7              
8             =head1 NAME
9              
10             Text::Variations - create many variations of the same message
11              
12             =head1 SYNOPSIS
13              
14             use Text::Variations;
15              
16             # Simple variables that change each time
17             my $mood = Text::Variations->new( [ 'happy', 'sad' ] );
18             my $activity = Text::Variations->new( [ 'shopping', 'surfing' ] );
19             my $facebook_status = "I'm feeling $mood - going $activity now\n";
20              
21             # build up complex strings with interpolations
22             my $announcement = Text::Variations->new(
23             "The train at platform {{platform}} has been ",
24             [ 'delayed',
25             'cancelled',
26             ],
27             " due to ",
28             [ "engineering works",
29             "maintenance issues",
30             "operating difficulties",
31             "a passenger incident",
32             "leaves on the tracks",
33             "the wrong kind of snow",
34             ],
35             " - we apologise for any ",
36             [ "inconvenience",
37             "disruption to your journey",
38             "missed onward connections",
39             ],
40             " this may have caused\n"
41             );
42              
43             print $announcement->generate( { platform => 4 } );
44              
45             =head1 DESCRIPTION
46              
47             Often you have a simple message that you want to get across, but you don't want
48             it to be the same format each time. This module helps you do that.
49              
50             You can specify several alternatives and a random one will be picked each time.
51              
52             This module was written to generate the tweets for
53             L every time someone signed up or donated. To keep
54             the tweets interesting and feel more human they all had to be different, but all
55             generated from code.
56              
57             =head1 METHODS
58              
59             =head2 new
60              
61             my $tv = Text::Variations->new(
62             "just a simple string",
63             [ 'or', 'an', 'arrayref', 'of', 'alternatives' ],
64             "can have {{placeholders}} to interpolate",
65             $or_even_other_text_variations_objects,
66             );
67              
68             Create a new Text::Variations object.
69              
70             The arguments are an array of strings, arrayrefs of alternatives, or other T::V
71             objects.
72              
73             You can include placeholders for variables by using C<'{{key}}'> in the strings.
74             These placeholders will then be replaced by the value you specify in the
75             arguments to C.
76              
77             =cut
78              
79             sub new {
80 8     8 1 3996 my $class = shift;
81 8         16 my @bits = @_;
82              
83 8         15 my $self = bless {}, $class;
84              
85 8         117 $self->{bits} = \@bits;
86              
87 8         22 return $self;
88             }
89              
90             =head2 generate
91              
92             my $string = $tv->generate();
93             my $string = "$tv";
94             my $string = $tv->generate( { name => 'Joe', } );
95              
96             Generates and returns a string. The arguments are used to fill in the
97             placeholders if there are any. The various parts are chosen at random. If there
98             are any embedded T::V objects then the arguments are passed on to them so as
99             well.
100              
101             Stringification is overloaded so that it is identical to calling C
102             with no arguments.
103              
104             =cut
105              
106 5     5   33 use overload '""' => \&generate;
  5         8  
  5         52  
107              
108             sub generate {
109 22005     22005 1 66701 my $self = shift;
110 22005   100     45342 my $args = shift || {};
111 22005         22168 my @outs = ();
112              
113 22005         15167 foreach my $bit ( @{ $self->{bits} } ) {
  22005         30383  
114              
115 62007         67398 my $string = $self->_convert_bit_to_string( $bit, $args );
116 62007 50       79852 next unless defined $string;
117              
118 62007         69811 my $interpolated = $self->_interpolate_string( $string, $args );
119              
120 62007         78103 push @outs, $interpolated;
121             }
122              
123 22005         60004 return join '', @outs;
124             }
125              
126             sub _convert_bit_to_string {
127 103007     103007   73249 my $self = shift;
128 103007         66701 my $bit = shift;
129 103007         68023 my $args = shift;
130              
131             # return strings and undefs at once
132 103007 50       127267 return $bit if !defined $bit;
133 103007 100       168477 return $bit if !ref $bit;
134              
135             # If we have an array pick a random entry
136 42000 100       55518 if ( ref $bit eq 'ARRAY' ) {
137 41000         48639 my $index = int rand scalar @$bit;
138 41000         51714 return $self->_convert_bit_to_string( $bit->[$index], $args );
139             }
140              
141             # Check if we are nested
142 1000         735 my $bit_ref = ref($bit);
143 1000         637 my $self_ref = ref($self);
144 1000 50       1096 if ( $bit_ref eq $self_ref ) {
145 1000         1003 return $bit->generate($args);
146             }
147              
148 0         0 die "Don't know what to do with '$bit_ref': $bit";
149             }
150              
151             sub _interpolate_string {
152 62007     62007   42717 my $self = shift;
153 62007         42369 my $string = shift;
154 62007         39908 my $args = shift;
155              
156 62007         88337 $string =~ s/ \{\{ (\w+) \}\} / $args->{$1} /xge;
  21002         38735  
157 62007         68430 return $string;
158             }
159              
160             =head1 SEE ALSO
161              
162             L - used to send the tweets that this module was created to generate.
163              
164             =head1 GOTCHAS
165              
166             If you're hoping to generate different looking messages make sure that there is
167             plenty of variation in the first part. Also think about creating several
168             different forms as T::V objects and then combining all of those into a single
169             final T::V object.
170              
171             =head1 THANKS TO
172              
173             ... the British rail companies, for delaying my journey and providing so much
174             material for the example code. This module was entirely written on the late
175             running service between London Paddington and Newport.
176              
177             =head1 AUTHOR
178              
179             Edmund von der Burg C<< >>.
180              
181             L
182              
183             =head1 CONTRIBUTING
184              
185             Contributions welcome: L
186              
187             TRavis build tests: L
188              
189             =head1 LICENCE AND COPYRIGHT
190              
191             Copyright (c) 2009, Edmund von der Burg C<< >>.
192             All rights reserved.
193              
194             This module is free software; you can redistribute it and/or modify it under
195             the same terms as Perl itself.
196              
197             1;