identica.pl

   1 #! /usr/bin/perl
   2 #
   3 # Copyright © 2009 Sebastian "tokkee" Harl
   4 # All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions are met:
   8 # 1. Redistributions of source code must retain the above copyright notice,
   9 #    this list of conditions and the following disclaimer.
  10 # 2. Redistributions in binary form must reproduce the above copyright notice,
  11 #    this list of conditions and the following disclaimer in the documentation
  12 #    and/or other materials provided with the distribution.
  13 # 3. Neither the name of the copyright holders nor the names of their
  14 #    contributors may be used to endorse or promote products derived from this
  15 #    software without specific prior written permission.
  16 #
  17 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
  18 # IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  19 # THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  20 # PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
  21 # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  22 # EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  23 # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
  24 # OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  25 # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  26 # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  27 # ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28 #
  29 # Author:
  30 #   Sebastian "tokkee" Harl <sh@tokkee.org>
  31
  32 use strict;
  33 use warnings;
  34
  35 use utf8;
  36 use open ':locale';
  37
  38 use Term::ANSIColor;
  39
  40 use Net::Twitter::Lite;
  41
  42 my $conf_file = "$ENV{'HOME'}/.identica.conf";
  43
  44 my ($fh, $nt);
  45 my %id;
  46
  47 # This file should fill the %id hash.
  48 #
  49 # See <http://search.cpan.org/~mmims/Net-Twitter-Lite-0.08000/lib/Net/
  50 # Twitter/Lite.pm#METHODS_AND_ARGUMENTS> for details about which parameters
  51 # are available.
  52 if (! open($fh, '<', $conf_file)) {
  53         print_err("Failed to open config file ($conf_file): $!\n");
  54         exit 1;
  55 }
  56
  57 {
  58         my @conf = <$fh>;
  59         eval join '', @conf;
  60 }
  61
  62 close($fh);
  63
  64 if (! $id{'identica'}) {
  65         print_err('id{identica} has not been set - '
  66                 . 'Twitter is not currently supported!' . "\n");
  67         exit 1;
  68 }
  69
  70 $nt = Net::Twitter::Lite->new(%id);
  71
  72 if (! $nt) {
  73         print_err("Failed to create Net::Twitter::Lite object: $!\n");
  74         exit 1;
  75 }
  76
  77 while (42) {
  78         my $msg = "";
  79         my $status;
  80         my $err;
  81
  82         print "identi.ca> ", ' ' x 140, '←', "\r";
  83         print color 'bold';
  84         print "identi.ca> ";
  85         print color 'reset';
  86
  87         $msg = <STDIN>;
  88
  89         if (! defined($msg)) {
  90                 last;
  91         }
  92         elsif ($msg =~ m/^\?(\?)?(\d+)?$/) {
  93                 my $friends = $1;
  94                 my $count = $2;
  95                 my $posts;
  96
  97                 if (! defined($count)) {
  98                         $count = 5;
  99                 }
 100
 101                 eval {
 102                         if (defined $friends) {
 103                                 $posts = $nt->friends_timeline({count => $count});
 104                         }
 105                         else {
 106                                 $posts = $nt->user_timeline({count => $count});
 107                         }
 108                 };
 109
 110                 if ($err = $@) {
 111                         print_err("Failed to get ``tweeds'': $err\n");
 112                         next;
 113                 }
 114
 115                 foreach my $post (@$posts) {
 116                         my $text   = $post->{'text'};
 117                         my $source = $post->{'source'};
 118
 119                         utf8::upgrade($text);
 120
 121                         if ($source =~ m/^<a href="[^"]+">(.*)<\/a>$/) {
 122                                 $source = $1;
 123                         }
 124
 125                         print $post->{'created_at'} . ' (';
 126                         print color 'bold blue';
 127                         print $post->{'user'}->{'screen_name'};
 128                         print color 'reset';
 129                         print ", $source): ";
 130                         print color 'dark yellow';
 131                         print "$text\n";
 132                         print color 'reset';
 133                 }
 134                 next;
 135         }
 136
 137         eval {
 138                 $status = $nt->update({ status => $msg });
 139         };
 140
 141         if ($err = $@) {
 142                 print_err("Failed to send message: $err\n");
 143                 next;
 144         }
 145
 146         print color 'bold green';
 147         print 'http://identi.ca/notice/' . $status->{'id'} . "\n";
 148         print color 'reset';
 149 }
 150
 151 print color 'bold';
 152 print "\nBye!\n";
 153 print color 'reset';
 154
 155 sub print_err {
 156         print STDERR color 'bold red';
 157         print STDERR join(' ', @_);
 158         print STDERR color 'reset';
 159 }
 160
 161 # vim: set noexpandtab tw=78 sw=4 ts=4 :
 162