File Coverage

blib/lib/App/Maisha/Shell.pm
Criterion Covered Total %
statement 210 475 44.2
branch 39 210 18.5
condition 8 66 12.1
subroutine 89 104 85.5
pod 84 84 100.0
total 430 939 45.7


line stmt bran cond sub pod time code
1             package App::Maisha::Shell;
2              
3 10     10   137049 use strict;
  10         27  
  10         253  
4 10     10   45 use warnings;
  10         19  
  10         404  
5              
6             our $VERSION = '0.22';
7              
8             #----------------------------------------------------------------------------
9              
10             =head1 NAME
11              
12             App::Maisha::Shell - A command line social micro-blog networking tool.
13              
14             =head1 SYNOPSIS
15              
16             use App::Maisha::Shell;
17             my $shell = App::Maisha::Shell->new;
18              
19             =head1 DESCRIPTION
20              
21             This distribution provides the ability to micro-blog via social networking
22             websites and services, such as Identica and Twitter.
23              
24             =cut
25              
26             #----------------------------------------------------------------------------
27             # Library Modules
28              
29 10     10   51 use base qw(Term::Shell);
  10         16  
  10         5259  
30              
31 10     10   158500 use File::Basename;
  10         29  
  10         645  
32 10     10   55 use File::Path;
  10         20  
  10         534  
33 10     10   3718 use IO::File;
  10         62576  
  10         1388  
34 10     10   4084 use Module::Pluggable instantiate => 'new', search_path => ['App::Maisha::Plugin'];
  10         23650  
  10         72  
35 10     10   4595 use Text::Wrap;
  10         21710  
  10         51620  
36              
37             #----------------------------------------------------------------------------
38             # Variables
39              
40             $Text::Wrap::columns = 80;
41              
42             my %plugins; # contains all available plugins
43              
44             my %months = (
45             'Jan' => 1, 'Feb' => 2, 'Mar' => 3, 'Apr' => 4,
46             'May' => 5, 'Jun' => 6, 'Jul' => 7, 'Aug' => 8,
47             'Sep' => 9, 'Oct' => 10, 'Nov' => 11, 'Dec' => 12,
48             );
49              
50             my %max = (
51             user_timeline => { limit => 3200, count => 200 }, # specific user timelines
52             search_tweets => { limit => 800, count => 100 }, # search lists
53             home_timeline => { limit => 800, count => 200 }, # generic timelines
54             user_lists => { limit => 5000, count => 5000 }, # user lists
55             );
56              
57             #----------------------------------------------------------------------------
58             # Accessors
59              
60 6     6 1 24905 sub networks { shift->_elem('networks', @_) }
61 10     10 1 5034 sub prompt_str { shift->_elem('prompt_str', @_) }
62 10     10 1 1306 sub tag_str { shift->_elem('tag_str', @_) }
63 10     10 1 1302 sub order { shift->_elem('order', @_) }
64 18     18 1 1437 sub limit { shift->_elem('limit', @_) }
65 19     19 1 1329 sub services { shift->_elem('services', @_) }
66 10     10 1 1265 sub pager { shift->_elem('pager', @_) }
67 10     10 1 1317 sub format { shift->_elem('format', @_) }
68 10     10 1 1322 sub chars { shift->_elem('chars', @_) }
69 10     10 1 1260 sub history { shift->_elem('historyfile', @_) }
70 10     10 1 1336 sub debug { shift->_elem('debug', @_) }
71 15     15 1 1273 sub error { shift->_elem('error', @_) }
72              
73             #----------------------------------------------------------------------------
74             # Public API
75              
76             #
77             # Connect/Disconnect
78             #
79              
80             sub connect {
81 2     2 1 27 my ($self,$plug,$config) = @_;
82              
83 2 50       8 unless($plug) { warn "No plugin supplied\n"; return }
  0         0  
  0         0  
84              
85 2 100       13 $self->_load_plugins unless(%plugins);
86 2         20 my $plugin = $self->_get_plugin($plug);
87 2 50       7 if(!$plugin) {
88 0         0 warn "Unable to establish plugin '$plug'\n";
89 0         0 return;
90             }
91              
92 2         8 my $status = $plugin->login($config);
93 2 50       6 if(!$status) {
94 0         0 warn "Login to '$plug' failed\n";
95 0         0 return;
96             }
97              
98 2         8 my $services = $self->services;
99 2         6 push @$services, $plugin;
100 2         7 $self->services($services);
101 2         7 $self->_reset_networks;
102             }
103              
104             *run_connect = \&connect;
105 2     2 1 763 sub smry_connect { "connect to a service" }
106             sub help_connect {
107 2     2 1 729 <<'END';
108              
109             Connects to a named service. Requires the name of the service, together with
110             the username and password to access the service.
111             END
112             }
113              
114              
115             sub run_disconnect {
116 0     0 1 0 my ($self,$plug) = @_;
117              
118 0 0       0 unless($plug) { warn "No plugin supplied\n"; return }
  0         0  
  0         0  
119              
120 0         0 my $services = $self->services;
121 0         0 my @new = grep {ref($_) !~ /^App::Maisha::Plugin::$plug$/} @$services;
  0         0  
122 0         0 $self->services(\@new);
123 0         0 $self->_reset_networks;
124             }
125 2     2 1 912 sub smry_disconnect { "disconnect from a service" }
126             sub help_disconnect {
127 2     2 1 715 <<'END';
128              
129             Disconnects from the named service.
130             END
131             }
132              
133              
134             #
135             # Use
136             #
137              
138             sub run_use {
139 0     0 1 0 my ($self,$plug) = @_;
140 0 0       0 if(my $p = $self->_get_plugin($plug)) {
141 0         0 my $services = $self->services;
142 0         0 my @new = grep {ref($_) !~ /^App::Maisha::Plugin::$plug$/} @$services;
  0         0  
143 0         0 unshift @new, $self->_get_plugin($plug);
144 0         0 $self->services(\@new);
145 0         0 $self->_reset_networks;
146             } else {
147 0         0 warn "Unknown plugin\n";
148             }
149             }
150 2     2 1 710 sub smry_use { "set primary service" }
151             sub help_use {
152 2     2 1 732 <<'END';
153              
154             Set the primary service for message list commands.
155             END
156             }
157              
158             sub comp_use {
159 0     0 1 0 my ($self, $word, $line, $start_index) = @_;
160 0         0 my $services = $self->services;
161             my @networks = map {
162 0         0 ref($_) =~ /^App::Maisha::Plugin::(.+)/; $1;
  0         0  
  0         0  
163             } @$services;
164 0         0 return grep { /^$word/ } @networks;
  0         0  
165             }
166              
167             #
168             # Followers
169             #
170              
171             sub run_followers {
172 1     1 1 311 my $self = shift;
173 1         12 $self->_run_snapshot('followers',$max{user_lists},@_);
174             }
175 2     2 1 20845 sub smry_followers { "display followers' status" }
176             sub help_followers {
177 2     2 1 729 <<'END';
178              
179             Displays the most recent status messages from each of your followers.
180             END
181             }
182              
183              
184             #
185             # Friends
186             #
187              
188             sub run_friends {
189 1     1 1 1189 my $self = shift;
190 1         4 $self->_run_snapshot('friends',$max{user_lists},@_);
191             }
192 2     2 1 743 sub smry_friends { "display friends' status" }
193             sub help_friends {
194 2     2 1 761 <<'END';
195              
196             Displays the most recent status messages from each of your friends.
197             END
198             }
199              
200              
201             #
202             # Show User
203             #
204              
205             sub run_user {
206 1     1 1 1003 my ($self,$user) = @_;
207              
208 1 50       6 $user =~ s/^\@// if($user);
209 1 50       4 unless($user) {
210 1         8 print "no user specified\n\n";
211 1         4 return;
212             }
213              
214 0         0 my $ref = { screen_name => $user };
215 0         0 my $ret = $self->_command('user', $ref);
216              
217 0         0 print "\n";
218 0 0       0 print "user: $ret->{screen_name}\n" if($ret->{screen_name});
219 0 0       0 print "name: $ret->{name}\n" if($ret->{name});
220 0 0       0 print "location: $ret->{location}\n" if($ret->{location});
221 0 0       0 print "description: $ret->{description}\n" if($ret->{description});
222 0 0       0 print "url: $ret->{url}\n" if($ret->{url});
223 0 0       0 print "friends: $ret->{friends_count}\n" if($ret->{friends_count});
224 0 0       0 print "followers: $ret->{followers_count}\n" if($ret->{followers_count});
225 0 0       0 print "statuses: $ret->{statuses_count}\n" if($ret->{statuses_count});
226 0 0       0 print "status: $ret->{status}{text}\n" if($ret->{status}{text});
227              
228             #use Data::Dumper;
229             #print Dumper($ret);
230             }
231 2     2 1 708 sub smry_user { "display a user profile" }
232             sub help_user {
233 2     2 1 726 <<'END';
234              
235             Displays a user profile.
236             END
237             }
238              
239             sub comp_user {
240 0     0 1 0 my ($self, $word, $line, $start_index) = @_;
241 0         0 my $services = $self->services;
242 0   0     0 my $service = $services->[0] || return;
243 0 0 0     0 return unless($service && $service->can('users'));
244              
245 0         0 my $users = $service->users;
246 0         0 return grep { /^$word/ } keys %$users;
  0         0  
247             }
248              
249              
250             #
251             # Follow/Unfollow
252             #
253              
254             sub run_follow {
255 1     1 1 1002 my ($self,$user) = @_;
256              
257 1 50       5 $user =~ s/^\@// if($user);
258 1 50       3 unless($user) {
259 1         8 print "no user specified\n\n";
260 1         5 return;
261             }
262              
263 0         0 my $ref = { screen_name => $user };
264 0         0 my $ret = $self->_command('follow', $ref);
265             }
266 2     2 1 725 sub smry_follow { "follow a named user" }
267             sub help_follow {
268 2     2 1 728 <<'END';
269              
270             Sends a follow request to the name user. If status updates are not protected
271             you can start seeing that user's updates immediately. Otherwise you will have
272             to wait until the user accepts your request.
273             END
274             }
275              
276              
277             sub run_unfollow {
278 1     1 1 986 my ($self,$user) = @_;
279              
280 1 50       4 $user =~ s/^\@// if($user);
281 1 50       3 unless($user) {
282 1         8 print "no user specified\n\n";
283 1         5 return;
284             }
285              
286 0         0 my $ref = { screen_name => $user };
287 0         0 my $ret = $self->_command('unfollow', $ref);
288             }
289 2     2 1 697 sub smry_unfollow { "unfollow a named user" }
290             sub help_unfollow {
291 2     2 1 696 <<'END';
292              
293             Allows you to unfollow a user.
294             END
295             }
296              
297              
298             #
299             # Friends Timeline
300             #
301              
302             sub run_friends_timeline {
303 2     2 1 2098 my $self = shift;
304 2         7 $self->_run_timeline('friends_timeline',$max{home_timeline},undef,@_);
305             }
306              
307 2     2 1 712 sub smry_friends_timeline { "display friends' status as a timeline" }
308             sub help_friends_timeline {
309 4     4 1 1434 <<'END';
310              
311             Displays the most recent status messages within your friends timeline.
312             END
313             }
314              
315             *run_ft = \&run_friends_timeline;
316 2     2 1 706 sub smry_ft { "alias to friends_timeline" }
317             *help_ft = \&help_friends_timeline;
318              
319              
320             #
321             # Public Timeline
322             #
323              
324             sub run_public_timeline {
325 2     2 1 1981 my $self = shift;
326 2         7 $self->_run_timeline('public_timeline',$max{home_timeline},undef,@_);
327             }
328              
329 2     2 1 715 sub smry_public_timeline { "display public status as a timeline" }
330             sub help_public_timeline {
331 4     4 1 1424 <<'END';
332              
333             Displays the most recent status messages within the public timeline.
334             END
335             }
336              
337             *run_pt = \&run_public_timeline;
338 2     2 1 710 sub smry_pt { "alias to public_timeline" }
339             *help_pt = \&help_public_timeline;
340              
341              
342             #
343             # User Timeline
344             #
345              
346             sub run_user_timeline {
347 2     2 1 2036 my $self = shift;
348 2         4 my $user = shift;
349              
350 2 50       5 $user =~ s/^\@// if($user);
351 2 50       6 unless($user) {
352 2         13 print "no user specified\n\n";
353 2         8 return;
354             }
355              
356 0         0 $self->_run_timeline('user_timeline',$max{user_timeline},$user,@_);
357             }
358              
359 2     2 1 706 sub smry_user_timeline { "display named user statuses as a timeline" }
360             sub help_user_timeline {
361 4     4 1 1423 <<'END';
362              
363             Displays the most recent status messages for a specified user.
364             END
365             }
366             *comp_user_timeline = \&comp_user;
367              
368             *run_ut = \&run_user_timeline;
369 2     2 1 711 sub smry_ut { "alias to user_timeline" }
370             *help_ut = \&help_user_timeline;
371             *comp_ut = \&comp_user;
372              
373              
374             #
375             # Replies
376             #
377              
378             sub run_replies {
379 2     2 1 2000 my $self = shift;
380 2         8 $self->_run_timeline('replies',$max{home_timeline},undef,@_);
381             }
382              
383 2     2 1 854 sub smry_replies { "display reply messages that refer to you" }
384             sub help_replies {
385 4     4 1 1417 <<'END';
386              
387             Displays the most recent reply messages that refer to you.
388             END
389             }
390              
391             *run_re = \&run_replies;
392 2     2 1 713 sub smry_re { "alias to replies" }
393             *help_re = \&help_replies;
394              
395              
396             #
397             # Direct Messages
398             #
399              
400             sub run_direct_messages {
401 2     2 1 2073 my $self = shift;
402 2 50 33     11 my $frto = @_ && $_[0] =~ /^from|to$/ ? shift : 'to';
403 2         3 my $num = shift;
404              
405 2         5 my ($limit,$pages,$count) = $self->_get_limits($max{home_timeline},$num,$self->limit);
406 2   50     9 $pages ||= 1;
407              
408 2         2 my (@pages,@results,$max_id);
409 2         6 for my $page (1 .. $pages) {
410 2         12 my $ref = {};
411 2 50       6 $ref->{max_id} = $max_id-1 if($max_id);
412 2 50       5 $ref->{count} = $count if($count);
413              
414 2         2 my $ret;
415 2         3 eval { $ret = $self->_command('direct_messages_' . $frto,$ref) };
  2         6  
416              
417 2 50 33     15 if(($@ || !$ret) && $self->error =~ /This application is not allowed to access or delete your direct messages/) {
      33        
418 0         0 print "WARNING: Your OAuth keys need updating.\n";
419 0         0 eval { $ret = $self->_command('reauthorize') };
  0         0  
420 0 0       0 return unless($ret);
421              
422             # okay retry
423 0         0 eval { $ret = $self->_command('direct_messages_' . $frto,$ref) };
  0         0  
424 0 0       0 return if($@);
425             }
426              
427 2 50       6 last unless($ret);
428 0 0 0     0 last if($max_id && $max_id == $ret->[-1]{id});
429 0         0 unshift @pages, $ret;
430 0         0 $max_id = $ret->[-1]{id};
431             }
432              
433 2 50       10 return unless(@pages);
434 0         0 for my $page (@pages) {
435 0         0 push @results, @$page;
436             }
437 0 0       0 $self->_print_messages($limit,($frto eq 'to' ? 'sender' : 'recipient'),\@results);
438             }
439              
440 2     2 1 770 sub smry_direct_messages { "display direct messages that have been sent to you" }
441             sub help_direct_messages {
442 4     4 1 1424 <<'END';
443              
444             Displays the direct messages that have been sent to you.
445             END
446             }
447              
448             *run_dm = \&run_direct_messages;
449 2     2 1 720 sub smry_dm { "alias to direct_messages" }
450             *help_dm = \&help_direct_messages;
451              
452              
453             #
454             # Send Message
455             #
456              
457             sub run_send_message {
458 3     3 1 3023 my $self = shift;
459            
460 3 50       9 unless($self->line()) {
461 3         32 print "cannot send an empty message\n\n";
462 3         11 return;
463             }
464              
465 0         0 my (undef,$user,$mess) = split(/\s+/,$self->line(),3);
466              
467 0 0       0 $user =~ s/^\@// if($user);
468 0 0       0 unless($user) {
469 0         0 print "no user specified\n\n";
470 0         0 return;
471             }
472              
473 0 0 0     0 unless(defined $mess && $mess =~ /\S/) {
474 0         0 print "cannot send an empty message\n\n";
475 0         0 return;
476             }
477              
478 0         0 $mess =~ s/^\s+//;
479 0         0 $mess =~ s/\s+$//;
480 0         0 my $len = length $mess;
481 0 0       0 if($len > 140) {
482 0         0 print "message too long: $len/140\n\n";
483 0         0 return;
484             }
485              
486 0         0 my $ref = { screen_name => $user, text => $mess };
487 0         0 $self->_command('send_message', $ref);
488             }
489              
490 2     2 1 739 sub smry_send_message { "send a direct message" }
491             sub help_send_message {
492 6     6 1 2146 <<'END';
493              
494             Posts a message (upto 140 characters), to a named user.
495             END
496             }
497              
498             *comp_send_message = \&comp_user;
499             *comp_send = \&comp_user;
500             *comp_sm = \&comp_user;
501              
502             *run_send = \&run_send_message;
503 4     4 1 1444 sub smry_send { "alias to send_message" }
504             *help_send = \&help_send_message;
505              
506             *run_sm = \&run_send_message;
507             *smry_sm = \&smry_send;
508             *help_sm = \&help_send_message;
509              
510              
511             #
512             # Update/Say
513             #
514              
515             sub run_update {
516 2     2 1 2066 my $self = shift;
517            
518 2 50       17 unless($self->line()) {
519 2         49 print "cannot send an empty message\n\n";
520 2         9 return;
521             }
522              
523 0         0 my (undef,$text) = split(' ',$self->line(),2);
524 0         0 $text =~ s/^\s+//;
525 0         0 $text =~ s/\s+$//;
526              
527 0 0       0 unless($text) {
528 0         0 print "cannot send an empty message\n\n";
529 0         0 return;
530             }
531              
532 0         0 my $len = length $text;
533 0 0       0 if($len < 140) {
    0          
534 0   0     0 my $tag = $self->tag_str || '';
535 0 0       0 $text .= " " if ($text =~ /\S/);
536 0 0       0 $text .= $tag if(length "$text$tag" <= 140);
537             } elsif($len > 140) {
538 0         0 print "message too long: $len/140\n\n";
539 0         0 return;
540             }
541              
542 0         0 $self->_commands('update', $text);
543             }
544 2     2 1 703 sub smry_update { "post a message" }
545             sub help_update {
546 4     4 1 1415 <<'END';
547              
548             Posts a message (upto 140 characters).
549             END
550             }
551              
552             *comp_update = \&comp_user;
553              
554             # help
555             *run_say = \&run_update;
556 2     2 1 711 sub smry_say { "alias to 'update'" }
557             *help_say = \&help_update;
558             *comp_say = \&comp_user;
559              
560              
561             #
562             # Search
563             #
564              
565             sub run_search {
566 0     0 1 0 my $self = shift;
567 0         0 my (undef,$text) = split(' ',$self->line(),2);
568 0         0 $text =~ s/^\s+//;
569 0         0 $text =~ s/\s+$//;
570              
571 0         0 my $limit;
572 0 0       0 if($text =~ /^(\d+)\s+(.*)/) {
573 0         0 ($limit,$text) = ($1,$2);
574             }
575              
576 0 0       0 unless($text) {
577 0         0 print "cannot search for an empty string\n\n";
578 0         0 return;
579             }
580              
581 0         0 my $len = length $text;
582 0 0       0 if($len > 1000) {
583 0         0 print "search term is too long: $len/1000\n\n";
584 0         0 return;
585             }
586             #print "limit=$limit, text=$text\n";
587 0         0 $self->_run_results('search',$max{search_tweets},$limit,$text);
588             }
589 0     0 1 0 sub smry_search { "search for messages" }
590             sub help_search {
591 0     0 1 0 <<'END';
592              
593             Search for messages with a given search term. The given search term can
594             contain up to 1000 characters.
595             END
596             }
597              
598              
599              
600             #
601             # About
602             #
603              
604 2     2 1 695 sub smry_about { "brief summary of maisha" }
605             sub help_about {
606 2     2 1 790 <<'END';
607             Provides a brief summary about maisha.
608             END
609             }
610             sub run_about {
611 1     1 1 1087 my @time = localtime(time);
612 1         4 $time[5] += 1900;
613 1         33 print <<ABOUT;
614              
615             Maisha is a command line application that can interface with a number of online
616             social networking sites. Referred to as micro-blogging, users can post status
617             updates to the likes of Twitter and Identi.ca. Maisha provides the abilty to
618             follow the status updates of friends and see who is following you, as well as
619             allowing you to send updates and send and receive direct messages too.
620              
621             Maisha means "life" in Swahili, and as the application is not tied to any
622             particular online service, it seemed an appropriate choice of name. After all
623             you are posting status updates about your life :)
624              
625             Maisha is written in Perl, and freely available as Open Source under the Perl
626             Artistic license. Copyright (c) 2009-$time[5] Barbie for Grango.org, the Open
627             Source development outlet of Miss Barbell Productions.
628            
629             See http://maisha.grango.org for further information.
630              
631             Version: $VERSION
632              
633             ABOUT
634             }
635              
636              
637             #
638             # Version
639             #
640              
641 2     2 1 677 sub smry_version { "display the current version of maisha" }
642             sub help_version {
643 2     2 1 701 <<'END';
644              
645             Displays the current version of maisha.
646             END
647             }
648             sub run_version {
649 1     1 1 1202 print "\nVersion: $VERSION\n";
650             }
651              
652              
653             #
654             # Debugging
655             #
656              
657 2     2 1 712 sub smry_debug { "turn on/off debugging" }
658             sub help_debug {
659 2     2 1 732 <<'END';
660              
661             Some commands may return unexpected results. More verbose output can be
662             returned when debugging is turned on. Set 'debug on' or 'debug off' to
663             turn the debugging functionality on or off respectively.
664             END
665             }
666             sub run_debug {
667 1     1 1 1184 my ($self,$state) = @_;
668              
669 1 50       4 if(!$state) {
    0          
    0          
670 1         9 print "Please use 'on' or 'off' with debug command\n\n";
671             } elsif($state eq 'on') {
672 0         0 $self->debug(1);
673 0         0 print "Debugging is ON\n\n";
674             } elsif($state eq 'off') {
675 0         0 $self->debug(0);
676 0         0 print "Debugging is OFF\n\n";
677             } else {
678 0         0 print "Please use 'on' or 'off' with debug command\n\n";
679             }
680             };
681              
682              
683             #
684             # Quit/Exit
685             #
686              
687 4     4 1 1460 sub smry_quit { "alias to exit" }
688             sub help_quit {
689 4     4 1 1407 <<'END';
690              
691             Exits the program.
692             END
693             }
694             sub run_quit {
695 0     0 1 0 my $self = shift;
696 0         0 $self->stoploop;
697             }
698              
699             *run_q = \&run_quit;
700             *smry_q = \&smry_quit;
701             *help_q = \&help_quit;
702              
703             sub postcmd {
704 0     0 1 0 my ($self, $handler, $cmd, $args) = @_;
705             #print "$$handler - $$cmd\n" if($self->debug);
706 0 0 0     0 return if($handler && $$handler =~ /^(comp|help|smry)_/);
707 0 0 0     0 return if($cmd && $$cmd =~ /^(q|quit)$/);
708              
709 0         0 push @{$self->{history}}, $self->line;
  0         0  
710 0         0 print $self->networks;
711             }
712              
713             sub preloop {
714 0     0 1 0 my $self = shift;
715 0         0 my $file = $self->history;
716 0 0 0     0 if($file && -f $file) {
717 0 0       0 my $fh = IO::File->new($file,'r') or return;
718 0         0 while(<$fh>) {
719 0         0 s/\s+$//;
720 0 0       0 next unless($_);
721 0         0 $self->term->addhistory($_);
722 0         0 push @{$self->{history}}, $_;
  0         0  
723             }
724             }
725             }
726              
727             sub postloop {
728 0     0 1 0 my $self = shift;
729 0 0       0 if(my $file = $self->history) {
730 0 0       0 my @history = grep { $_ && $_ !~ /^(q|quit)$/ } @{$self->{history}};
  0         0  
  0         0  
731 0 0       0 if(@history) {
732 0         0 mkpath(dirname($file));
733 0 0       0 my $fh = IO::File->new($file,'w+') or return;
734 0 0       0 splice( @history, 0, (scalar(@history) - 100)) if(@history > 100);
735 0         0 print $fh join("\n", @history);
736 0         0 $fh->close;
737             }
738             }
739             }
740              
741             #----------------------------------------------------------------------------
742             # Private Methods
743              
744             sub _reset_networks {
745 2     2   4 my $self = shift;
746 2         3 my $first = 1;
747 2         11 my $str = "\nNetworks: ";
748 2         5 my $services = $self->services;
749 2         16 for my $item (@$services) {
750 3         8 my $ref = ref($item);
751 3         14 $ref =~ s/^App::Maisha::Plugin:://;
752 3 100       13 $str .= $first ? "[$ref]" : " $ref";
753 3         5 $first = 0;
754             }
755 2         5 $str .= "\n";
756 2         11 $self->networks($str);
757             }
758              
759             sub _elem {
760 138     138   194 my $self = shift;
761 138         201 my $name = shift;
762 138         208 my $value = $self->{$name};
763 138 100       247 if (@_) {
764 63         165 $self->{$name} = shift;
765             }
766 138         372 return $value;
767             }
768              
769             sub _run_snapshot {
770 2     2   11 my ($self,$cmd,$max,$num) = @_;
771 2         6 my (@pages,@results,$max_id);
772 2         6 my ($limit,$pages,$count) = $self->_get_limits($max,$num);
773              
774 2 50       5 if($pages) {
775 0         0 for my $page (1 .. $pages) {
776 0         0 my $ref = {};
777 0 0       0 $ref->{max_id} = $max_id-1 if($max_id);
778 0 0       0 $ref->{count} = $count if($count);
779              
780 0         0 my $ret;
781 0         0 eval { $ret = $self->_command($cmd,$ref) };
  0         0  
782 0 0       0 last unless($ret);
783 0 0 0     0 last if($max_id && $max_id == $ret->[-1]{id});
784 0         0 unshift @pages, @$ret;
785 0         0 $max_id = $ret->[-1]{id};
786             }
787             } else {
788 2         3 my $ret;
789 2         3 eval { $ret = $self->_command($cmd) };
  2         8  
790 2 50       4 push @pages, @$ret if($ret);
791             }
792              
793 2 50       14 return unless(@pages);
794 0         0 for my $page (@pages) {
795 0         0 push @results, @$page;
796             }
797 0         0 $self->_print_messages($limit,undef,\@results);
798             }
799              
800             sub _run_results {
801 0     0   0 my ($self,$cmd,$max,$num,$term) = @_;
802 0         0 my (@pages,@results,$max_id);
803 0         0 my ($limit,$pages,$count) = $self->_get_limits($max,$num);
804              
805 0 0       0 if($pages) {
806 0         0 for my $page (1 .. $pages) {
807 0         0 my $ref = {};
808 0 0       0 $ref->{max_id} = $max_id-1 if($max_id);
809 0 0       0 $ref->{count} = $count if($count);
810              
811 0         0 my $ret;
812 0         0 eval { $ret = $self->_command($cmd,$term,$ref) };
  0         0  
813 0 0       0 last unless($ret);
814 0 0 0     0 last if($max_id && $max_id == $ret->[-1]{id});
815 0         0 unshift @pages, [ @{$ret->{results}} ];
  0         0  
816 0         0 $max_id = $ret->{results}[-1]{id};
817             }
818             } else {
819 0         0 my $ret;
820 0         0 eval { $ret = $self->_command($cmd,$term) };
  0         0  
821 0 0       0 push @pages, [ @{$ret->{results}} ] if($ret);
  0         0  
822             }
823              
824 0 0       0 return unless(@pages);
825 0         0 for my $page (@pages) {
826 0         0 push @results, @$page;
827             }
828 0         0 $self->_print_messages($limit,undef,\@results);
829             }
830              
831             sub _run_timeline {
832 6     6   15 my ($self,$cmd,$max,$user,$num) = @_;
833 6         18 my ($limit,$pages,$count) = $self->_get_limits($max,$num,$self->limit);
834              
835 6   50     26 $pages ||= 1;
836              
837 6         9 my (@pages,@results,$max_id);
838 6         17 for my $page (1 .. $pages) {
839 6         9 my $ref = {};
840 6 50       10 $ref->{screen_name} = $user if($user);
841 6 50       10 $ref->{max_id} = $max_id-1 if($max_id);
842 6 50       10 $ref->{count} = $count if($count);
843              
844 6         6 my $ret;
845 6         8 eval { $ret = $self->_command($cmd,$ref) };
  6         10  
846 6 50       14 last unless($ret);
847 0 0 0     0 last if($max_id && $max_id == $ret->[-1]{id});
848 0         0 unshift @pages, $ret;
849 0         0 $max_id = $ret->[-1]{id};
850             }
851              
852 6 50       19 return unless(@pages);
853 0         0 for my $page (@pages) {
854 0         0 push @results, @$page;
855             }
856 0         0 $self->_print_messages($limit,'user',\@results);
857             }
858              
859             sub _command {
860 10     10   18 my $self = shift;
861 10         12 my $cmd = shift;
862              
863 10         28 $self->error('');
864              
865 10         19 my $services = $self->services;
866 10 50 33     26 return unless(defined $services && @$services);
867              
868 0         0 my $service = $services->[0];
869 0 0       0 return unless(defined $service);
870              
871 0         0 my $method = "api_$cmd";
872 0         0 my $ret;
873 0         0 eval { $ret = $service->$method(@_) };
  0         0  
874              
875 0 0       0 if ($@) {
    0          
876 0 0       0 print "Command $cmd failed :(" . ($self->debug ? " [$@]" : '') . "\n";
877 0         0 $self->error($@);
878             } elsif(!$ret) {
879 0         0 print "Command $cmd failed :(\n";
880             } else {
881             #print "$cmd ok\n";
882             }
883              
884 0         0 return $ret;
885             }
886              
887             sub _commands {
888 0     0   0 my $self = shift;
889 0         0 my $cmd = shift;
890              
891 0         0 $self->error('');
892              
893 0         0 my $services = $self->services;
894 0 0 0     0 return unless(defined $services && @$services);
895              
896 0         0 for my $service (@$services) {
897 0 0       0 next unless(defined $service);
898              
899 0         0 my $class = ref($service);
900 0         0 $class =~ s/^App::Maisha::Plugin:://;
901              
902 0         0 my $method = "api_$cmd";
903 0         0 my $ret;
904 0         0 eval { $ret = $service->$method(@_) };
  0         0  
905              
906 0 0       0 if ($@) {
    0          
907 0 0       0 print "[$class] Command $cmd failed :(" . ($self->debug ? " [$@]" : '') . "\n";
908 0         0 $self->error("[$class] $@");
909             } elsif(!$ret) {
910 0         0 print "[$class] Command $cmd failed :(\n";
911             } else {
912 0         0 print "[$class] $cmd ok\n";
913             }
914             }
915              
916 0         0 return 1;
917             }
918              
919             sub _print_messages {
920 0     0   0 my ($self,$limit,$who,$ret) = @_;
921              
922 0         0 $Text::Wrap::columns = $self->chars;
923              
924 0 0       0 my @recs = $self->order =~ /^asc/i ? @$ret : reverse @$ret;
925 0 0 0     0 splice(@recs,$limit) if($limit && $limit < scalar(@recs));
926 0         0 @recs = reverse @recs;
927              
928             my $msgs = "\n" .
929             join("\n", map {
930 0         0 wrap('',' ',$self->_format_message($_,$who))
  0         0  
931             } @recs ) . "\n";
932 0 0       0 if ($self->pager) {
933 0         0 $self->page($msgs);
934             } else {
935 0         0 print $msgs;
936             }
937             }
938              
939             sub _format_message {
940 0     0   0 my ($self,$mess,$who) = @_;
941 0         0 my ($user,$text);
942              
943 0         0 my $network = $self->networks();
944 0         0 $network =~ s!^.*?\[([^\]]+)\].*!$1!s;
945              
946 0         0 my $timestamp = $mess->{created_at};
947 0         0 my ($M,$D,$T,$Y) = $timestamp =~ /\w+\s+(\w+)\s+(\d+)\s+([\d:]+)\s+\S+\s+(\d+)/; # Sat Oct 13 19:01:19 +0000 2012
948 0 0       0 ($D,$M,$Y,$T) = $timestamp =~ /\w+,\s+(\d+)\s+(\w+)\s+(\d+)\s+([\d:]+)/ unless($M); # Sat, 13 Oct 2012 19:01:19 +0000
949              
950 0         0 my $datetime = sprintf "%02d/%02d/%04d %s", $D, $months{$M}, $Y, $T;
951 0         0 my $date = sprintf "%02d/%02d/%04d", $D, $months{$M}, $Y;
952 0         0 my $time = $T;
953              
954 0 0       0 if($who) {
955 0         0 $user = $mess->{$who}{screen_name};
956 0         0 $text = $mess->{text};
957             } else {
958 0   0     0 $user = $mess->{screen_name} || $mess->{from_user};
959 0   0     0 $text = $mess->{status}{text} || $mess->{text};
960 0   0     0 $text ||= '';
961             }
962              
963 0         0 my $format = $self->format;
964 0         0 $format =~ s!\%U!$user!g;
965 0         0 $format =~ s!\%M!$text!g;
966 0         0 $format =~ s!\%T!$timestamp!g;
967 0         0 $format =~ s!\%D!$datetime!g;
968 0         0 $format =~ s!\%t!$time!g;
969 0         0 $format =~ s!\%d!$date!g;
970 0         0 $format =~ s!\%N!$network!g;
971 0         0 return $format;
972             }
973              
974             sub _get_limits {
975 10     10   19 my ($self,$max,$limit,$default) = @_;
976 10   33     43 $limit ||= $default;
977 10 50       25 return unless($limit);
978              
979 0 0       0 return unless($limit =~ /^\d+$/);
980 0 0       0 $limit = $max->{limit} if($limit > $max->{limit});
981 0         0 my $count = $max->{count};
982              
983 0 0       0 return($limit,1,$limit) if($limit <= $count);
984              
985 0 0       0 my $pages = int($limit / $count) + ($limit % $count ? 1 : 0);
986 0         0 return($limit,$pages,$count);
987             }
988              
989             sub _load_plugins {
990 1     1   3 my $self = shift;
991 1         13 for my $plugin ($self->plugins()) {
992 4         27 my $class = ref($plugin);
993 4         13 $class =~ s/^App::Maisha::Plugin:://;
994             #print STDERR "CLASS=$class, PLUGIN=$plugin\n";
995 4 100       14 $plugins{$class} = $plugin unless($class eq 'Base');
996             }
997             }
998              
999             sub _get_plugin {
1000 2     2   5 my $self = shift;
1001 2 50       7 my $class = shift or return;
1002 2   50     10 return $plugins{$class} || undef;
1003             }
1004              
1005             1;
1006              
1007             __END__
1008              
1009             =head1 METHODS
1010              
1011             =head2 Constructor
1012              
1013             =over 4
1014              
1015             =item * new
1016              
1017             =back
1018              
1019             =head2 Configuration Methods
1020              
1021             =over 4
1022              
1023             =item * context
1024              
1025             Used internally to reference the current shell for command handlers.
1026              
1027             =item * limit
1028              
1029             Used by timeline commands to limit the number of messages displayed. The
1030             default setting will display the last 20 messages.
1031              
1032             =item * order
1033              
1034             Used by timeline commands to order the messages displayed. The default is to
1035             display messages in descending order, with the most recent first and the oldest
1036             last.
1037              
1038             To reverse this order, set the 'order' as 'ascending' (or 'asc') in your
1039             configuration file. (case insensitive).
1040              
1041             =item * networks
1042              
1043             Sets the networks list that will appear above the command line.
1044              
1045             =item * prompt_str
1046              
1047             Sets the prompt string that will appear on the command line.
1048              
1049             =item * tag_str
1050              
1051             Sets the text that will appear at the end of your message.
1052              
1053             In order to suppress the tag string set the 'tag' option to '.' in your
1054             configuration file.
1055              
1056             =item * services
1057              
1058             Provides the order of services available, the first is always the primary
1059             service.
1060              
1061             =item * pager
1062              
1063             Enables the use of a pager when viewing timelines. Defaults to true
1064             if not specified.
1065              
1066             =item * format
1067              
1068             When printing a list of status messages, the default format of printing the
1069             username followed by the status message is not always suitable for everyone. As
1070             such you can define your own formatting.
1071              
1072             The default format is "[%U] %M", with the available formatting patterns defined
1073             as:
1074              
1075             %U - username or screen name
1076             %M - status message
1077             %T - timestamp (e.g. Sat Oct 13 19:29:17 +0000 2012)
1078             %D - datetime (e.g. 13/10/2012 19:29:17)
1079             %d - date only (e.g. 13/10/2012)
1080             %t - time only (e.g. 19:29:17)
1081             %N - network
1082              
1083             =item * chars
1084              
1085             As Maisha is run from the command line, it is most likely being run within a
1086             terminal window. Unfortunately there isn't currently a detection method for
1087             knowing the exact screen width being used. As such you can specify a width for
1088             the wrapper to use to ensure the messages are correctly line wrapped. The
1089             default setting is 80.
1090              
1091             =item * history
1092              
1093             Provides the history file, if available.
1094              
1095             =item * debug
1096              
1097             Boolean setting for debugging messages.
1098              
1099             =item * error
1100              
1101             The last error message received from a failing command.
1102              
1103             =back
1104              
1105             =head2 Run Methods
1106              
1107             The run methods are handlers to run the specific command requested.
1108              
1109             =head2 Help Methods
1110              
1111             The help methods are handlers to provide additional information about the named
1112             command when the 'help' command is used, with the name of a command as an
1113             argument.
1114              
1115             =head2 Summary Methods
1116              
1117             When the 'help' command is requested, with no additonal arguments, a summary
1118             of the available commands is display, with the text from each specific command
1119             summary method handler.
1120              
1121             =head2 Completion Methods
1122              
1123             For some commands completion methods are available to help complete the command
1124             request. for example with the 'use' command, pressing <TAB> will attempt to
1125             complete the name of the Network plugin name for you.
1126              
1127             =head2 Connect Methods
1128              
1129             The connect methods provide the handlers to connect to a service. This is
1130             performed automatically on startup for all the services provided in your
1131             configuration file.
1132              
1133             =over 4
1134              
1135             =item * connect
1136              
1137             =item * run_connect
1138              
1139             =item * help_connect
1140              
1141             =item * smry_connect
1142              
1143             =back
1144              
1145             =head2 Disconnect Methods
1146              
1147             The disconnect methods provide the handlers to disconnect from a service.
1148              
1149             =over 4
1150              
1151             =item * run_disconnect
1152              
1153             =item * help_disconnect
1154              
1155             =item * smry_disconnect
1156              
1157             =back
1158              
1159             =head2 Use Methods
1160              
1161             The use methods provide the handlers change the primary service. The primary
1162             service is used by the main messaging commands. All available services are
1163             used when 'update' or 'say' are used.
1164              
1165             =over 4
1166              
1167             =item * run_use
1168              
1169             =item * help_use
1170              
1171             =item * smry_use
1172              
1173             =item * comp_use
1174              
1175             =back
1176              
1177             =head2 Followers Methods
1178              
1179             The followers methods provide the handlers for the 'followers' command.
1180              
1181             =over 4
1182              
1183             =item * run_followers
1184              
1185             =item * help_followers
1186              
1187             =item * smry_followers
1188              
1189             =back
1190              
1191             =head2 Follow Methods
1192              
1193             The follow methods provide the handlers for the 'follow' command.
1194              
1195             =over 4
1196              
1197             =item * run_follow
1198              
1199             =item * help_follow
1200              
1201             =item * smry_follow
1202              
1203             =back
1204              
1205             =head2 Unfollow Methods
1206              
1207             The unfollow methods provide the handlers for the 'unfollow' command.
1208              
1209             =over 4
1210              
1211             =item * run_unfollow
1212              
1213             =item * help_unfollow
1214              
1215             =item * smry_unfollow
1216              
1217             =back
1218              
1219             =head2 User Methods
1220              
1221             The user methods provide the handlers display the profile of a named user.
1222              
1223             =over 4
1224              
1225             =item * run_user
1226              
1227             =item * help_user
1228              
1229             =item * smry_user
1230              
1231             =item * comp_user
1232              
1233             =back
1234              
1235             =head2 User Timeline Methods
1236              
1237             The user timeline methods provide the handlers for the 'user_timeline'
1238             command. Note that the 'ut' is an alias to 'user_timeline'.
1239              
1240             The user_timeline command has one optional parameter:
1241              
1242             maisha> ut [limit]
1243              
1244             =over 4
1245              
1246             =item * run_user_timeline
1247              
1248             =item * help_user_timeline
1249              
1250             =item * smry_user_timeline
1251              
1252             =item * comp_user_timeline
1253              
1254             =item * run_ut
1255              
1256             =item * help_ut
1257              
1258             =item * smry_ut
1259              
1260             =item * comp_ut
1261              
1262             =back
1263              
1264             =head2 Friends Methods
1265              
1266             The friends methods provide the handlers for the 'friends' command.
1267              
1268             =over 4
1269              
1270             =item * run_friends
1271              
1272             =item * help_friends
1273              
1274             =item * smry_friends
1275              
1276             =back
1277              
1278             =head2 Friends Timeline Methods
1279              
1280             The friends timeline methods provide the handlers for the 'friends_timeline'
1281             command. Note that the 'ft' is an alias to 'friends_timeline'.
1282              
1283             The friends_timeline command has one optional parameter:
1284              
1285             maisha> ft [limit]
1286              
1287             =over 4
1288              
1289             =item * run_friends_timeline
1290              
1291             =item * help_friends_timeline
1292              
1293             =item * smry_friends_timeline
1294              
1295             =item * run_ft
1296              
1297             =item * help_ft
1298              
1299             =item * smry_ft
1300              
1301             =back
1302              
1303             =head2 Public Timeline Methods
1304              
1305             The public timeline methods provide the handlers for the 'public_timeline'
1306             command. Note that the 'pt' is an alias to 'public_timeline'.
1307              
1308             The public_timeline command has one optional parameter:
1309              
1310             maisha> pt [limit]
1311              
1312             =over 4
1313              
1314             =item * run_public_timeline
1315              
1316             =item * help_public_timeline
1317              
1318             =item * smry_public_timeline
1319              
1320             =item * run_pt
1321              
1322             =item * help_pt
1323              
1324             =item * smry_pt
1325              
1326             =back
1327              
1328             =head2 Update Methods
1329              
1330             The update methods provide the handlers for the 'update' command. Note that
1331             'say' is an alias for 'update'.
1332              
1333             =over 4
1334              
1335             =item * run_update
1336              
1337             =item * help_update
1338              
1339             =item * smry_update
1340              
1341             =item * comp_update
1342              
1343             =item * run_say
1344              
1345             =item * help_say
1346              
1347             =item * smry_say
1348              
1349             =item * comp_say
1350              
1351             =back
1352              
1353             =head2 Reply Methods
1354              
1355             The reply methods provide the handlers for the 'replies' command. Note that
1356             're' is an aliases for 'replies'
1357              
1358             The replies command has one optional parameter:
1359              
1360             maisha> re [limit]
1361              
1362             =over 4
1363              
1364             =item * run_replies
1365              
1366             =item * help_replies
1367              
1368             =item * smry_replies
1369              
1370             =item * run_re
1371              
1372             =item * help_re
1373              
1374             =item * smry_re
1375              
1376             =back
1377              
1378             =head2 Direct Message Methods
1379              
1380             The direct message methods provide the handlers for the 'direct_message'
1381             command. Note that 'dm' is an aliases for 'direct_message'.
1382              
1383             The direct_message command has two optional parameters:
1384              
1385             maisha> dm [from|to] [limit]
1386              
1387             maisha> dm from
1388             maisha> dm to 10
1389             maisha> dm 5
1390             maisha> dm
1391              
1392             The first above is the usage, with the keywords 'from' and 'to' both being
1393             optional. If neither is specified, 'to' is assumed. In addition a limit for
1394             the number of message can be provided. If no limit is given, your configured
1395             default, or the system default (20) is used.
1396              
1397             =over 4
1398              
1399             =item * run_direct_messages
1400              
1401             =item * help_direct_messages
1402              
1403             =item * smry_direct_messages
1404              
1405             =item * run_dm
1406              
1407             =item * help_dm
1408              
1409             =item * smry_dm
1410              
1411             =back
1412              
1413             =head2 Send Message Methods
1414              
1415             The send message methods provide the handlers for the 'send_message' command.
1416             Note that both 'send' and 'sm' are aliases to 'send_message'
1417              
1418             =over 4
1419              
1420             =item * run_send_message
1421              
1422             =item * help_send_message
1423              
1424             =item * smry_send_message
1425              
1426             =item * comp_send_message
1427              
1428             =item * run_send
1429              
1430             =item * help_send
1431              
1432             =item * smry_send
1433              
1434             =item * comp_send
1435              
1436             =item * run_sm
1437              
1438             =item * help_sm
1439              
1440             =item * smry_sm
1441              
1442             =item * comp_sm
1443              
1444             =back
1445              
1446             =head2 Search Methods
1447              
1448             These methods provide the handlers for the 'search' command.
1449              
1450             The search command has one optional, and one mandatory parameter:
1451              
1452             maisha> search [limit] term [term ...]
1453              
1454             maisha> search term
1455             maisha> search 10 term
1456             maisha> search a really long search term
1457             maisha> search 20 a really long search term
1458              
1459             If the first parameter is a number, this will be treated as the limit value,
1460             used to limit the number of messages displayed.
1461              
1462             =over 4
1463              
1464             =item * run_search
1465              
1466             =item * help_search
1467              
1468             =item * smry_search
1469              
1470             =back
1471              
1472             =head2 About Methods
1473              
1474             These methods provide the handlers for the 'about' command.
1475              
1476             =over 4
1477              
1478             =item * run_about
1479              
1480             =item * help_about
1481              
1482             =item * smry_about
1483              
1484             =back
1485              
1486             =head2 Version Methods
1487              
1488             The quit methods provide the handlers for the 'version' command.
1489              
1490             =over 4
1491              
1492             =item * run_version
1493              
1494             =item * help_version
1495              
1496             =item * smry_version
1497              
1498             =back
1499              
1500             =head2 Debug Methods
1501              
1502             The debug methods provide more verbose error mesages if commands fail.
1503              
1504             The debug command has two optional parameters:
1505              
1506             maisha> debug on|off
1507              
1508             maisha> debug on
1509             maisha> debug off
1510              
1511             =over 4
1512              
1513             =item * run_debug
1514              
1515             =item * help_debug
1516              
1517             =item * smry_debug
1518              
1519             =back
1520              
1521             =head2 Quit Methods
1522              
1523             The quit methods provide the handlers for the 'quit' command. Note that both
1524             'quit' and 'q' are aliases to 'exit'
1525              
1526             =over 4
1527              
1528             =item * run_quit
1529              
1530             =item * help_quit
1531              
1532             =item * smry_quit
1533              
1534             =item * run_q
1535              
1536             =item * help_q
1537              
1538             =item * smry_q
1539              
1540             =back
1541              
1542             =head2 Internal Shell Methods
1543              
1544             Used internally to interface with the underlying shell application.
1545              
1546             =over 4
1547              
1548             =item * postcmd
1549              
1550             =item * preloop
1551              
1552             =item * postloop
1553              
1554             =back
1555              
1556             =head1 SEE ALSO
1557              
1558             For further information regarding the commands and configuration, please see
1559             the 'maisha' script included with this distribution.
1560              
1561             L<App::Maisha>
1562              
1563             L<Term::Shell>
1564              
1565             =head1 WEBSITES
1566              
1567             =over 4
1568              
1569             =item * Main Site: L<http://maisha.grango.org>
1570              
1571             =item * Git Repo: L<http://github.com/barbie/maisha/tree/master>
1572              
1573             =item * RT Queue: L<RT: http://rt.cpan.org/Public/Dist/Display.html?Name=App-Maisha>
1574              
1575             =back
1576              
1577             =head1 AUTHOR
1578              
1579             Barbie, <barbie@cpan.org>
1580             for Miss Barbell Productions <http://www.missbarbell.co.uk>.
1581              
1582             =head1 COPYRIGHT AND LICENSE
1583              
1584             Copyright (C) 2009-2019 by Barbie
1585              
1586             This distribution is free software; you can redistribute it and/or
1587             modify it under the Artistic License v2.
1588              
1589             =cut