Dev/twitter/show_status.pl

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 ## IMPORTANT ##
   8 # When Net::Twitter::Lite encounters a Twitter API error or a network error,
   9 # it throws a Net::Twitter::Lite::Error object.
  10 # You can catch and process these exceptions by using eval blocks and testing $@
  11 ## from http://search.cpan.org/perldoc?Net::Twitter::Lite#ERROR_HANDLING
  12 use Net::Twitter::Lite;
  13 use Data::Dumper;
  14
  15 my $bot = Net::Twitter::Lite->new;
  16
  17 my $dump;
  18 if (defined $ARGV[0] and $ARGV[0] eq "-d") {
  19     $dump = shift @ARGV;
  20 }
  21
  22 eval {
  23     foreach my $id (@ARGV) {
  24         $id =~ /\/?(\d+)$/;
  25         $id = $1;
  26         my $res = $bot->show_status($id);
  27         foreach my $line (split /\n/, Dumper $res) {
  28             if ($line =~ /undef/) { next; }
  29             if (! $dump) {
  30                 unless ($line =~ / => {/
  31                     ||  $line =~ / = /
  32                     ||  $line =~ /status/
  33                     ||  $line =~ /'text'/
  34                     ||  $line =~ /created/
  35                     ||  $line =~ /'id'/
  36                     ||  $line =~ /name/
  37                     ||  $line =~ / },/
  38                     ||  $line =~ / };/
  39                 ) { next; }
  40             }
  41             print $line, "\n";
  42         }
  43     }
  44 };
  45 if ($@) {
  46     evalrescue($@);
  47 }
  48
  49
  50 sub evalrescue {
  51     # output error message at eval error
  52
  53     use Scalar::Util qw(blessed);
  54
  55     if (blessed $@ && $@->isa('Net::Twitter::Lite::Error')) {
  56         warn $@->error;
  57         if ($@->twitter_error) {
  58             my %twitter_error = %{$@->twitter_error};
  59             map {
  60                 $twitter_error{"$_ => "} = $twitter_error{$_} . "\n";
  61                 delete $twitter_error{$_}
  62             } keys %twitter_error;
  63             warn join("", %twitter_error);
  64         }
  65     }
  66     else {
  67         warn $@;
  68     }
  69 }