line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- cperl; cperl-indent-level: 4 -*- |
2
|
|
|
|
|
|
|
# Copyright (C) 2010-2021, Roland van Ipenburg |
3
|
|
|
|
|
|
|
package WWW::Wookie::Connector::Service v1.1.4; |
4
|
4
|
|
|
4
|
|
220627
|
use strict; |
|
4
|
|
|
|
|
29
|
|
|
4
|
|
|
|
|
111
|
|
5
|
4
|
|
|
4
|
|
41
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
105
|
|
6
|
|
|
|
|
|
|
|
7
|
4
|
|
|
4
|
|
1245
|
use utf8; |
|
4
|
|
|
|
|
32
|
|
|
4
|
|
|
|
|
31
|
|
8
|
4
|
|
|
4
|
|
160
|
use 5.020000; |
|
4
|
|
|
|
|
12
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
#use Log::Log4perl qw(:resurrect :easy get_logger); |
11
|
4
|
|
|
4
|
|
583
|
use Exception::Class; |
|
4
|
|
|
|
|
5074
|
|
|
4
|
|
|
|
|
28
|
|
12
|
4
|
|
|
4
|
|
2242
|
use HTTP::Headers; |
|
4
|
|
|
|
|
26771
|
|
|
4
|
|
|
|
|
139
|
|
13
|
4
|
|
|
4
|
|
1868
|
use HTTP::Request; |
|
4
|
|
|
|
|
45327
|
|
|
4
|
|
|
|
|
140
|
|
14
|
4
|
|
|
4
|
|
2028
|
use HTTP::Request::Common; |
|
4
|
|
|
|
|
8579
|
|
|
4
|
|
|
|
|
333
|
|
15
|
4
|
|
|
4
|
|
1835
|
use HTTP::Status qw(HTTP_CREATED HTTP_OK HTTP_UNAUTHORIZED HTTP_FORBIDDEN); |
|
4
|
|
|
|
|
17923
|
|
|
4
|
|
|
|
|
539
|
|
16
|
4
|
|
|
4
|
|
2768
|
use LWP::UserAgent qw/POST/; |
|
4
|
|
|
|
|
75497
|
|
|
4
|
|
|
|
|
165
|
|
17
|
4
|
|
|
4
|
|
1235
|
use Moose qw/around has with/; |
|
4
|
|
|
|
|
879632
|
|
|
4
|
|
|
|
|
35
|
|
18
|
4
|
|
|
4
|
|
26880
|
use Regexp::Common qw(URI); |
|
4
|
|
|
|
|
10633
|
|
|
4
|
|
|
|
|
15
|
|
19
|
4
|
|
|
4
|
|
96420
|
use URI::Escape qw(uri_escape); |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
189
|
|
20
|
4
|
|
|
4
|
|
3183
|
use XML::Simple; |
|
4
|
|
|
|
|
34597
|
|
|
4
|
|
|
|
|
28
|
|
21
|
4
|
|
|
4
|
|
1377
|
use namespace::autoclean '-except' => 'meta', '-also' => qr/^__/sxm; |
|
4
|
|
|
|
|
15804
|
|
|
4
|
|
|
|
|
48
|
|
22
|
|
|
|
|
|
|
|
23
|
4
|
|
|
4
|
|
1869
|
use WWW::Wookie::Connector::Exceptions; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
113
|
|
24
|
4
|
|
|
4
|
|
1751
|
use WWW::Wookie::Server::Connection; |
|
4
|
|
|
|
|
16
|
|
|
4
|
|
|
|
|
187
|
|
25
|
4
|
|
|
4
|
|
2329
|
use WWW::Wookie::User; |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
168
|
|
26
|
4
|
|
|
4
|
|
1745
|
use WWW::Wookie::Widget; |
|
4
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
154
|
|
27
|
4
|
|
|
4
|
|
1873
|
use WWW::Wookie::Widget::Category; |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
153
|
|
28
|
4
|
|
|
4
|
|
1865
|
use WWW::Wookie::Widget::Property; |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
141
|
|
29
|
4
|
|
|
4
|
|
1076
|
use WWW::Wookie::Widget::Instance; |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
132
|
|
30
|
4
|
|
|
4
|
|
1825
|
use WWW::Wookie::Widget::Instances; |
|
4
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
145
|
|
31
|
|
|
|
|
|
|
|
32
|
4
|
|
|
4
|
|
29
|
use Readonly; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
15198
|
|
33
|
|
|
|
|
|
|
## no critic qw(ProhibitCallsToUnexportedSubs) |
34
|
|
|
|
|
|
|
Readonly::Scalar my $DEFAULT_ICON => |
35
|
|
|
|
|
|
|
q{http://www.oss-watch.ac.uk/images/logo2.gif}; |
36
|
|
|
|
|
|
|
Readonly::Scalar my $TIMEOUT => 15; |
37
|
|
|
|
|
|
|
Readonly::Scalar my $AGENT => q{WWW::Wookie/} |
38
|
|
|
|
|
|
|
. $WWW::Wookie::Connector::Service::VERSION; |
39
|
|
|
|
|
|
|
Readonly::Scalar my $TESTUSER => q{testuser}; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Readonly::Scalar my $EMPTY => q{}; |
42
|
|
|
|
|
|
|
Readonly::Scalar my $QUERY => q{?}; |
43
|
|
|
|
|
|
|
Readonly::Scalar my $SLASH => q{/}; |
44
|
|
|
|
|
|
|
Readonly::Scalar my $TRUE => 1; |
45
|
|
|
|
|
|
|
Readonly::Scalar my $FALSE => 0; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Readonly::Scalar my $MORE_ARGS => 4; |
48
|
|
|
|
|
|
|
Readonly::Scalar my $MOST_ARGS => 5; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Readonly::Scalar my $GET => q{GET}; |
51
|
|
|
|
|
|
|
Readonly::Scalar my $POST => q{POST}; |
52
|
|
|
|
|
|
|
Readonly::Scalar my $DELETE => q{DELETE}; |
53
|
|
|
|
|
|
|
Readonly::Scalar my $PUT => q{PUT}; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Readonly::Scalar my $ALL => q{all}; |
56
|
|
|
|
|
|
|
Readonly::Scalar my $PARTICIPANTS => q{participants}; |
57
|
|
|
|
|
|
|
Readonly::Scalar my $PROPERTIES => q{properties}; |
58
|
|
|
|
|
|
|
Readonly::Scalar my $SERVICES => q{services}; |
59
|
|
|
|
|
|
|
Readonly::Scalar my $WIDGETS => q{widgets}; |
60
|
|
|
|
|
|
|
Readonly::Scalar my $WIDGETINSTANCES => q{widgetinstances}; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Readonly::Scalar my $DEFAULT_SCHEME => q{http}; |
63
|
|
|
|
|
|
|
Readonly::Scalar my $VALID_SCHEMES => $DEFAULT_SCHEME . q{s?}; # http(s) |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Readonly::Hash my %LOG => ( |
66
|
|
|
|
|
|
|
'GET_USERS' => q{Getting users for instance of '%s'}, |
67
|
|
|
|
|
|
|
'USING_URL' => q{Using URL '%s'}, |
68
|
|
|
|
|
|
|
'RESPONSE_CODE' => q{Got response code %s}, |
69
|
|
|
|
|
|
|
'DO_REQUEST' => q{Requesting %s '%s'}, |
70
|
|
|
|
|
|
|
'ALL_TRUE' => q{Requesting all widgets}, |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Readonly::Hash my %ERR => ( |
74
|
|
|
|
|
|
|
'NO_WIDGET_INSTANCE' => q{No Widget instance}, |
75
|
|
|
|
|
|
|
'NO_PROPERTIES_INSTANCE' => q{No properties instance}, |
76
|
|
|
|
|
|
|
'NO_USER_OBJECT' => q{No User object}, |
77
|
|
|
|
|
|
|
'NO_WIDGET_GUID' => q{No GUID nor widget object}, |
78
|
|
|
|
|
|
|
'MALFORMED_URL' => q{URL for supplied Wookie Server is malformed: %s}, |
79
|
|
|
|
|
|
|
'INCORRECT_PARTICIPANTS_REST_URL' => |
80
|
|
|
|
|
|
|
q{Participants rest URL is incorrect: %s}, |
81
|
|
|
|
|
|
|
'INCORRECT_PROPERTIES_REST_URL' => q{Properties rest URL is incorrect: %s}, |
82
|
|
|
|
|
|
|
'INVALID_API_KEY' => q{Invalid API key}, |
83
|
|
|
|
|
|
|
'HTTP' => q{%s<br />%s}, |
84
|
|
|
|
|
|
|
); |
85
|
|
|
|
|
|
|
## use critic |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
###l4p Log::Log4perl::easy_init($ERROR); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
###l4p has '_logger' => ( |
90
|
|
|
|
|
|
|
###l4p 'is' => 'ro', |
91
|
|
|
|
|
|
|
###l4p 'isa' => 'Log::Log4perl::Logger', |
92
|
|
|
|
|
|
|
###l4p 'default' => |
93
|
|
|
|
|
|
|
###l4p sub { Log::Log4perl->get_logger('WWW::Wookie::Connector::Service') }, |
94
|
|
|
|
|
|
|
###l4p 'reader' => 'getLogger', |
95
|
|
|
|
|
|
|
###l4p ); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
has '_conn' => ( |
98
|
|
|
|
|
|
|
'is' => 'rw', |
99
|
|
|
|
|
|
|
'isa' => 'WWW::Wookie::Server::Connection', |
100
|
|
|
|
|
|
|
'reader' => 'getConnection', |
101
|
|
|
|
|
|
|
'writer' => '_setConnection', |
102
|
|
|
|
|
|
|
); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
has '_locale' => ( |
105
|
|
|
|
|
|
|
'is' => 'rw', |
106
|
|
|
|
|
|
|
'isa' => 'Str', |
107
|
|
|
|
|
|
|
'reader' => 'getLocale', |
108
|
|
|
|
|
|
|
'writer' => 'setLocale', |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
112
|
|
|
|
|
|
|
sub getAvailableServices { |
113
|
|
|
|
|
|
|
## use critic |
114
|
1
|
|
|
1
|
1
|
874
|
my ( $self, $service_name ) = @_; |
115
|
1
|
|
|
|
|
4
|
my $url = $self->_append_path($SERVICES); |
116
|
1
|
|
|
|
|
44
|
__check_url( $url, $ERR{'MALFORMED_URL'} ); |
117
|
0
|
|
|
|
|
0
|
my $content = {}; |
118
|
0
|
0
|
|
|
|
0
|
if ($service_name) { |
119
|
0
|
|
|
|
|
0
|
$url .= $SLASH . URI::Escape::uri_escape($service_name); |
120
|
|
|
|
|
|
|
} |
121
|
0
|
0
|
|
|
|
0
|
if ( $self->getLocale ) { |
122
|
0
|
|
|
|
|
0
|
${$content}{'locale'} = $self->getLocale; |
|
0
|
|
|
|
|
0
|
|
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
0
|
my %services = (); |
126
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( $url, $content, $GET ); |
127
|
0
|
|
|
|
|
0
|
my $xml_obj = XML::Simple->new( |
128
|
|
|
|
|
|
|
'ForceArray' => 1, |
129
|
|
|
|
|
|
|
'KeyAttr' => { 'widget' => q{id}, 'service' => q{name} }, |
130
|
|
|
|
|
|
|
)->XMLin( $response->content ); |
131
|
0
|
|
|
|
|
0
|
while ( my ( $name, $value ) = each %{ ${$xml_obj}{'service'} } ) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
132
|
|
|
|
|
|
|
###l4p $self->getLogger->debug($name); |
133
|
0
|
|
|
|
|
0
|
my $service = WWW::Wookie::Widget::Category->new( 'name' => $name ); |
134
|
0
|
|
|
|
|
0
|
while ( my ( $id, $value ) = each %{ ${$value}{'widget'} } ) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
135
|
0
|
|
|
|
|
0
|
$service->put( |
136
|
|
|
|
|
|
|
WWW::Wookie::Widget->new( $id, $self->_parse_widget($value) ) ); |
137
|
|
|
|
|
|
|
} |
138
|
0
|
|
|
|
|
0
|
$services{$name} = $service; |
139
|
|
|
|
|
|
|
} |
140
|
0
|
|
|
|
|
0
|
return values %services; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
144
|
|
|
|
|
|
|
sub getAvailableWidgets { |
145
|
|
|
|
|
|
|
## use critic |
146
|
1
|
|
|
1
|
1
|
690
|
my ( $self, $service ) = @_; |
147
|
1
|
|
|
|
|
4
|
my %widgets = (); |
148
|
1
|
|
|
|
|
4
|
my $url = $self->_append_path($WIDGETS); |
149
|
1
|
|
|
|
|
16
|
my $content = {}; |
150
|
1
|
50
|
33
|
|
|
6
|
if ( !defined $service || $service eq $ALL ) { |
|
|
0
|
|
|
|
|
|
151
|
|
|
|
|
|
|
###l4p $self->getLogger->debug( $LOG{'ALL_TRUE'} ); |
152
|
1
|
|
|
|
|
3
|
${$content}{'all'} = q{true}; |
|
1
|
|
|
|
|
4
|
|
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
elsif ($service) { |
155
|
0
|
|
|
|
|
0
|
$url .= $SLASH . URI::Escape::uri_escape($service); |
156
|
|
|
|
|
|
|
} |
157
|
1
|
50
|
|
|
|
48
|
if ( $self->getLocale ) { |
158
|
0
|
|
|
|
|
0
|
${$content}{'locale'} = $self->getLocale; |
|
0
|
|
|
|
|
0
|
|
159
|
|
|
|
|
|
|
} |
160
|
1
|
|
|
|
|
6
|
__check_url( $url, $ERR{'MALFORMED_URL'} ); |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( $url, $content, $GET ); |
163
|
0
|
|
|
|
|
0
|
my $xml_obj = |
164
|
|
|
|
|
|
|
XML::Simple->new( 'ForceArray' => 1, 'KeyAttr' => 'id' ) |
165
|
|
|
|
|
|
|
->XMLin( $response->content ); |
166
|
0
|
|
|
|
|
0
|
while ( my ( $id, $value ) = each %{ ${$xml_obj}{'widget'} } ) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
167
|
|
|
|
|
|
|
$widgets{$id} = |
168
|
|
|
|
|
|
|
WWW::Wookie::Widget->new( $id, |
169
|
0
|
|
|
|
|
0
|
$self->_parse_widget( ${ ${$xml_obj}{'widget'} }{$id} ) ); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
170
|
|
|
|
|
|
|
} |
171
|
0
|
|
|
|
|
0
|
return values %widgets; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
has '_user' => ( |
175
|
|
|
|
|
|
|
'is' => 'ro', |
176
|
|
|
|
|
|
|
'isa' => 'WWW::Wookie::User', |
177
|
|
|
|
|
|
|
'reader' => '_getUser', |
178
|
|
|
|
|
|
|
'writer' => '_setUser', |
179
|
|
|
|
|
|
|
); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
182
|
|
|
|
|
|
|
sub getUser { |
183
|
|
|
|
|
|
|
## use critic |
184
|
1
|
|
|
1
|
1
|
4
|
my ( $self, $userid ) = @_; |
185
|
1
|
50
|
33
|
|
|
5
|
if ( defined $userid && $userid =~ /$TESTUSER(\d+)/gsmxi ) { |
186
|
0
|
|
|
|
|
0
|
return WWW::Wookie::User->new( $userid, qq{Test User $1} ); |
187
|
|
|
|
|
|
|
} |
188
|
1
|
|
|
|
|
34
|
return $self->_getUser; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
192
|
|
|
|
|
|
|
sub setUser { |
193
|
|
|
|
|
|
|
## use critic |
194
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $login, $screen ) = @_; |
195
|
0
|
|
|
|
|
0
|
$self->_setUser( WWW::Wookie::User->new( $login, $screen ) ); |
196
|
0
|
|
|
|
|
0
|
return; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
has 'WidgetInstances' => ( |
200
|
|
|
|
|
|
|
'is' => 'rw', |
201
|
|
|
|
|
|
|
'isa' => 'WWW::Wookie::Widget::Instances', |
202
|
|
|
|
|
|
|
'default' => sub { WWW::Wookie::Widget::Instances->new() }, |
203
|
|
|
|
|
|
|
'writer' => '_setWidgetInstances', |
204
|
|
|
|
|
|
|
); |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
207
|
|
|
|
|
|
|
sub getWidget { |
208
|
|
|
|
|
|
|
## use critic |
209
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $widget_id ) = @_; |
210
|
|
|
|
|
|
|
my @widgets = |
211
|
0
|
|
|
|
|
0
|
grep { $_->getIdentifier eq $widget_id } $self->getAvailableWidgets; |
|
0
|
|
|
|
|
0
|
|
212
|
0
|
|
|
|
|
0
|
return shift @widgets; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
## no critic qw(ProhibitCommentedOutCode) |
215
|
|
|
|
|
|
|
# API method isn't implemented using proper id on the server. |
216
|
|
|
|
|
|
|
#my $url = $self->_append_path($WIDGETS); |
217
|
|
|
|
|
|
|
#if ( defined $widget_id ) { |
218
|
|
|
|
|
|
|
# $url .= $SLASH . URI::Escape::uri_escape($widget_id); |
219
|
|
|
|
|
|
|
#} |
220
|
|
|
|
|
|
|
#__check_url($url, $ERR{'MALFORMED_URL'}); |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
#my $response = $self->_do_request( $url, {}, $GET ); |
223
|
|
|
|
|
|
|
#my $xs = XML::Simple->new( 'ForceArray' => 1, 'KeyAttr' => 'id' ); |
224
|
|
|
|
|
|
|
#my $xml_obj = $xs->XMLin( $response->content ); |
225
|
|
|
|
|
|
|
#return WWW::Wookie::Widget->new( $widget_id, |
226
|
|
|
|
|
|
|
# $self->_parse_widget($xml_obj) ); |
227
|
|
|
|
|
|
|
## use critic |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
231
|
|
|
|
|
|
|
sub getOrCreateInstance { |
232
|
|
|
|
|
|
|
## use critic |
233
|
2
|
|
|
2
|
1
|
973
|
my ( $self, $widget_or_guid ) = @_; |
234
|
2
|
|
|
|
|
6
|
my $guid = $widget_or_guid; |
235
|
2
|
50
|
|
|
|
9
|
if ( q{WWW::Wookie::Widget} eq ref $widget_or_guid ) { |
236
|
0
|
|
|
|
|
0
|
$guid = $widget_or_guid->getIdentifier; |
237
|
|
|
|
|
|
|
} |
238
|
2
|
|
|
|
|
3
|
my $result = eval { |
239
|
2
|
100
|
66
|
|
|
14
|
if ( defined $guid && $guid eq $EMPTY ) { |
240
|
|
|
|
|
|
|
## no critic qw(RequireExplicitInclusion) |
241
|
|
|
|
|
|
|
WookieConnectorException->throw( |
242
|
1
|
|
|
|
|
10
|
'error' => $ERR{'NO_WIDGET_GUID'} ); |
243
|
|
|
|
|
|
|
## use critic |
244
|
|
|
|
|
|
|
} |
245
|
1
|
|
|
|
|
4
|
my $url = $self->_append_path($WIDGETINSTANCES); |
246
|
1
|
|
|
|
|
24
|
__check_url( $url, $ERR{'MALFORMED_URL'} ); |
247
|
0
|
|
|
|
|
0
|
my $content = { 'widgetid' => $guid }; |
248
|
0
|
0
|
|
|
|
0
|
if ( my $locale = $self->getLocale ) { |
249
|
0
|
|
|
|
|
0
|
${$content}{'locale'} = $locale; |
|
0
|
|
|
|
|
0
|
|
250
|
|
|
|
|
|
|
} |
251
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( $url, $content ); |
252
|
0
|
0
|
|
|
|
0
|
if ( $response->code == HTTP_CREATED ) { |
253
|
0
|
|
|
|
|
0
|
$response = $self->_do_request( $url, $content ); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
0
|
my $instance = $self->_parse_instance( $guid, $response->content ); |
257
|
0
|
0
|
|
|
|
0
|
if ($instance) { |
258
|
0
|
|
|
|
|
0
|
$self->WidgetInstances->put($instance); |
259
|
0
|
|
|
|
|
0
|
$self->addParticipant( $instance, $self->getUser ); |
260
|
|
|
|
|
|
|
} |
261
|
0
|
|
|
|
|
0
|
return $instance; |
262
|
|
|
|
|
|
|
}; |
263
|
|
|
|
|
|
|
|
264
|
2
|
50
|
|
|
|
1112
|
if ( my $e = Exception::Class->caught('WookieConnectorException') ) { |
265
|
|
|
|
|
|
|
###l4p $self->getLogger->error( $e->error ); |
266
|
2
|
|
|
|
|
45
|
$e->rethrow; |
267
|
0
|
|
|
|
|
0
|
return $FALSE; |
268
|
|
|
|
|
|
|
} |
269
|
0
|
|
|
|
|
0
|
return $result; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
273
|
|
|
|
|
|
|
sub getUsers { |
274
|
|
|
|
|
|
|
## use critic |
275
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $instance ) = @_; |
276
|
0
|
0
|
|
|
|
0
|
if ( ref $instance ne q{WWW::Wookie::Widget::Instance} ) { |
277
|
0
|
|
|
|
|
0
|
$instance = $self->getOrCreateInstance($instance); |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
###l4p $self->getLogger->debug( sprintf $LOG{'GET_USERS'}, |
280
|
|
|
|
|
|
|
###l4p $instance->getIdentifier ); |
281
|
0
|
|
|
|
|
0
|
my $url = $self->_append_path($PARTICIPANTS); |
282
|
|
|
|
|
|
|
###l4p $self->getLogger->debug( sprintf $LOG{'USING_URL'}, $url ); |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
0
|
__check_url( $url, $ERR{'MALFORMED_URL'} ); |
285
|
0
|
|
|
|
|
0
|
my $response = |
286
|
|
|
|
|
|
|
$self->_do_request( $url, { 'widgetid' => $instance->getIdentifier, }, |
287
|
|
|
|
|
|
|
$GET, ); |
288
|
|
|
|
|
|
|
|
289
|
0
|
0
|
|
|
|
0
|
if ( $response->code > HTTP_OK ) { |
290
|
0
|
|
|
|
|
0
|
__throw_http_err($response); |
291
|
|
|
|
|
|
|
} |
292
|
0
|
|
|
|
|
0
|
my $xml_obj = |
293
|
|
|
|
|
|
|
XML::Simple->new( 'ForceArray' => 1, 'KeyAttr' => 'id' ) |
294
|
|
|
|
|
|
|
->XMLin( $response->content ); |
295
|
0
|
|
|
|
|
0
|
my @users = (); |
296
|
0
|
|
|
|
|
0
|
while ( my ( $id, $value ) = each %{ ${$xml_obj}{'participant'} } ) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
297
|
|
|
|
|
|
|
my $new_user = WWW::Wookie::User->new( |
298
|
|
|
|
|
|
|
$id, |
299
|
|
|
|
|
|
|
defined ${$value}{'displayName'} || $id, |
300
|
0
|
|
0
|
|
|
0
|
defined ${$value}{'thumbnail_url'} || $EMPTY, |
|
|
|
0
|
|
|
|
|
301
|
|
|
|
|
|
|
); |
302
|
0
|
|
|
|
|
0
|
push @users, $new_user; |
303
|
|
|
|
|
|
|
} |
304
|
0
|
|
|
|
|
0
|
return @users; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
308
|
|
|
|
|
|
|
sub addProperty { |
309
|
|
|
|
|
|
|
## use critic |
310
|
1
|
|
|
1
|
1
|
4
|
my ( $self, $widget, $property ) = @_; |
311
|
1
|
|
|
|
|
12
|
my $url = $self->_append_path($PROPERTIES); |
312
|
1
|
|
|
|
|
22
|
__check_url( $url, $ERR{'INCORRECT_PROPERTIES_REST_URL'} ); |
313
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( |
314
|
|
|
|
|
|
|
$url, |
315
|
|
|
|
|
|
|
{ |
316
|
|
|
|
|
|
|
'widgetid' => $widget->getIdentifier, |
317
|
|
|
|
|
|
|
'propertyname' => $property->getName, |
318
|
|
|
|
|
|
|
'propertyvalue' => $property->getValue, |
319
|
|
|
|
|
|
|
'is_public' => $property->getIsPublic, |
320
|
|
|
|
|
|
|
}, |
321
|
|
|
|
|
|
|
$POST, |
322
|
|
|
|
|
|
|
); |
323
|
0
|
0
|
0
|
|
|
0
|
if ( $response->code == HTTP_OK || $response->code == HTTP_CREATED ) { |
|
|
0
|
|
|
|
|
|
324
|
0
|
|
|
|
|
0
|
return $TRUE; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
elsif ( $response->code > HTTP_CREATED ) { |
327
|
0
|
|
|
|
|
0
|
return $response->content; |
328
|
|
|
|
|
|
|
} |
329
|
0
|
|
|
|
|
0
|
return $FALSE; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
333
|
|
|
|
|
|
|
sub getProperty { |
334
|
|
|
|
|
|
|
## use critic |
335
|
4
|
|
|
4
|
1
|
18
|
my ( $self, $widget_instance, $property_instance ) = @_; |
336
|
4
|
|
|
|
|
13
|
my $url = $self->_append_path($PROPERTIES); |
337
|
4
|
|
|
|
|
138
|
__check_widget($widget_instance); |
338
|
3
|
|
|
|
|
10
|
__check_property($property_instance); |
339
|
2
|
|
|
|
|
10
|
__check_url( $url, $ERR{'MALFORMED_URL'} ); |
340
|
1
|
|
|
|
|
41
|
my $response = $self->_do_request( |
341
|
|
|
|
|
|
|
$url, |
342
|
|
|
|
|
|
|
{ |
343
|
|
|
|
|
|
|
'widgetid' => $widget_instance->getIdentifier, |
344
|
|
|
|
|
|
|
'propertyname' => $property_instance->getName, |
345
|
|
|
|
|
|
|
}, |
346
|
|
|
|
|
|
|
$GET, |
347
|
|
|
|
|
|
|
); |
348
|
1
|
50
|
|
|
|
7
|
if ( !$response->is_success ) { |
349
|
1
|
|
|
|
|
16
|
__throw_http_err($response); |
350
|
0
|
|
|
|
|
0
|
return $FALSE; |
351
|
|
|
|
|
|
|
} |
352
|
0
|
|
|
|
|
0
|
return WWW::Wookie::Widget::Property->new( $property_instance->getName, |
353
|
|
|
|
|
|
|
$response->content ); |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
358
|
|
|
|
|
|
|
sub setProperty { |
359
|
|
|
|
|
|
|
## use critic |
360
|
3
|
|
|
3
|
1
|
810
|
my ( $self, $widget, $property ) = @_; |
361
|
3
|
|
|
|
|
9
|
my $url = $self->_append_path($PROPERTIES); |
362
|
3
|
|
|
|
|
45
|
my $result = eval { |
363
|
3
|
|
|
|
|
13
|
__check_widget($widget); |
364
|
2
|
|
|
|
|
7
|
__check_property($property); |
365
|
1
|
|
|
|
|
6
|
__check_url( $url, $ERR{'INCORRECT_PROPERTIES_REST_URL'} ); |
366
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( |
367
|
|
|
|
|
|
|
$url, |
368
|
|
|
|
|
|
|
{ |
369
|
|
|
|
|
|
|
'widgetid' => $widget->getIdentifier, |
370
|
|
|
|
|
|
|
'propertyname' => $property->getName, |
371
|
|
|
|
|
|
|
'propertyvalue' => $property->getValue, |
372
|
|
|
|
|
|
|
'is_public' => $property->getIsPublic, |
373
|
|
|
|
|
|
|
}, |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
## no critic qw(ProhibitFlagComments) |
376
|
|
|
|
|
|
|
# TODO: $PUT breaks, but should be used instead of $POST |
377
|
|
|
|
|
|
|
## use critic |
378
|
|
|
|
|
|
|
$POST, |
379
|
|
|
|
|
|
|
); |
380
|
0
|
0
|
0
|
|
|
0
|
if ( $response->code == HTTP_CREATED || $response == HTTP_OK ) { |
381
|
0
|
|
|
|
|
0
|
return $property; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
else { |
384
|
0
|
|
|
|
|
0
|
__throw_http_err($response); |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
}; |
387
|
3
|
100
|
|
|
|
1732
|
if ( my $e = Exception::Class->caught('WookieConnectorException') ) { |
388
|
|
|
|
|
|
|
###l4p $self->getLogger->error( $e->error ); |
389
|
2
|
|
|
|
|
37
|
$e->rethrow; |
390
|
0
|
|
|
|
|
0
|
return $FALSE; |
391
|
|
|
|
|
|
|
} |
392
|
1
|
50
|
|
|
|
16
|
if ( my $e = Exception::Class->caught('WookieWidgetInstanceException') ) { |
393
|
|
|
|
|
|
|
###l4p $self->getLogger->error( $e->error ); |
394
|
1
|
|
|
|
|
27
|
$e->rethrow; |
395
|
0
|
|
|
|
|
0
|
return $FALSE; |
396
|
|
|
|
|
|
|
} |
397
|
0
|
|
|
|
|
0
|
return $result; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
401
|
|
|
|
|
|
|
sub deleteProperty { |
402
|
|
|
|
|
|
|
## use critic |
403
|
3
|
|
|
3
|
1
|
18
|
my ( $self, $widget, $property ) = @_; |
404
|
3
|
|
|
|
|
10
|
my $url = $self->_append_path($PROPERTIES); |
405
|
3
|
|
|
|
|
80
|
__check_url( $url, $ERR{'INCORRECT_PROPERTIES_REST_URL'} ); |
406
|
2
|
|
|
|
|
9
|
__check_widget($widget); |
407
|
1
|
|
|
|
|
4
|
__check_property($property); |
408
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( |
409
|
|
|
|
|
|
|
$url, |
410
|
|
|
|
|
|
|
{ |
411
|
|
|
|
|
|
|
'widgetid' => $widget->getIdentifier, |
412
|
|
|
|
|
|
|
'propertyname' => $property->getName, |
413
|
|
|
|
|
|
|
}, |
414
|
|
|
|
|
|
|
$DELETE, |
415
|
|
|
|
|
|
|
); |
416
|
0
|
0
|
|
|
|
0
|
if ( $response->code == HTTP_OK ) { |
417
|
0
|
|
|
|
|
0
|
return $TRUE; |
418
|
|
|
|
|
|
|
} |
419
|
0
|
|
|
|
|
0
|
return $FALSE; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
423
|
|
|
|
|
|
|
sub addParticipant { |
424
|
|
|
|
|
|
|
## use critic |
425
|
2
|
|
|
2
|
1
|
727
|
my ( $self, $widget_instance, $user ) = @_; |
426
|
2
|
|
|
|
|
7
|
__check_widget($widget_instance); |
427
|
1
|
|
|
|
|
3
|
my $url = $self->_append_path($PARTICIPANTS); |
428
|
1
|
|
|
|
|
20
|
__check_url( $url, $ERR{'INCORRECT_PARTICIPANTS_REST_URL'} ); |
429
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( |
430
|
|
|
|
|
|
|
$url, |
431
|
|
|
|
|
|
|
{ |
432
|
|
|
|
|
|
|
'widgetid' => $widget_instance->getIdentifier, |
433
|
|
|
|
|
|
|
'participant_id' => $self->getUser->getLoginName, |
434
|
|
|
|
|
|
|
'participant_display_name' => $user->getScreenName, |
435
|
|
|
|
|
|
|
'participant_thumbnail_url' => $user->getThumbnailUrl, |
436
|
|
|
|
|
|
|
}, |
437
|
|
|
|
|
|
|
); |
438
|
0
|
0
|
|
|
|
0
|
if ( $response->code == HTTP_OK ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
439
|
0
|
|
|
|
|
0
|
return $TRUE; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
elsif ( $response->code == HTTP_CREATED ) { |
442
|
0
|
|
|
|
|
0
|
return $TRUE; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
elsif ( $response->code > HTTP_CREATED ) { |
445
|
0
|
|
|
|
|
0
|
return $response->content; |
446
|
|
|
|
|
|
|
} |
447
|
0
|
|
|
|
|
0
|
return $FALSE; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
451
|
|
|
|
|
|
|
sub deleteParticipant { |
452
|
|
|
|
|
|
|
## use critic |
453
|
2
|
|
|
2
|
1
|
706
|
my ( $self, $widget, $user ) = @_; |
454
|
2
|
|
|
|
|
6
|
__check_widget($widget); |
455
|
1
|
|
|
|
|
4
|
my $url = $self->_append_path($PARTICIPANTS); |
456
|
1
|
|
|
|
|
20
|
__check_url( $url, $ERR{'INCORRECT_PARTICIPANTS_REST_URL'} ); |
457
|
0
|
|
|
|
|
0
|
my $response = $self->_do_request( |
458
|
|
|
|
|
|
|
$url, |
459
|
|
|
|
|
|
|
{ |
460
|
|
|
|
|
|
|
'widgetid' => $widget->getIdentifier, |
461
|
|
|
|
|
|
|
'participant_id' => $self->getUser->getLoginName, |
462
|
|
|
|
|
|
|
'participant_display_name' => $user->getScreenName, |
463
|
|
|
|
|
|
|
'participant_thumbnail_url' => $user->getThumbnailUrl, |
464
|
|
|
|
|
|
|
}, |
465
|
|
|
|
|
|
|
$DELETE, |
466
|
|
|
|
|
|
|
); |
467
|
0
|
0
|
|
|
|
0
|
if ( $response->code == HTTP_OK ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
468
|
0
|
|
|
|
|
0
|
return $TRUE; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
elsif ( $response->code == HTTP_CREATED ) { |
471
|
0
|
|
|
|
|
0
|
return $TRUE; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
elsif ( $response->code > HTTP_CREATED ) { |
474
|
0
|
|
|
|
|
0
|
__throw_http_err($response); |
475
|
|
|
|
|
|
|
} |
476
|
0
|
|
|
|
|
0
|
return $FALSE; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
## no critic qw(Capitalization) |
480
|
|
|
|
|
|
|
sub _setWidgetInstancesHolder { |
481
|
|
|
|
|
|
|
## use critic |
482
|
9
|
|
|
9
|
|
16
|
my $self = shift; |
483
|
9
|
|
|
|
|
301
|
$self->_setWidgetInstances( WWW::Wookie::Widget::Instances->new ); |
484
|
9
|
|
|
|
|
39
|
return; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
has '_ua' => ( |
488
|
|
|
|
|
|
|
'is' => 'rw', |
489
|
|
|
|
|
|
|
'isa' => 'LWP::UserAgent', |
490
|
|
|
|
|
|
|
'default' => sub { |
491
|
|
|
|
|
|
|
LWP::UserAgent->new( |
492
|
|
|
|
|
|
|
'timeout' => $TIMEOUT, |
493
|
|
|
|
|
|
|
'agent' => $AGENT, |
494
|
|
|
|
|
|
|
); |
495
|
|
|
|
|
|
|
}, |
496
|
|
|
|
|
|
|
); |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
around 'BUILDARGS' => sub { |
499
|
|
|
|
|
|
|
my $orig = shift; |
500
|
|
|
|
|
|
|
my $class = shift; |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
if ( @_ == $MORE_ARGS ) { |
503
|
|
|
|
|
|
|
push @_, $EMPTY; |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
if ( @_ == $MOST_ARGS && !ref $_[0] ) { |
506
|
|
|
|
|
|
|
my ( $url, $api_key, $shareddata_key, $loginname, $screenname ) = @_; |
507
|
|
|
|
|
|
|
return $class->$orig( |
508
|
|
|
|
|
|
|
'_user' => WWW::Wookie::User->new( $loginname, $screenname ), |
509
|
|
|
|
|
|
|
'_conn' => WWW::Wookie::Server::Connection->new( |
510
|
|
|
|
|
|
|
$url, $api_key, $shareddata_key, |
511
|
|
|
|
|
|
|
), |
512
|
|
|
|
|
|
|
); |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
return $class->$orig(@_); |
515
|
|
|
|
|
|
|
}; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub BUILD { |
518
|
9
|
|
|
9
|
1
|
936
|
my $self = shift; |
519
|
9
|
|
|
|
|
38
|
$self->_setWidgetInstancesHolder; |
520
|
9
|
|
|
|
|
237
|
return; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
sub _append_path { |
524
|
16
|
|
|
16
|
|
43
|
my ( $self, $path ) = @_; |
525
|
16
|
|
|
|
|
571
|
return $self->getConnection->getURL . URI::Escape::uri_escape($path); |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub __check_url { |
529
|
|
|
|
|
|
|
my ( $url, $message ) = @_; |
530
|
|
|
|
|
|
|
if ( $url !~ m{^$RE{URI}{HTTP}{-keep}{ '-scheme' => $VALID_SCHEMES }$}smx ) |
531
|
|
|
|
|
|
|
{ |
532
|
|
|
|
|
|
|
## no critic qw(RequireExplicitInclusion) |
533
|
|
|
|
|
|
|
WookieConnectorException->throw( 'error' => sprintf $message, $url ); |
534
|
|
|
|
|
|
|
## use critic |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
return; |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub __check_widget { |
540
|
|
|
|
|
|
|
my ($ref) = @_; |
541
|
|
|
|
|
|
|
if ( ref $ref ne q{WWW::Wookie::Widget::Instance} ) { |
542
|
|
|
|
|
|
|
## no critic qw(RequireExplicitInclusion) |
543
|
|
|
|
|
|
|
WookieWidgetInstanceException->throw( |
544
|
|
|
|
|
|
|
## use critic |
545
|
|
|
|
|
|
|
'error' => $ERR{'NO_WIDGET_INSTANCE'}, |
546
|
|
|
|
|
|
|
); |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
return; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub __check_property { |
552
|
|
|
|
|
|
|
my ($ref) = @_; |
553
|
|
|
|
|
|
|
if ( ref $ref ne q{WWW::Wookie::Widget::Property} ) { |
554
|
|
|
|
|
|
|
## no critic qw(RequireExplicitInclusion) |
555
|
|
|
|
|
|
|
WookieConnectorException->throw( |
556
|
|
|
|
|
|
|
## use critic |
557
|
|
|
|
|
|
|
'error' => $ERR{'NO_PROPERTIES_INSTANCE'}, |
558
|
|
|
|
|
|
|
); |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
return; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub __throw_http_err { |
564
|
|
|
|
|
|
|
my ($response) = @_; |
565
|
|
|
|
|
|
|
## no critic qw(RequireExplicitInclusion) |
566
|
|
|
|
|
|
|
WookieConnectorException->throw( |
567
|
|
|
|
|
|
|
## use critic |
568
|
|
|
|
|
|
|
'error' => sprintf $ERR{'HTTP'}, |
569
|
|
|
|
|
|
|
$response->headers->as_string, $response->content, |
570
|
|
|
|
|
|
|
); |
571
|
|
|
|
|
|
|
return; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub _do_request { |
575
|
1
|
|
|
1
|
|
5
|
my ( $self, $url, $payload, $method ) = @_; |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
# Widgets and Services request doesn't require API key stuff: |
578
|
1
|
50
|
|
|
|
8
|
if ( $url !~ m{/(?:widgets|services)(?:[?/]|$)}gismx ) { |
579
|
|
|
|
|
|
|
$payload = { |
580
|
|
|
|
|
|
|
'api_key' => $self->getConnection->getApiKey, |
581
|
|
|
|
|
|
|
'shareddatakey' => $self->getConnection->getSharedDataKey, |
582
|
|
|
|
|
|
|
'userid' => $self->getUser->getLoginName, |
583
|
1
|
|
|
|
|
34
|
%{$payload}, |
|
1
|
|
|
|
|
6
|
|
584
|
|
|
|
|
|
|
}; |
585
|
|
|
|
|
|
|
} |
586
|
1
|
50
|
|
|
|
5
|
if ( !defined $method ) { |
587
|
0
|
|
|
|
|
0
|
$method = $POST; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
|
590
|
1
|
50
|
|
|
|
2
|
if ( ( my $content = [ POST $url, [ %{$payload} ] ]->[0]->content ) ne |
|
1
|
|
|
|
|
9
|
|
591
|
|
|
|
|
|
|
$EMPTY ) |
592
|
|
|
|
|
|
|
{ |
593
|
1
|
|
|
|
|
8978
|
$url .= $QUERY . $content; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
###l4p $self->getLogger->debug( sprintf $LOG{'DO_REQUEST'}, $method, $url ); |
596
|
1
|
|
|
|
|
13
|
my $request = HTTP::Request->new( |
597
|
|
|
|
|
|
|
$method => $url, |
598
|
|
|
|
|
|
|
HTTP::Headers->new(), |
599
|
|
|
|
|
|
|
); |
600
|
1
|
|
|
|
|
217
|
my $response = $self->_ua->request($request); |
601
|
|
|
|
|
|
|
###l4p $self->getLogger->debug( sprintf $LOG{'RESPONSE_CODE'}, $response->code ); |
602
|
1
|
50
|
33
|
|
|
46558
|
if ( $response->code == HTTP_UNAUTHORIZED |
603
|
|
|
|
|
|
|
|| $response->code == HTTP_FORBIDDEN ) |
604
|
|
|
|
|
|
|
{ |
605
|
|
|
|
|
|
|
## no critic qw(RequireExplicitInclusion) |
606
|
0
|
|
|
|
|
0
|
WookieConnectorException->throw( 'error' => $ERR{'INVALID_API_KEY'} ); |
607
|
|
|
|
|
|
|
## use critic |
608
|
|
|
|
|
|
|
} |
609
|
1
|
|
|
|
|
35
|
return $response; |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
sub _parse_instance { |
613
|
0
|
|
|
0
|
|
|
my ( $self, $guid, $xml ) = @_; |
614
|
0
|
|
|
|
|
|
my $xml_obj = |
615
|
|
|
|
|
|
|
XML::Simple->new( 'ForceArray' => 1, 'KeyAttr' => 'id' )->XMLin($xml); |
616
|
0
|
0
|
|
|
|
|
if ( |
617
|
|
|
|
|
|
|
my $instance = WWW::Wookie::Widget::Instance->new( |
618
|
0
|
|
|
|
|
|
${$xml_obj}{'url'}[0], $guid, |
619
|
0
|
|
|
|
|
|
${$xml_obj}{'title'}[0], ${$xml_obj}{'height'}[0], |
|
0
|
|
|
|
|
|
|
620
|
0
|
|
|
|
|
|
${$xml_obj}{'width'}[0], |
621
|
|
|
|
|
|
|
) |
622
|
|
|
|
|
|
|
) |
623
|
|
|
|
|
|
|
{ |
624
|
0
|
|
|
|
|
|
$self->WidgetInstances->put($instance); |
625
|
0
|
|
|
|
|
|
$self->addParticipant( $instance, $self->getUser ); |
626
|
0
|
|
|
|
|
|
return $instance; |
627
|
|
|
|
|
|
|
} |
628
|
0
|
|
|
|
|
|
return; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
sub _parse_widget { |
632
|
0
|
|
|
0
|
|
|
my ( $self, $xml ) = @_; |
633
|
0
|
|
|
|
|
|
my $title = ${ ${$xml}{'name'}[0] }{'content'}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
my $description = |
635
|
0
|
|
|
|
|
|
ref ${$xml}{'description'}[0] |
636
|
0
|
|
|
|
|
|
? ${ ${$xml}{'description'}[0] }{'content'} |
|
0
|
|
|
|
|
|
|
637
|
0
|
0
|
|
|
|
|
: ${$xml}{'description'}[0]; |
|
0
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
my $icon = |
639
|
0
|
|
|
|
|
|
ref ${$xml}{'icon'}[0] |
640
|
0
|
|
|
|
|
|
? ${ ${$xml}{'icon'}[0] }{'content'} |
|
0
|
|
|
|
|
|
|
641
|
0
|
0
|
|
|
|
|
: ${$xml}{'icon'}[0]; |
|
0
|
|
|
|
|
|
|
642
|
0
|
0
|
|
|
|
|
if ( !$icon ) { |
643
|
0
|
|
|
|
|
|
$icon = $DEFAULT_ICON; |
644
|
|
|
|
|
|
|
} |
645
|
0
|
|
|
|
|
|
return ( $title, $description, $icon ); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
with 'WWW::Wookie::Connector::Service::Interface'; |
649
|
|
|
|
|
|
|
|
650
|
4
|
|
|
4
|
|
39
|
no Moose; |
|
4
|
|
|
|
|
22
|
|
|
4
|
|
|
|
|
39
|
|
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
1; |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
__END__ |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=encoding utf8 |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=for stopwords Bitbucket API Readonly Wookie guid Ipenburg login MERCHANTABILITY |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head1 NAME |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
WWW::Wookie::Connector::Service - Wookie connector service, handles all the |
665
|
|
|
|
|
|
|
data requests and responses |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=head1 VERSION |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
This document describes WWW::Wookie::Connector::Service version C<v1.1.4> |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=head1 SYNOPSIS |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
use WWW::Wookie::Connector::Service; |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=head1 DESCRIPTION |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
This module is an implementation of the |
680
|
|
|
|
|
|
|
L<WWW::Wookie::Connector::Service::Interface |
681
|
|
|
|
|
|
|
|WWW::Wookie::Connector::Service::Interface/"SUBROUTINES/METHODS">. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=head2 C<new> |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
Create a new connector |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=over |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
=item 1. URL to Wookie host as string |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=item 2. Wookie API key as string |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=item 3. Shared data key to use as string |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=item 4. User login name |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=item 5. User display name |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=back |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=head2 C<getAvailableServices> |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
Get a all available service categories in the server. Returns an array of |
704
|
|
|
|
|
|
|
L<WWWW::Wookie::Widget::Category|WW::Wookie::Widget::Category> objects. |
705
|
|
|
|
|
|
|
Throws a C<WookieConnectorException>. |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=head2 C<getAvailableWidgets> |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
Get all available widgets in the server, or only the available widgets in the |
710
|
|
|
|
|
|
|
specified service category. Returns an array of |
711
|
|
|
|
|
|
|
L<WWW::Wookie::Widget|WWW::Wookie::Widget> objects, otherwise false. Throws a |
712
|
|
|
|
|
|
|
C<WookieConnectorException>. |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=over |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=item 1. Service category name as string |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=back |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=head2 C<getWidget> |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Get the details of the widget specified by it's identifier. Returns a |
723
|
|
|
|
|
|
|
L<WWW::Wookie::Widget|WWW::Wookie::Widget> object. |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=over |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=item 1. The identifier of an available widget |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=back |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head2 C<getConnection> |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
Get the currently active connection to the Wookie server. Returns a |
734
|
|
|
|
|
|
|
L<WWW::Wookie::Server::Connection|WWW::Wookie::Server::Connection> object. |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
=head2 C<setUser> |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Set the current user. |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=over |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=item 1. User name for the current Wookie connection |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=item 2. Screen name for the current Wookie connection |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=back |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=head2 C<getUser> |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Retrieve the details of the current user. Returns an instance of the user as a |
751
|
|
|
|
|
|
|
L<WWW::Wookie::User|WWW::Wookie::User> object. |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=head2 C<getOrCreateInstance> |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
Get or create a new instance of a widget. The current user will be added as a |
756
|
|
|
|
|
|
|
participant. Returns a |
757
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object if |
758
|
|
|
|
|
|
|
successful, otherwise false. Throws a C<WookieConnectorException>. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=over |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=item 1. Widget as guid string or a L<WWW::Wookie::Widget|WWW::Wookie::Widget> |
763
|
|
|
|
|
|
|
object |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=back |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head2 C<addParticipant> |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
Add a participant to a widget. Returns true if successful, otherwise false. |
770
|
|
|
|
|
|
|
Throws a C<WookieWidgetInstanceException> or a C<WookieConnectorException>. |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=over |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=item 1. Instance of widget as |
775
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=item 2. Instance of user as L<WWW::Wookie::User|WWW::Wookie::User> object |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=back |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=head2 C<deleteParticipant> |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
Delete a participant. Returns true if successful, otherwise false. Throws a |
784
|
|
|
|
|
|
|
C<WookieWidgetInstanceException> or a C<WookieConnectorException>. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=over |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=item 1. Instance of widget as |
789
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=item 2. Instance of user as L<WWW::Wookie::User|WWW::Wookie::User> object |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=back |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=head2 C<getUsers> |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
Get all participants of the current widget. Returns an array of |
798
|
|
|
|
|
|
|
L<WWW::Wookie::User|WWW::Wookie::User> instances. Throws a |
799
|
|
|
|
|
|
|
C<WookieConnectorException>. |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=over |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=item 1. Instance of widget as |
804
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
=back |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=head2 C<addProperty> |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Adds a new property. Returns true if successful, otherwise false. Throws a |
811
|
|
|
|
|
|
|
C<WookieConnectorException>. |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=over |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=item 1. Instance of widget as |
816
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=item 2. Instance of property as |
819
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=back |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=head2 C<setProperty> |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
Set a new property. Returns the property as |
826
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> if successful, |
827
|
|
|
|
|
|
|
otherwise false. Throws a C<WookieWidgetInstanceException> or a |
828
|
|
|
|
|
|
|
C<WookieConnectorException>. |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=over |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
=item 1. Instance of widget as |
833
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item 2. Instance of property as |
836
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=back |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=head2 C<getProperty> |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
Get a property. Returns the property as |
843
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> if successful, |
844
|
|
|
|
|
|
|
otherwise false. Throws a C<WookieWidgetInstanceException> or a |
845
|
|
|
|
|
|
|
C<WookieConnectorException>. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=over |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=item 1. Instance of widget as |
850
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=item 2. Instance of property as |
853
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=back |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=head2 C<deleteProperty> |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
Delete a property. Returns true if successful, otherwise false. Throws a |
860
|
|
|
|
|
|
|
C<WookieWidgetInstanceException> or a C<WookieConnectorException>. |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=over |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=item 1. Instance of widget as |
865
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=item 2. Instance of property as |
868
|
|
|
|
|
|
|
L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=back |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=head2 C<setLocale> |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Set a locale. |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=over |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=item 1. Locale as string |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
=back |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=head2 C<getLocale> |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
Get the current locale setting. Returns current locale as string. |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
=head2 C<BUILD> |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
The Moose internal BUILD method. |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=over 4 |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=item * L<HTTP::Headers|HTTP::Headers> |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item * L<HTTP::Request|HTTP::Request> |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=item * L<HTTP::Request::Common|HTTP::Request::Common> |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=item * L<HTTP::Status|HTTP::Status> |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=item * L<LWP::UserAgent|LWP::UserAgent> |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=item * L<Log::Log4perl|Log::Log4perl> |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
=item * L<Moose|Moose> |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
=item * L<Moose::Util::TypeConstraints|Moose::Util::TypeConstraints> |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=item * L<Readonly|Readonly> |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=item * L<Regexp::Common|Regexp::Common> |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=item * L<WWW::Wookie::Connector::Exceptions|WWW::Wookie::Connector::Exceptions> |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=item * L<WWW::Wookie::Server::Connection|WWW::Wookie::Server::Connection> |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
=item * L<WWW::Wookie::User|WWW::Wookie::User> |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=item * L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=item * L<WWW::Wookie::Widget::Instances|WWW::Wookie::Widget::Instances> |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=item * L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=item * L<WWW::Wookie::Widget|WWW::Wookie::Widget> |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=item * L<XML::Simple|XML::Simple> |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=item * L<namespace::autoclean|namespace::autoclean> |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=back |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Please report any bugs or feature requests at |
943
|
|
|
|
|
|
|
L<Bitbucket|https://bitbucket.org/rolandvanipenburg/www-wookie/issues>. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=head1 AUTHOR |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
Roland van Ipenburg, E<lt>roland@rolandvanipenburg.comE<gt> |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
Copyright 2010-2021 by Roland van Ipenburg |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
954
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.14.0 or, |
955
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTY |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
960
|
|
|
|
|
|
|
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN |
961
|
|
|
|
|
|
|
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES |
962
|
|
|
|
|
|
|
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER |
963
|
|
|
|
|
|
|
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
964
|
|
|
|
|
|
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE |
965
|
|
|
|
|
|
|
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH |
966
|
|
|
|
|
|
|
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL |
967
|
|
|
|
|
|
|
NECESSARY SERVICING, REPAIR, OR CORRECTION. |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
970
|
|
|
|
|
|
|
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
971
|
|
|
|
|
|
|
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE |
972
|
|
|
|
|
|
|
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, |
973
|
|
|
|
|
|
|
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE |
974
|
|
|
|
|
|
|
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING |
975
|
|
|
|
|
|
|
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A |
976
|
|
|
|
|
|
|
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF |
977
|
|
|
|
|
|
|
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF |
978
|
|
|
|
|
|
|
SUCH DAMAGES. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=cut |