File Coverage

blib/lib/WWW/Wookie/Connector/Service.pm
Criterion Covered Total %
statement 153 283 54.0
branch 15 70 21.4
condition 5 24 20.8
subroutine 39 44 88.6
pod 14 14 100.0
total 226 435 51.9


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.3;
4 4     4   241970 use strict;
  4         30  
  4         120  
5 4     4   42 use warnings;
  4         9  
  4         103  
6              
7 4     4   1365 use utf8;
  4         35  
  4         36  
8 4     4   156 use 5.020000;
  4         14  
9              
10             #use Log::Log4perl qw(:resurrect :easy get_logger);
11 4     4   572 use Exception::Class;
  4         5268  
  4         32  
12 4     4   2506 use HTTP::Headers;
  4         29042  
  4         152  
13 4     4   2021 use HTTP::Request;
  4         50558  
  4         151  
14 4     4   2227 use HTTP::Request::Common;
  4         9309  
  4         342  
15 4     4   2051 use HTTP::Status qw(HTTP_CREATED HTTP_OK HTTP_UNAUTHORIZED HTTP_FORBIDDEN);
  4         19781  
  4         504  
16 4     4   2803 use LWP::UserAgent qw/POST/;
  4         81430  
  4         159  
17 4     4   1218 use Moose qw/around has with/;
  4         954223  
  4         37  
18 4     4   29597 use Regexp::Common qw(URI);
  4         11681  
  4         23  
19 4     4   105582 use URI::Escape qw(uri_escape);
  4         11  
  4         207  
20 4     4   3568 use XML::Simple;
  4         37955  
  4         35  
21 4     4   1540 use namespace::autoclean '-except' => 'meta', '-also' => qr/^__/sxm;
  4         17376  
  4         47  
22              
23 4     4   2042 use WWW::Wookie::Connector::Exceptions;
  4         12  
  4         120  
24 4     4   1914 use WWW::Wookie::Server::Connection;
  4         13  
  4         196  
25 4     4   2449 use WWW::Wookie::User;
  4         15  
  4         178  
26 4     4   1761 use WWW::Wookie::Widget;
  4         13  
  4         373  
27 4     4   2186 use WWW::Wookie::Widget::Category;
  4         14  
  4         151  
28 4     4   1757 use WWW::Wookie::Widget::Property;
  4         30  
  4         137  
29 4     4   999 use WWW::Wookie::Widget::Instance;
  4         10  
  4         148  
30 4     4   1729 use WWW::Wookie::Widget::Instances;
  4         16  
  4         132  
31              
32 4     4   34 use Readonly;
  4         10  
  4         16881  
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 701 my ( $self, $service_name ) = @_;
115 1         5 my $url = $self->_append_path($SERVICES);
116 1         18 __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 681 my ( $self, $service ) = @_;
147 1         3 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         2 ${$content}{'all'} = q{true};
  1         4  
153             }
154             elsif ($service) {
155 0         0 $url .= $SLASH . URI::Escape::uri_escape($service);
156             }
157 1 50       35 if ( $self->getLocale ) {
158 0         0 ${$content}{'locale'} = $self->getLocale;
  0         0  
159             }
160 1         7 __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 5 my ( $self, $userid ) = @_;
185 1 50 33     4 if ( defined $userid && $userid =~ /$TESTUSER(\d+)/gsmxi ) {
186 0         0 return WWW::Wookie::User->new( $userid, qq{Test User $1} );
187             }
188 1         33 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 948 my ( $self, $widget_or_guid ) = @_;
234 2         5 my $guid = $widget_or_guid;
235 2 50       7 if ( q{WWW::Wookie::Widget} eq ref $widget_or_guid ) {
236 0         0 $guid = $widget_or_guid->getIdentifier;
237             }
238 2         4 my $result = eval {
239 2 100 66     12 if ( defined $guid && $guid eq $EMPTY ) {
240             ## no critic qw(RequireExplicitInclusion)
241             WookieConnectorException->throw(
242 1         8 '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       1076 if ( my $e = Exception::Class->caught('WookieConnectorException') ) {
265             ###l4p $self->getLogger->error( $e->error );
266 2         63 $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         3 my $url = $self->_append_path($PROPERTIES);
312 1         18 __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 22 my ( $self, $widget_instance, $property_instance ) = @_;
336 4         11 my $url = $self->_append_path($PROPERTIES);
337 4         88 __check_widget($widget_instance);
338 3         10 __check_property($property_instance);
339 2         12 __check_url( $url, $ERR{'MALFORMED_URL'} );
340 1         42 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         17 __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 757 my ( $self, $widget, $property ) = @_;
361 3         11 my $url = $self->_append_path($PROPERTIES);
362 3         45 my $result = eval {
363 3         8 __check_widget($widget);
364 2         10 __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       1653 if ( my $e = Exception::Class->caught('WookieConnectorException') ) {
388             ###l4p $self->getLogger->error( $e->error );
389 2         35 $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         25 $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 16 my ( $self, $widget, $property ) = @_;
404 3         8 my $url = $self->_append_path($PROPERTIES);
405 3         52 __check_url( $url, $ERR{'INCORRECT_PROPERTIES_REST_URL'} );
406 2         10 __check_widget($widget);
407 1         6 __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 787 my ( $self, $widget_instance, $user ) = @_;
426 2         9 __check_widget($widget_instance);
427 1         5 my $url = $self->_append_path($PARTICIPANTS);
428 1         60 __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 705 my ( $self, $widget, $user ) = @_;
454 2         8 __check_widget($widget);
455 1         3 my $url = $self->_append_path($PARTICIPANTS);
456 1         18 __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         309 $self->_setWidgetInstances( WWW::Wookie::Widget::Instances->new );
484 9         47 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 1280 my $self = shift;
519 9         43 $self->_setWidgetInstancesHolder;
520 9         225 return;
521             }
522              
523             sub _append_path {
524 16     16   37 my ( $self, $path ) = @_;
525 16         569 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         7  
584             };
585             }
586 1 50       4 if ( !defined $method ) {
587 0         0 $method = $POST;
588             }
589              
590 1 50       3 if ( ( my $content = [ POST $url, [ %{$payload} ] ]->[0]->content ) ne
  1         11  
591             $EMPTY )
592             {
593 1         8587 $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         181 my $response = $self->_ua->request($request);
601             ###l4p $self->getLogger->debug( sprintf $LOG{'RESPONSE_CODE'}, $response->code );
602 1 50 33     44409 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         32 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   59 no Moose;
  4         10  
  4         54  
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.3>
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