src/Modules/pager.pl

   1 # Pager
   2 #
   3 # modified from pager.pm in flooterbuck changes are:
   4 #
   5 # Copyright (c) 2004 Tim Riker <Tim@Rikers.org>
   6 #
   7 # This package is free software;  you can redistribute it and/or
   8 # modify it under the terms of the license found in the file
   9 # named LICENSE that should have accompanied this file.
  10 #
  11 # THIS PACKAGE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
  12 # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  13 # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  14
  15 package pager;
  16 use strict;
  17
  18 my $no_page;
  19
  20 BEGIN {
  21         eval qq{
  22                 use Mail::Mailer qw(sendmail);
  23         };
  24         $no_page++ if ($@);
  25 }
  26
  27 sub pager::page {
  28         my ($message) = @_;
  29         my ($retval);
  30
  31         # TODO only allow registered users?
  32
  33         if ($no_page) {
  34                 &::status('page module requires Mail::Mailer.');
  35                 return 'page module not active';
  36         }
  37
  38         unless ($message =~ /^(\S+)\s+(.*)$/) {
  39                 return undef;
  40         }
  41
  42         my $from = $::who;
  43         my $to = $1;
  44         my $msg = $2;
  45
  46         # allow optional trailing : ie: page foo[:] hello
  47         $to =~ s/:$//;
  48
  49         my $tofactoid = &::getFactoid(lc "${to}'s pager");
  50         if ($tofactoid =~ /(\S+@\S+)/) {
  51                 my $toaddr = $1;
  52                 $toaddr =~ s/^mailto://;
  53                 # TODO require sender-locked factoid?
  54
  55                 my $fromfactoid = &::getFactoid(lc "${from}'s pager");
  56
  57                 my $fromaddr;
  58                 if ($fromfactoid =~ /(\S+@\S+)/) {
  59                         $fromaddr = $1;
  60                         $fromaddr =~ s/^mailto://;
  61                 } else {
  62                         # TODO require sender to have valid self-locked pager factoid?
  63                         $fromaddr = 'infobot@example.com';
  64                 }
  65
  66                 my $channel = $::chan || 'infobot';
  67                 # TODO disallow use from private message? $chan='_default'
  68
  69                 &::status("pager: from $from <$fromaddr>, to $to <$toaddr>, msg \"$msg\"");
  70                 my %headers = (
  71                         To => "$to <$toaddr>",
  72                         From => "$from <$fromaddr>",
  73                         Subject => "Message from $channel!",
  74                         'X-Mailer' => 'infobot',
  75                 );
  76
  77 #               my $logmsg;
  78 #               for (keys %headers) {
  79 #                       $logmsg .= "$_: $headers{$_}\n";
  80 #               }
  81 #               $logmsg .= "\n$msg\n";
  82 #               &::status("pager:\n$logmsg");
  83
  84                 my $failed;
  85                 my $mailer = new Mail::Mailer 'sendmail';
  86                 $failed++ unless $mailer->open(\%headers);
  87                 $failed++ unless print $mailer "$msg\n";
  88                 $failed++ unless $mailer->close;
  89
  90                 if ($failed) {
  91                         $retval='Sorry, an error occurred while sending mail.';
  92                 } else {
  93                         $retval="$from: I sent mail to $toaddr from $fromaddr.";
  94                 }
  95         } else {
  96                 $retval="Sorry, I don't know ${to}'s email address.";
  97         }
  98         &::performStrictReply($retval);
  99 }
 100
 101 'pager';
 102 # vim: ts=2 sw=2