File Coverage

blib/lib/WWW/Wookie/Connector/Service.pm
Criterion Covered Total %
statement 145 283 51.2
branch 12 70 17.1
condition 4 24 16.6
subroutine 39 44 88.6
pod 14 14 100.0
total 214 435 49.2


line stmt bran cond sub pod time code
1             # -*- cperl; cperl-indent-level: 4 -*-
2             # Copyright (C) 2010-2024, Roland van Ipenburg
3             package WWW::Wookie::Connector::Service v1.1.6;
4 4     4   325863 use strict;
  4         9  
  4         150  
5 4     4   18 use warnings;
  4         8  
  4         222  
6              
7 4     4   21 use utf8;
  4         6  
  4         23  
8 4     4   192 use 5.020000;
  4         32  
9              
10             #use Log::Log4perl qw(:resurrect :easy get_logger);
11 4     4   418 use Exception::Class;
  4         4135  
  4         2186  
12 4     4   2655 use HTTP::Headers;
  4         22886  
  4         207  
13 4     4   2103 use HTTP::Request;
  4         66752  
  4         164  
14 4     4   2338 use HTTP::Request::Common;
  4         11061  
  4         416  
15 4     4   2038 use HTTP::Status qw(HTTP_CREATED HTTP_OK HTTP_UNAUTHORIZED HTTP_FORBIDDEN);
  4         21320  
  4         719  
16 4     4   3337 use LWP::UserAgent;
  4         126694  
  4         234  
17 4     4   1457 use Moose qw/around has with/;
  4         1181191  
  4         38  
18 4     4   31263 use Regexp::Common qw(URI);
  4         12826  
  4         18  
19 4     4   118203 use URI::Escape qw(uri_escape);
  4         21  
  4         259  
20 4     4   5351 use XML::Simple;
  4         43303  
  4         34  
21 4     4   1844 use namespace::autoclean '-except' => 'meta', '-also' => qr/^__/sxm;
  4         23455  
  4         54  
22              
23 4     4   2060 use WWW::Wookie::Connector::Exceptions;
  4         13  
  4         141  
24 4     4   3209 use WWW::Wookie::Server::Connection;
  4         86  
  4         231  
25 4     4   3570 use WWW::Wookie::User;
  4         68  
  4         241  
26 4     4   1896 use WWW::Wookie::Widget;
  4         43  
  4         196  
27 4     4   1940 use WWW::Wookie::Widget::Category;
  4         55  
  4         217  
28 4     4   2250 use WWW::Wookie::Widget::Property;
  4         54  
  4         220  
29 4     4   1488 use WWW::Wookie::Widget::Instance;
  4         39  
  4         193  
30 4     4   2156 use WWW::Wookie::Widget::Instances;
  4         39  
  4         203  
31              
32 4     4   33 use Readonly;
  4         9  
  4         17522  
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 1197 my ( $self, $service_name ) = @_;
115 1         5 my $url = $self->_append_path($SERVICES);
116 1         28 __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 1010 my ( $self, $service ) = @_;
147 1         3 my %widgets = ();
148 1         6 my $url = $self->_append_path($WIDGETS);
149 1         23 my $content = {};
150 1 50 33     10 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       116 if ( $self->getLocale ) {
158 0         0 ${$content}{'locale'} = $self->getLocale;
  0         0  
159             }
160 1         9 __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 3 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         49 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 1192 my ( $self, $widget_or_guid ) = @_;
234 2         4 my $guid = $widget_or_guid;
235 2 50       10 if ( q{WWW::Wookie::Widget} eq ref $widget_or_guid ) {
236 0         0 $guid = $widget_or_guid->getIdentifier;
237             }
238 2         5 my $result = eval {
239 2 100 66     15 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         5 my $url = $self->_append_path($WIDGETINSTANCES);
246 1         27 __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       1374 if ( my $e = Exception::Class->caught('WookieConnectorException') ) {
265             ###l4p $self->getLogger->error( $e->error );
266 2         44 $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         4 my $url = $self->_append_path($PROPERTIES);
312 1         29 __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 21 my ( $self, $widget_instance, $property_instance ) = @_;
336 4         15 my $url = $self->_append_path($PROPERTIES);
337 4         158 __check_widget($widget_instance);
338 3         10 __check_property($property_instance);
339 2         12 __check_url( $url, $ERR{'MALFORMED_URL'} );
340 1         59 my $response = $self->_do_request(
341             $url,
342             {
343             'widgetid' => $widget_instance->getIdentifier,
344             'propertyname' => $property_instance->getName,
345             },
346             $GET,
347             );
348 0 0       0 if ( !$response->is_success ) {
349 0         0 __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 941 my ( $self, $widget, $property ) = @_;
361 3         10 my $url = $self->_append_path($PROPERTIES);
362 3         62 my $result = eval {
363 3         10 __check_widget($widget);
364 2         8 __check_property($property);
365 1         8 __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       2149 if ( my $e = Exception::Class->caught('WookieConnectorException') ) {
388             ###l4p $self->getLogger->error( $e->error );
389 2         39 $e->rethrow;
390 0         0 return $FALSE;
391             }
392 1 50       44 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         11 my $url = $self->_append_path($PROPERTIES);
405 3         373 __check_url( $url, $ERR{'INCORRECT_PROPERTIES_REST_URL'} );
406 2         39 __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 966 my ( $self, $widget_instance, $user ) = @_;
426 2         8 __check_widget($widget_instance);
427 1         5 my $url = $self->_append_path($PARTICIPANTS);
428 1         25 __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 981 my ( $self, $widget, $user ) = @_;
454 2         7 __check_widget($widget);
455 1         5 my $url = $self->_append_path($PARTICIPANTS);
456 1         28 __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   18 my $self = shift;
483 9         438 $self->_setWidgetInstances( WWW::Wookie::Widget::Instances->new );
484 9         40 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 1295 my $self = shift;
519 9         43 $self->_setWidgetInstancesHolder;
520 9         383 return;
521             }
522              
523             sub _append_path {
524 16     16   44 my ( $self, $path ) = @_;
525 16         886 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       9 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         51 %{$payload},
  1         7  
584             };
585             }
586 1 50       5 if ( !defined $method ) {
587 0         0 $method = $POST;
588             }
589              
590 1 0       47 if (
591             (
592             my $content =
593 0           [ $self->_ua->POST($url), [ %{$payload} ] ]->[0]->content
594             ) ne $EMPTY
595             )
596             {
597 0           $url .= $QUERY . $content;
598             }
599             ###l4p $self->getLogger->debug( sprintf $LOG{'DO_REQUEST'}, $method, $url );
600 0           my $request = HTTP::Request->new(
601             $method => $url,
602             HTTP::Headers->new(),
603             );
604 0           my $response = $self->_ua->request($request);
605             ###l4p $self->getLogger->debug( sprintf $LOG{'RESPONSE_CODE'}, $response->code );
606 0 0 0       if ( $response->code == HTTP_UNAUTHORIZED
607             || $response->code == HTTP_FORBIDDEN )
608             {
609             ## no critic qw(RequireExplicitInclusion)
610 0           WookieConnectorException->throw( 'error' => $ERR{'INVALID_API_KEY'} );
611             ## use critic
612             }
613 0           return $response;
614             }
615              
616             sub _parse_instance {
617 0     0     my ( $self, $guid, $xml ) = @_;
618 0           my $xml_obj =
619             XML::Simple->new( 'ForceArray' => 1, 'KeyAttr' => 'id' )->XMLin($xml);
620 0 0         if (
621             my $instance = WWW::Wookie::Widget::Instance->new(
622 0           ${$xml_obj}{'url'}[0], $guid,
623 0           ${$xml_obj}{'title'}[0], ${$xml_obj}{'height'}[0],
  0            
624 0           ${$xml_obj}{'width'}[0],
625             )
626             )
627             {
628 0           $self->WidgetInstances->put($instance);
629 0           $self->addParticipant( $instance, $self->getUser );
630 0           return $instance;
631             }
632 0           return;
633             }
634              
635             sub _parse_widget {
636 0     0     my ( $self, $xml ) = @_;
637 0           my $title = ${ ${$xml}{'name'}[0] }{'content'};
  0            
  0            
638             my $description =
639 0           ref ${$xml}{'description'}[0]
640 0           ? ${ ${$xml}{'description'}[0] }{'content'}
  0            
641 0 0         : ${$xml}{'description'}[0];
  0            
642             my $icon =
643 0           ref ${$xml}{'icon'}[0]
644 0           ? ${ ${$xml}{'icon'}[0] }{'content'}
  0            
645 0 0         : ${$xml}{'icon'}[0];
  0            
646 0 0         if ( !$icon ) {
647 0           $icon = $DEFAULT_ICON;
648             }
649 0           return ( $title, $description, $icon );
650             }
651              
652             with 'WWW::Wookie::Connector::Service::Interface';
653              
654 4     4   45 no Moose;
  4         9  
  4         41  
655              
656             __PACKAGE__->meta->make_immutable;
657              
658             1;
659              
660             __END__
661              
662             =encoding utf8
663              
664             =for stopwords Bitbucket API Readonly Wookie guid Ipenburg login MERCHANTABILITY
665              
666             =head1 NAME
667              
668             WWW::Wookie::Connector::Service - Wookie connector service, handles all the
669             data requests and responses
670              
671             =head1 VERSION
672              
673             This document describes WWW::Wookie::Connector::Service version C<v1.1.6>
674              
675             =head1 SYNOPSIS
676              
677             use WWW::Wookie::Connector::Service;
678              
679             =head1 DESCRIPTION
680              
681             =head1 SUBROUTINES/METHODS
682              
683             This module is an implementation of the
684             L<WWW::Wookie::Connector::Service::Interface
685             |WWW::Wookie::Connector::Service::Interface/"SUBROUTINES/METHODS">.
686              
687             =head2 C<new>
688              
689             Create a new connector
690              
691             =over
692              
693             =item 1. URL to Wookie host as string
694              
695             =item 2. Wookie API key as string
696              
697             =item 3. Shared data key to use as string
698              
699             =item 4. User login name
700              
701             =item 5. User display name
702              
703             =back
704              
705             =head2 C<getAvailableServices>
706              
707             Get a all available service categories in the server. Returns an array of
708             L<WWWW::Wookie::Widget::Category|WW::Wookie::Widget::Category> objects.
709             Throws a C<WookieConnectorException>.
710              
711             =head2 C<getAvailableWidgets>
712              
713             Get all available widgets in the server, or only the available widgets in the
714             specified service category. Returns an array of
715             L<WWW::Wookie::Widget|WWW::Wookie::Widget> objects, otherwise false. Throws a
716             C<WookieConnectorException>.
717              
718             =over
719              
720             =item 1. Service category name as string
721              
722             =back
723              
724             =head2 C<getWidget>
725              
726             Get the details of the widget specified by it's identifier. Returns a
727             L<WWW::Wookie::Widget|WWW::Wookie::Widget> object.
728              
729             =over
730              
731             =item 1. The identifier of an available widget
732              
733             =back
734              
735             =head2 C<getConnection>
736              
737             Get the currently active connection to the Wookie server. Returns a
738             L<WWW::Wookie::Server::Connection|WWW::Wookie::Server::Connection> object.
739              
740             =head2 C<setUser>
741              
742             Set the current user.
743              
744             =over
745              
746             =item 1. User name for the current Wookie connection
747              
748             =item 2. Screen name for the current Wookie connection
749              
750             =back
751              
752             =head2 C<getUser>
753              
754             Retrieve the details of the current user. Returns an instance of the user as a
755             L<WWW::Wookie::User|WWW::Wookie::User> object.
756              
757             =head2 C<getOrCreateInstance>
758              
759             Get or create a new instance of a widget. The current user will be added as a
760             participant. Returns a
761             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object if
762             successful, otherwise false. Throws a C<WookieConnectorException>.
763              
764             =over
765              
766             =item 1. Widget as guid string or a L<WWW::Wookie::Widget|WWW::Wookie::Widget>
767             object
768              
769             =back
770              
771             =head2 C<addParticipant>
772              
773             Add a participant to a widget. Returns true if successful, otherwise false.
774             Throws a C<WookieWidgetInstanceException> or a C<WookieConnectorException>.
775              
776             =over
777              
778             =item 1. Instance of widget as
779             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object
780              
781             =item 2. Instance of user as L<WWW::Wookie::User|WWW::Wookie::User> object
782              
783             =back
784              
785             =head2 C<deleteParticipant>
786              
787             Delete a participant. Returns true if successful, otherwise false. Throws a
788             C<WookieWidgetInstanceException> or a C<WookieConnectorException>.
789              
790             =over
791              
792             =item 1. Instance of widget as
793             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object
794              
795             =item 2. Instance of user as L<WWW::Wookie::User|WWW::Wookie::User> object
796              
797             =back
798              
799             =head2 C<getUsers>
800              
801             Get all participants of the current widget. Returns an array of
802             L<WWW::Wookie::User|WWW::Wookie::User> instances. Throws a
803             C<WookieConnectorException>.
804              
805             =over
806              
807             =item 1. Instance of widget as
808             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object
809              
810             =back
811              
812             =head2 C<addProperty>
813              
814             Adds a new property. Returns true if successful, otherwise false. Throws a
815             C<WookieConnectorException>.
816              
817             =over
818              
819             =item 1. Instance of widget as
820             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object
821              
822             =item 2. Instance of property as
823             L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object
824              
825             =back
826              
827             =head2 C<setProperty>
828              
829             Set a new property. Returns the property as
830             L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> if successful,
831             otherwise false. Throws a C<WookieWidgetInstanceException> or a
832             C<WookieConnectorException>.
833              
834             =over
835              
836             =item 1. Instance of widget as
837             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object
838              
839             =item 2. Instance of property as
840             L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object
841              
842             =back
843              
844             =head2 C<getProperty>
845              
846             Get a property. Returns the property as
847             L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> if successful,
848             otherwise false. Throws a C<WookieWidgetInstanceException> or a
849             C<WookieConnectorException>.
850              
851             =over
852              
853             =item 1. Instance of widget as
854             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object
855              
856             =item 2. Instance of property as
857             L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object
858              
859             =back
860              
861             =head2 C<deleteProperty>
862              
863             Delete a property. Returns true if successful, otherwise false. Throws a
864             C<WookieWidgetInstanceException> or a C<WookieConnectorException>.
865              
866             =over
867              
868             =item 1. Instance of widget as
869             L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance> object
870              
871             =item 2. Instance of property as
872             L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property> object
873              
874             =back
875              
876             =head2 C<setLocale>
877              
878             Set a locale.
879              
880             =over
881              
882             =item 1. Locale as string
883              
884             =back
885              
886             =head2 C<getLocale>
887              
888             Get the current locale setting. Returns current locale as string.
889              
890             =head2 C<BUILD>
891              
892             The Moose internal BUILD method.
893              
894             =head1 CONFIGURATION AND ENVIRONMENT
895              
896             =head1 DEPENDENCIES
897              
898             =over 4
899              
900             =item * L<HTTP::Headers|HTTP::Headers>
901              
902             =item * L<HTTP::Request|HTTP::Request>
903              
904             =item * L<HTTP::Request::Common|HTTP::Request::Common>
905              
906             =item * L<HTTP::Status|HTTP::Status>
907              
908             =item * L<LWP::UserAgent|LWP::UserAgent>
909              
910             =item * L<Log::Log4perl|Log::Log4perl>
911              
912             =item * L<Moose|Moose>
913              
914             =item * L<Moose::Util::TypeConstraints|Moose::Util::TypeConstraints>
915              
916             =item * L<Readonly|Readonly>
917              
918             =item * L<Regexp::Common|Regexp::Common>
919              
920             =item * L<WWW::Wookie::Connector::Exceptions|WWW::Wookie::Connector::Exceptions>
921              
922             =item * L<WWW::Wookie::Server::Connection|WWW::Wookie::Server::Connection>
923              
924             =item * L<WWW::Wookie::User|WWW::Wookie::User>
925              
926             =item * L<WWW::Wookie::Widget::Instance|WWW::Wookie::Widget::Instance>
927              
928             =item * L<WWW::Wookie::Widget::Instances|WWW::Wookie::Widget::Instances>
929              
930             =item * L<WWW::Wookie::Widget::Property|WWW::Wookie::Widget::Property>
931              
932             =item * L<WWW::Wookie::Widget|WWW::Wookie::Widget>
933              
934             =item * L<XML::Simple|XML::Simple>
935              
936             =item * L<namespace::autoclean|namespace::autoclean>
937              
938             =back
939              
940             =head1 INCOMPATIBILITIES
941              
942             =head1 DIAGNOSTICS
943              
944             =head1 BUGS AND LIMITATIONS
945              
946             Please report any bugs or feature requests at
947             L<Bitbucket|https://bitbucket.org/rolandvanipenburg/www-wookie/issues>.
948              
949             =head1 AUTHOR
950              
951             Roland van Ipenburg, E<lt>roland@rolandvanipenburg.comE<gt>
952              
953             =head1 LICENSE AND COPYRIGHT
954              
955             Copyright 2010-2024 by Roland van Ipenburg
956              
957             This library is free software; you can redistribute it and/or modify
958             it under the same terms as Perl itself, either Perl version 5.14.0 or,
959             at your option, any later version of Perl 5 you may have available.
960              
961             =head1 DISCLAIMER OF WARRANTY
962              
963             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
964             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
965             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
966             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
967             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
968             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
969             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
970             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
971             NECESSARY SERVICING, REPAIR, OR CORRECTION.
972              
973             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
974             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
975             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
976             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
977             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
978             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
979             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
980             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
981             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
982             SUCH DAMAGES.
983              
984             =cut