File Coverage

blib/lib/Jaipo.pm
Criterion Covered Total %
statement 47 176 26.7
branch 1 44 2.2
condition 1 20 5.0
subroutine 15 29 51.7
pod 12 15 80.0
total 76 284 26.7


line stmt bran cond sub pod time code
1             package Jaipo;
2 2     2   46221 use utf8;
  2         15  
  2         6  
3 2     2   45 use warnings;
  2         2  
  2         36  
4 2     2   5 use strict;
  2         5  
  2         32  
5 2     2   4 use feature qw(:5.10);
  2         2  
  2         147  
6 2     2   603 use Jaipo::Config;
  2         3  
  2         11  
7 2     2   695 use Jaipo::Notify;
  2         3  
  2         10  
8 2     2   617 use Jaipo::Logger;
  2         4  
  2         42  
9 2     2   1010 use Data::Dumper;
  2         9060  
  2         96  
10 2     2   8 use base qw/Class::Accessor::Fast/;
  2         2  
  2         129  
11             __PACKAGE__->mk_accessors(qw/config/);
12              
13 2     2   8 use vars qw/$NOTIFY $CONFIG $LOGGER $HANDLER $PUB_SUB @PLUGINS @SERVICES/;
  2         2  
  2         2955  
14              
15             my $debug = 0;
16              
17             =encoding utf8
18              
19             =head1 NAME
20              
21             Jaipo - Micro-blogging Client
22              
23             =cut
24              
25             our $VERSION = '0.22';
26              
27             =head1 DESCRIPTION
28              
29             Jaipo ( å®…å™— )
30              
31             This project started for Jaiku.com, but now is going to support
32             as-much-as-we-can micro-blogging sites.
33              
34             "Jaiku" pronunced close to "宅窟" in Chinese, which means an area full of
35             computer/internet users, and it really is one of the most popular sites
36             recently. As jaiku is part of google and growing, there're still only few linux
37             client.
38              
39             it's writen in perl, so it can run on any platform that you can get perl on it.
40             we got the first feedback that somebody use it on ARM embedded system at May 2008.
41              
42             =cut
43              
44             =head1 FUNCTIONS
45              
46             =head2 new
47              
48             =cut
49              
50             sub new {
51 1     1 1 1 my $class = shift;
52 1         2 my %args = @_;
53 1         2 my $self = {};
54            
55             # Jaipo::$_->new($args{$_}) for keys %args;
56             #~ $self{"UI"} = Jaipo::UI->new( $args{"ui"} );
57             #~ $self{"Notify"} = Jaipo::Notify->new ( $args{"notify"} );
58             #~ $self{"Service"} = Jaipo::Service->new ( $args{"service"} );
59            
60 1         2 bless $self, $class;
61 1         2 return $self;
62             }
63              
64             =head2 config
65              
66             return L<Jaipo::Config>
67              
68             =cut
69              
70             sub config {
71 0     0 1 0 my $class = shift;
72 0 0       0 $CONFIG = shift if (@_);
73 0   0     0 $CONFIG ||= Jaipo::Config->new ();
74 0         0 return $CONFIG;
75             }
76              
77             sub notify {
78 1     1 0 1 my $class = shift;
79 1   33     6 $NOTIFY ||= Jaipo::Notify->new;
80 0         0 return $NOTIFY;
81             }
82              
83             =head2 services
84              
85             =cut
86              
87             sub services {
88 0     0 1 0 my $class = shift;
89 0 0       0 @SERVICES = @_ if @_;
90 0         0 return @SERVICES;
91             }
92              
93             sub logger {
94 1     1 0 2 my $class = shift;
95 1 50       3 $LOGGER = shift if (@_);
96 1         2 return $LOGGER;
97             }
98              
99             =head2 init CALLER_OBJECT
100              
101             =cut
102              
103             sub init {
104 1     1 1 1 my $self = shift;
105 1         1 my $caller = shift;
106              
107             # Logger turn on
108 1         5 Jaipo->logger ( Jaipo::Logger->new );
109              
110             # prereserve arguments for service plugin
111             # my $args = {
112             #
113             # };
114 1         2 Jaipo->notify;
115              
116             # we initialize service plugin class here
117             # Set up plugins
118 0           my @services;
119 0           my @services_to_load = @{ Jaipo->config->app ('Services') };
  0            
120              
121 0           my @plugins;
122             my @plugins_to_load;
123              
124 0           for ( my $i = 0; my $service = $services_to_load[$i]; $i++ ) {
125              
126             # Prepare to learn the plugin class name
127 0           my ($service_name) = keys %{$service};
  0            
128 0           say "Jaipo: Init " . $service_name;
129              
130 0           my $class;
131              
132             # Is the plugin name a fully-qualified class name?
133 0 0         if ( $service_name =~ /^Jaipo::Service::/ ) {
134              
135             # app-specific plugins use fully qualified names, Jaipo service plugins may
136 0           $class = $service_name;
137             }
138              
139             # otherwise, assume it's a short name, qualify it
140             else {
141 0           $class = "Jaipo::Service::" . $service_name;
142             }
143              
144             # Load the service plugin options
145 0           my %options = ( %{ $service->{$service_name} } );
  0            
146              
147 0 0         if ( !$options{enable} ) {
148 0           Jaipo->logger->info ( '%s is disabled', $service_name );
149 0           next;
150             }
151              
152             # Load the service plugin code
153 0           $self->_try_to_require ($class);
154              
155             # XXX: if Service don't have trigger_name, we have to do something
156             #
157             # Initialize the plugin and mark the prerequisites for loading too
158 0           my $plugin_obj = $class->new (%options);
159 0           $plugin_obj->init ($caller);
160              
161 0           push @services, $plugin_obj;
162 0           foreach my $name ( $plugin_obj->prereq_plugins ) {
163 0 0         next if grep { $_ eq $name } @plugins_to_load;
  0            
164 0           push @plugins_to_load, { $name => {} };
165             }
166              
167             }
168              
169             # All plugins loaded, save them for later reference
170 0           Jaipo->services (@services);
171              
172             # XXX: need to implement plugin loader
173              
174             # warn "No supported service provider initialled!\n" if not $has_site;
175              
176             # when initialize jaipo, there are some new settings that we need to save.
177 0           Jaipo->config->save;
178 0           Jaipo->logger->info ('Configuration saved.');
179             }
180              
181             =head2 list_loaded_triggers
182              
183             =cut
184              
185             sub list_loaded_triggers {
186 0     0 1   my @services = Jaipo->services;
187 0           for my $s (@services) {
188 0           print $s->trigger_name, " => ", ref ($s), "\n";
189             }
190             }
191              
192             =head2 list_triggers
193              
194             =cut
195              
196             sub list_triggers {
197 0     0 1   my @service_configs = @{ Jaipo->config->app ('Services') };
  0            
198 0           for my $s (@service_configs) {
199 0           my @v = values %$s;
200 0           print $v[0]->{trigger_name}, " => ", join ( q||, keys (%$s) ), "\n";
201             }
202             }
203              
204             =head2 find_service_by_trigger TRIGGER_NAME [ SERVICES ]
205              
206             =cut
207              
208             sub find_service_by_trigger {
209 0     0 1   my ( $self, $tg, $services ) = @_;
210 0   0       $services ||= [ Jaipo->services ];
211 0           for my $s (@$services) {
212 0           my $s_tg = $s->trigger_name;
213 0           print "Service: $s_tg\n";
214 0 0         return $s if $s->trigger_name eq $tg;
215             }
216             }
217              
218             =head2 _require ( module => MODULE , ... )
219              
220             =cut
221              
222             sub _require {
223 0     0     my $self = shift;
224 0           my %args = @_;
225 0           my $class = $args{module};
226              
227 0 0         return 1 if $self->_already_required ($class);
228              
229 0           my $file = $class;
230 0 0         $file .= '.pm' unless $file =~ /\.pm$/;
231 0           $file =~ s|::|/|g;
232              
233 0           my $retval = eval { CORE::require "$file" };
  0            
234 0           my $error = $@;
235 0 0         if ( my $message = $error ) {
236 0           $message =~ s/ at .*?\n$//;
237 0 0 0       if ( $args{'quiet'} and $message =~ /^Can't locate $file/ ) {
    0          
238 0           return 0;
239             }
240             elsif ( $error !~ /^Can't locate $file/ ) {
241 0           die $error;
242             }
243             else {
244             #log->error(sprintf("$message at %s line %d\n", (caller(1))[1,2]));
245 0           return 0;
246             }
247             }
248             }
249              
250             =head2 _already_required CLASS_NAME
251              
252             =cut
253              
254             sub _already_required {
255 0     0     my $self = shift;
256 0           my $class = shift;
257 0           my ($path) = ( $class =~ s|::|/|g );
258 0           $path .= '.pm';
259 0 0         return $INC{$path} ? 1 : 0;
260             }
261              
262             =head2 _try_to_require CLASS_NAME
263              
264             =cut
265              
266             sub _try_to_require {
267 0     0     my $self = shift;
268 0           my $module = shift;
269 0           $self->_require ( module => $module, quiet => 0 );
270             }
271              
272             =head2 find_plugin CLASS_NAME
273              
274             Find plugins by class name, which is full-qualified class name.
275              
276             =cut
277              
278             sub find_plugin {
279 0     0 1   my $self = shift;
280 0           my $name = shift;
281 0           my @plugins = grep { $_->isa ($name) } Jaipo->plugins;
  0            
282 0 0         return wantarray ? @plugins : $plugins[0];
283             }
284              
285             =head2 set_plugin_trigger PLUGIN_OBJECT CLASS
286              
287             =cut
288              
289             # this may used by runtime_load_service
290             sub set_plugin_trigger {
291 0     0 1   my ( $self, $plugin_obj, $options, $class, $services ) = @_;
292              
293             # give a trigger to plugin obj , take a look. :p
294 0           my $trigger_name;
295 0 0         if ( defined $options->{trigger_name} ) {
296 0           $trigger_name = $options->{trigger_name};
297             }
298              
299             else {
300 0           ($trigger_name) = ( $class =~ m/(?<=Service::)(\w+)$/ );
301 0           $trigger_name = lc $trigger_name; # lower case
302             }
303              
304             # repeat service trigger name
305 0           while ( my $s
306             = $self->find_service_by_trigger ( $trigger_name, $services ) )
307             {
308              
309             # give an another trigger name for it or ask user
310             # TODO: provide a config option to let user set jaipo to ask
311 0           $trigger_name .= '_';
312             }
313              
314             # set trigger name
315 0           $plugin_obj->trigger_name ($trigger_name);
316 0           print "set trigger: ", $trigger_name, ' for ', $class, "\n";
317             }
318              
319             =head2 runtime_load_service CALLER SERVICE_NAME [TRIGGER_NAME]
320              
321             if trigger name is specified, and it doesn't exist in config.
322             Jaipo will create a new service object, and assign the trigger name to it.
323              
324             if trigger name is specified, and Jaipo will try to search the service config
325             by trigger name and load the service.
326              
327             if trigger name is not specified. Jaipo will try to find service configs
328             by service name. if there are two or more same service, Jaipo will load the
329             default trigger name ( service name in lowcase )
330              
331             =cut
332              
333             # XXX: need to re-check logic
334             sub runtime_load_service {
335 0     0 1   my ( $self, $caller, $service_name, $trigger_name ) = @_;
336              
337 0   0       $trigger_name ||= lc $service_name;
338 0           my $class = "Jaipo::Service::" . ucfirst $service_name;
339              
340 0           my $options = {};
341             my @sp_options
342 0           = Jaipo->config->find_service_option_by_trigger ($trigger_name);
343              
344             # can not find option , set default trigger name and sp_id
345 0 0         if ( !@sp_options ) {
    0          
346 0           $options->{trigger_name} = $trigger_name;
347 0           my $num_rec = Number::RecordLocator->new;
348 0           $options->{sp_id} = $num_rec->encode ( Jaipo->config->last_sp_cnt );
349             }
350              
351             elsif ( scalar @sp_options == 1 ) {
352 0           $options = $sp_options[0];
353             }
354              
355             # XXX:
356             # actually won't happen, config loader will canonicalize the config
357             # service plugin will get it's default trigger namd from service name.
358             else {
359             # find by service name
360             # elsif ( scalar @sp_options > 1 ) {
361             # # find service by trigger name
362             # for my $s (@sp_options) {
363             # $options = $s if ( $s->{trigger_name} eq $trigger_name );
364             # }
365             # }
366             }
367              
368             # Load the service plugin code
369 0           $self->_try_to_require ($class);
370              
371             # Jaipo::ClassLoader->new(base => $class)->require;
372              
373 0           my $plugin_obj = $class->new (%$options);
374 0           $plugin_obj->init ($caller);
375              
376             # $self->set_plugin_trigger( $plugin_obj , $class );
377              
378 0           my @services = Jaipo->services;
379 0           push @services, $plugin_obj;
380 0           foreach my $name ( $plugin_obj->prereq_plugins ) {
381              
382             # next if grep { $_ eq $name } @plugins_to_load;
383             #push @plugins_to_load, {$name => {}};
384             }
385 0           Jaipo->services (@services);
386              
387             # call save configuration here
388             # TODO: this may overwrites other plugins afterload options
389             # make sure that user did config jaipo , or we don't need to rewrite config
390 0           Jaipo->config->save;
391             }
392              
393             =head2 dispatch_to_service SERVICE_TRIGGER , MESSAGE
394              
395             command start with C<:[service]> ( e.g. C<:twitter> or C<:plurk> ) something
396             like that will call the servcie dispatch method, service plugin will decide
397             what to do with.
398              
399             =cut
400              
401             sub dispatch_to_service {
402 0     0 1   print "going to dispatch\n";
403 0           my ( $self, $service_tg, $line ) = @_;
404 0           my $s = $self->find_service_by_trigger ($service_tg);
405 0           print "choosen: $s\n";
406 0           my ($sub_command) = ($line =~ m[^(\w+)] );
407 0           $s->dispatch_sub_command( $sub_command , $line );
408              
409             }
410              
411             sub cache_clear {
412 0     0 0   my @services = Jaipo->services;
413 0           foreach my $service (@services) {
414 0 0         if( UNIVERSAL::can( $service , 'get_cache' ) ) {
415 0           my $c = $service->get_cache;
416 0           $c->clear;
417             }
418             }
419             }
420              
421             =head2 action ACTION, PARAM
422              
423             =cut
424              
425             sub action {
426 0     0 1   my ( $self, $action, $param ) = @_;
427 0           my @services = Jaipo->services;
428 0 0         print "Services: @services \n" if $debug;
429 0           foreach my $service (@services) {
430 0 0         if ( UNIVERSAL::can( $service, $action ) ) {
431 0           my $ret = $service->$action($param);
432 0 0         if ($debug) {
433 2     2   850 use Data::Dumper::Simple;
  2         33055  
  2         10  
434 0           warn Dumper( $ret );
435             }
436              
437             # XXX:
438             # - we should check ret->{type} eq 'notification'
439             # - and call Notify::init
440 0 0 0       if ( ref $ret
      0        
441             and $ret->{type} eq 'notification'
442             and $ret->{updates} > 0 )
443             {
444 0           Jaipo->notify->create($ret);
445             }
446             }
447             else {
448 0           warn "Not a supported action.\n";
449             # service plugin doesn't support this kind of action
450             }
451             }
452              
453             }
454              
455             =head1 AUTHOR
456              
457             BlueT - Matthew Lien - 練喆明, C<< <BlueT at BlueT.org> >>
458             Cornelius, C<< cornelius.howl at gmail.com >>
459              
460             =head1 BUGS
461              
462             Please report any bugs or feature requests to C<bug-jaipo at rt.cpan.org>, or through
463             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Jaipo>. I will be notified, and then you'll
464             automatically be notified of progress on your bug as I make changes.
465              
466              
467              
468              
469             =head1 SUPPORT
470              
471             You can find documentation for this module with the perldoc command.
472              
473             perldoc Jaipo
474              
475              
476             You can also look for information at:
477              
478             =over 4
479              
480             =item * our main git repository is located at github.com.
481             L<https://github.com/BlueT/jaipo>
482              
483             =item * RT: CPAN's request tracker (report bugs here)
484              
485             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Jaipo>
486              
487             =item * AnnoCPAN: Annotated CPAN documentation
488              
489             L<http://annocpan.org/dist/Jaipo>
490              
491             =item * CPAN Ratings
492              
493             L<http://cpanratings.perl.org/d/Jaipo>
494              
495             =item * Search CPAN
496              
497             L<http://search.cpan.org/dist/Jaipo/>
498              
499             =back
500              
501              
502             =head1 ACKNOWLEDGEMENTS
503              
504              
505             =head1 LICENSE AND COPYRIGHT
506              
507             Copyright 2017 BlueT - Matthew Lien - 練喆明.
508              
509             This program is free software; you can redistribute it and/or modify it
510             under the terms of the the Artistic License (2.0). You may obtain a
511             copy of the full license at:
512              
513             L<http://www.perlfoundation.org/artistic_license_2_0>
514              
515             Any use, modification, and distribution of the Standard or Modified
516             Versions is governed by this Artistic License. By using, modifying or
517             distributing the Package, you accept this license. Do not use, modify,
518             or distribute the Package, if you do not accept this license.
519              
520             If your Modified Version has been derived from a Modified Version made
521             by someone other than you, you are nevertheless required to ensure that
522             your Modified Version complies with the requirements of this license.
523              
524             This license does not grant you the right to use any trademark, service
525             mark, tradename, or logo of the Copyright Holder.
526              
527             This license includes the non-exclusive, worldwide, free-of-charge
528             patent license to make, have made, use, offer to sell, sell, import and
529             otherwise transfer the Package with respect to any patent claims
530             licensable by the Copyright Holder that are necessarily infringed by the
531             Package. If you institute patent litigation (including a cross-claim or
532             counterclaim) against any party alleging that the Package constitutes
533             direct or contributory patent infringement, then this Artistic License
534             to you shall terminate on the date that such litigation is filed.
535              
536             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
537             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
538             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
539             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
540             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
541             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
542             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
543             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
544              
545              
546             =cut
547              
548             1; # End of Jaipo