File Coverage

blib/lib/Net/Amazon/MechanicalTurk/Template/ReplacementTemplate.pm
Criterion Covered Total %
statement 18 51 35.2
branch 0 10 0.0
condition 0 9 0.0
subroutine 6 8 75.0
pod 0 2 0.0
total 24 80 30.0


line stmt bran cond sub pod time code
1             package Net::Amazon::MechanicalTurk::Template::ReplacementTemplate;
2 2     2   11 use strict;
  2         4  
  2         69  
3 2     2   10 use warnings;
  2         4  
  2         44  
4 2     2   10 use Carp;
  2         11  
  2         123  
5 2     2   10 use IO::File;
  2         3  
  2         344  
6 2     2   1134 use Net::Amazon::MechanicalTurk::Template;
  2         6  
  2         61  
7 2     2   612 use Net::Amazon::MechanicalTurk::DataStructure;
  2         5  
  2         1227  
8              
9             our $VERSION = '1.00';
10              
11             our @ISA = qw{ Net::Amazon::MechanicalTurk::Template };
12              
13             Net::Amazon::MechanicalTurk::Template::ReplacementTemplate->attributes(qw{
14             tokens
15             });
16              
17             #
18             # The java command line tools for MechanicalTurk use Velocity for
19             # question templates.
20             #
21             # The class should handle some of the simple samples used for bulk loading
22             # in the java command line tools.
23             #
24             # For more powerful features PerlTemplate may be used.
25             #
26              
27             sub compileSource {
28 0     0 0   my ($self, $text) = @_;
29            
30 0           $self->templateSource($text);
31            
32             # The loop keeps chopping of chunks of text from the front.
33             # It may pull out a chunk of text in the first regex group
34             # and the variable name to be replaced, will be in the 3rd or 4th.
35             # Variable names appear as ${variableName} or $variableName.
36             # If a nested variable is needed it must be in the bracket syntax
37             # with dots seperating keys or array indices (array indices
38             # start at 1).
39            
40 0           my @tokens;
41 0           while ($text =~ s/^(.*?)(\${([^}]+)}|\$([a-zA-Z0-9\-_]+))//s) {
42 0           my $subText = $1;
43 0           my $var = $3;
44 0 0 0       if (!defined($var) or $var eq "") {
45 0           $var = $4;
46             }
47 0           my $varToken = $2;
48 0           $var =~ s/^\s+//;
49 0           $var =~ s/\s+$//;
50 0 0 0       if (defined($subText) and length($subText) > 0) {
51 0           $subText =~ s/\\{/{/g;
52 0           $subText =~ s/\\}/}/g;
53 0           push(@tokens, { type => 'text', text => $subText });
54             }
55 0           push(@tokens, { type => 'var', var => $var, varToken => $varToken });
56             }
57            
58 0 0         if (length($text) > 0) {
59 0           my $subText = $text;
60 0           $subText =~ s/\\{/{/g;
61 0           $subText =~ s/\\}/}/g;
62 0           push(@tokens, { type => 'text', text => $subText });
63             }
64            
65 0           $self->tokens(\@tokens);
66 0           $self->compiled(1);
67             }
68              
69             sub merge {
70 0     0 0   my ($self, $params) = @_;
71 0           my $out = '';
72 0           foreach my $token (@{$self->tokens}) {
  0            
73 0 0         if ($token->{type} eq 'text') {
74 0           $out .= $token->{text};
75             }
76             else {
77 0           my $value = Net::Amazon::MechanicalTurk::DataStructure->getFirst($params, $token->{var});
78 0 0 0       if (defined($value) and length($value) > 0) {
79 0           $out .= $value;
80             }
81             }
82             }
83 0           return $out;
84             }
85              
86             return 1;