perl/kyberia/dist-probably-outdated/Kyberia.pl

   1 #!/usr/bin/env perl
   2 #Kyberia client... (Harvie 2oo9)
   3 #THX2 ||
   4
   5 use strict;
   6 use warnings;
   7
   8 package Kyberia;
   9         use LWP;
  10         use HTML::Entities;
  11
  12         our $url;
  13         our $browser;
  14
  15         sub new { #constructor
  16                 my ($self, $kurl) = @_;
  17                 $url = $kurl;
  18     $browser = LWP::UserAgent->new( );
  19     $browser->cookie_jar( {} );
  20                 return $self;
  21         }
  22
  23         sub Login {
  24                 my ($self, $user, $pass) = @_;
  25                 my $response = $browser->post( $url,
  26                         [ 'event' => 'login',
  27                                 'login' => $user,
  28                                 'password' => $pass,
  29                                 'login_type' => 'name',
  30                         ]
  31                 );
  32                 return $response->is_success;
  33         }
  34
  35         sub Logout {
  36                 my $response = $browser->post( $url,
  37                         [ 'event' => 'logout'
  38                         ]
  39                 );
  40                 return $response->is_success;
  41         }
  42
  43         sub SendMail {
  44                 my ($self, $user, $message) = @_;
  45                 my $response = $browser->post( $url,
  46                         [ 'event' => 'send',
  47                                 'mail_to' => $user,
  48                                 'mail_to_type' => 'name',
  49                                 'mail_text' => $message,
  50                         ]
  51                 );
  52                 return $response->is_success;
  53         }
  54
  55         sub GetNode {
  56                 my ($self, $id) = @_;
  57                 my $response = $browser->get("$url/id/$id/");
  58                 return $response->content;
  59         }
  60
  61         sub ReadMail {
  62                 my $response = $browser->get("$url/id/2176597/");
  63                 my @mails = split(/\n/, $response->content); $response = '';
  64                 shift(@mails); #remove CSV header
  65                 foreach (@mails) {
  66                         my ($MSG_ID, $FROM, $FROM_ID, $TO, $TO_ID, $TIME, $NEW, $TEXT) = split(/;/, $_, 8); #parse CSV
  67                         $TEXT =~ s/\\n/\n/g; decode_entities($TEXT); #unescape message
  68                         print("#$MSG_ID $FROM --> $TO ($TIME)\n\n$TEXT\n---------------------------------\n");
  69                 }
  70                 return $response->is_success;
  71         }
  72
  73         sub CheckMail {
  74                 my $response = $browser->get("$url/ajax/check_new_mail.php");
  75                 my @mails = split(/;/, $response->content);
  76                 return ($mails[0], $mails[1], "You have $mails[0] unread mails, last from $mails[1].");
  77         }
  78
  79         return 1;