001 #!/usr/bin/perl -w
002 use strict;
003 use Gaim::Log::Parser 0.04;
004 use Gaim::Log::Finder;
005 use Sysadm::Install 0.23 qw(:all);
006 use Lingua::StopWords;
007 use Text::Language::Guess;
008 use Log::Log4perl qw(:easy);
009 use Text::Wrap qw(fill $columns);
010 use URI::Find;
011 use IMAP::Client;
012 use DateTime::Format::Mail;
013 
014 my $mailbox = "im_mailbox";
015 my $tzone   = "America/Los_Angeles";
016 my $min_age = 3600;
017 my $sleep   = 3600;
018 
019 my %im_stopwords = map { $_ => 1 } qw(
020 maybe thanks thx doesn hey put already 
021 said say would can could haha hehe see 
022 well think like heh now many lol doh );
023 
024 Log::Log4perl->easy_init({
025   level => $DEBUG, category => "main",
026   file  => ">>$ENV{HOME}/.gaim2imap.log"
027 });
028 
029 my $PW = password_read("password: ");
030 
031 my $pid = fork();
032 die "fork failed" if ! defined $pid;
033 exit 0 if $pid;
034 
035 dbmopen my %SEEN, 
036         "$ENV{HOME}/.gaim/.seen", 0644 or
037      LOGDIE "Cannot open dbm file ($!)";
038 
039 $SIG{TERM} = sub { INFO "Exiting"; 
040     dbmclose %SEEN;
041     exit 0;
042 };
043 
044 while(1) {
045     update();
046     INFO "Sleeping $sleep secs";
047     sleep $sleep;
048 }
049 
050 ###########################################
051 sub update {
052 ###########################################
053   DEBUG "Connecting to IMAP server";
054 
055   my $imap = new IMAP::Client();
056   $imap->onfail('ABORT');
057   $imap->connect(PeerAddr => 'localhost',
058       ConnectMethod => 'PLAIN');
059 
060   my $u = getpwuid $>;
061   $imap->authenticate($u, $PW);
062 
063   my $finder = Gaim::Log::Finder->new(
064     callback => sub { 
065       my($self, $file, $protocol, 
066          $from, $to) = @_;
067 
068       return 1 if $from eq $to;
069 
070       my $mtime = (stat $file)[9];
071       my $age = time() - $mtime;
072 
073       return 1 if $SEEN{$file} and
074                   $SEEN{$file} == $mtime;
075 
076       if($age < $min_age) {
077           INFO "$file: Too recent ($age)";
078           return 1;
079       }
080 
081       $SEEN{$file} = $mtime;
082       INFO "Processing log file: $file";
083       my($subject, $formatted, $epoch) = 
084                    chat_process($file);
085 
086       imap_add($imap, $mailbox, $epoch, 
087                "$to\@gaim", "", $subject, 
088                $formatted);
089   });
090 
091   $finder->find();
092 }
093 
094 ###########################################
095 sub chat_process {
096 ###########################################
097   my($file) = @_;
098 
099   my $parser = Gaim::Log::Parser->new(
100     file => $file,
101   );
102       # Search+delete URL processor
103   my $urifind = URI::Find->new(sub {""});
104 
105   my $text      = "";
106   my $formatted = "";
107   my $urifound;
108   $Text::Wrap::columns = 70;
109 
110   while(my $m = $parser->next_message()) {
111     my $content = $m->content();
112     $content =~ s/\n+/ /g;
113     $formatted .= fill("", "  ", 
114       nice_time($m->date()) . " " .
115       $m->from() . ": " . $content) . "\n\n";
116 
117     $urifound = 
118         $urifind->find(\$content);
119     $text .= " " . $content;
120   }
121 
122   my $guesser = Text::Language::Guess->
123             new(languages => ['en', 'de']);
124 
125   my $lang = 
126     $guesser->language_guess_string($text);
127 
128   $lang = 'en' unless $lang;
129   DEBUG "Guessed language: $lang\n";
130 
131   my $stopwords = 
132     Lingua::StopWords::getStopWords($lang);
133 
134   my %words;
135 
136   while($text =~ /\b(\w+)\b/g) {
137     my $word = lc($1);
138     next if $stopwords->{$word};
139     next if $word =~ /^\d+$/;
140     next if length($word) <= 2;
141     next if exists $im_stopwords{$word};
142     $words{$word}++;
143     $words{$word} += 3 if length $word > 6;
144   }
145 
146   my @weighted_words = sort { 
147     $words{$b} <=> $words{$a} 
148   } keys %words;
149 
150   my $subj = ($urifound ? '*L*' : "");
151   my $char = "";
152 
153   while(@weighted_words and length($subj) + 
154       length($char . 
155 	     $weighted_words[0]) <= 70) {
156     $subj .= $char .  shift @weighted_words;
157     $char = ", ";
158   }
159 
160   return($subj, $formatted, 
161          $parser->{dt}->epoch());
162 }
163 
164 ###########################################
165 sub imap_add {
166 ###########################################
167   my($imap, $mailbox, $date, 
168      $from, $to, $subject, $text) = @_;
169 
170   $date = 
171    DateTime::Format::Mail->format_datetime(
172      DateTime->from_epoch(
173          epoch => $date, 
174          time_zone => $tzone));
175 
176   my $message = "Date: $date\n" .
177     "From: $from\n" .
178     "To: $to\n" .
179     "Subject: $subject\n\n$text";
180 
181   my $fl = $imap->buildflaglist();
182   $imap->append($mailbox, $message, $fl);
183 }