File Coverage

blib/lib/Net/Amazon/MechanicalTurk/QuestionFormAnswers.pm
Criterion Covered Total %
statement 23 66 34.8
branch 1 16 6.2
condition n/a
subroutine 6 13 46.1
pod 0 7 0.0
total 30 102 29.4


line stmt bran cond sub pod time code
1             package Net::Amazon::MechanicalTurk::QuestionFormAnswers;
2 1     1   25358 use strict;
  1         3  
  1         34  
3 1     1   227 use warnings;
  1         2  
  1         31  
4 1     1   731 use Net::Amazon::MechanicalTurk::DataStructure;
  1         3  
  1         31  
5 1     1   600 use Net::Amazon::MechanicalTurk::XMLParser;
  1         3  
  1         30  
6 1     1   1003 use URI::Escape;
  1         1530  
  1         811  
7              
8             our $VERSION = '1.00';
9              
10             our @ISA = qw{ Net::Amazon::MechanicalTurk::BaseObject };
11              
12             Net::Amazon::MechanicalTurk::QuestionFormAnswers->attributes(qw{
13             answers
14             requesterUrl
15             assignmentId
16             answerSeparator
17             });
18              
19             sub init {
20 1     1 0 3 my $self = shift;
21 1         11 $self->setAttributes(@_);
22 1         11 $self->setAttributesIfNotDefined(
23             answerSeparator => '|'
24             );
25 1         8 $self->assertRequiredAttributes(qw{
26             answers
27             requesterUrl
28             assignmentId
29             });
30 1         5 my $answers = $self->answers;
31 1 50       18 if (UNIVERSAL::isa($answers, "Net::Amazon::MechanicalTurk::DataStructure")) {
32 0         0 $self->answers($answers);
33             }
34             else {
35 1         2 my $rootElement;
36 1         12 ($answers, $rootElement) = Net::Amazon::MechanicalTurk::XMLParser->new->parse($answers);
37 0           $self->answers($answers);
38             }
39             }
40              
41             sub getAnswer {
42 0     0 0   my ($self, $questionId) = @_;
43 0           foreach my $answer (@{$self->answers->{Answer}}) {
  0            
44 0 0         if ($answer->{QuestionIdentifier}[0] eq $questionId) {
45 0           return $answer;
46             }
47             }
48 0           return undef;
49             }
50              
51             sub getAnswerValues {
52 0     0 0   my $self = shift;
53 0           my $answers = {};
54             $self->eachAnswerValue(sub {
55 0     0     my ($questionId, $answerText) = @_;
56 0           $answers->{$questionId} = $answerText;
57 0           });
58 0           return $answers;
59             }
60              
61             sub eachAnswerValue {
62 0     0 0   my ($self, $code) = @_;
63 0           foreach my $answer (@{$self->answers->{Answer}}) {
  0            
64 0           my $questionId = $answer->{QuestionIdentifier}[0];
65 0           my $answerText = $self->getAnswerValue($answer);
66 0           $code->($questionId, $answerText);
67             }
68             }
69              
70             sub getAnswerValue {
71 0     0 0   my ($self, $answer) = @_;
72 0           my $value = '';
73 0 0         if (exists $answer->{FreeText}) {
    0          
74 0           $value = $answer->{FreeText}[0];
75             }
76             elsif (exists $answer->{UploadedFileKey}) {
77 0           $value = $self->getDownloadUrl($answer->{QuestionIdentifier}[0]);
78             }
79             else {
80 0           my $count = 0;
81 0 0         if (exists $answer->{SelectionIdentifier}) {
82 0           foreach my $sid (@{$answer->{SelectionIdentifier}}) {
  0            
83 0 0         if ($count++ > 0) {
84 0           $value .= $self->answerSeparator;
85             }
86 0           $value .= $sid;
87             }
88             }
89 0 0         if (exists $answer->{OtherSelectionText}) {
90 0           foreach my $sid (@{$answer->{OtherSelectionText}}) {
  0            
91 0 0         if ($count++ > 0) {
92 0           $value .= $self->answerSeparator;
93             }
94 0           $value .= $sid;
95             }
96             }
97             }
98 0           return $value;
99             }
100              
101             sub getDownloadUrl {
102 0     0 0   my ($self, $questionId) = @_;
103 0           return sprintf "%s/mturk/downloadAnswer?assignmentId=%s&questionId=%s",
104             $self->requesterUrl,
105             uri_escape($self->assignmentId),
106             uri_escape($questionId);
107             }
108              
109             sub toString {
110 0     0 0   my $self = shift;
111 0           return $self->answers->toString;
112             }
113              
114             return 1;