bin/nag.pl

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 =head1 NAME $RCSfile: nag.pl,v $
   6
   7 Nag: A progressively more agressive reminder program.
   8
   9 =head1 VERSION
  10
  11 =over
  12
  13 =item Author
  14
  15 Andrew DeFaria <Andrew@ClearSCM.com>
  16
  17 =item Revision:
  18
  19 $Revision: 1.6 $
  20
  21 =item Created:
  22
  23 Tue Jul 27 15:00:11 PDT 2004
  24
  25 =item Modified:
  26
  27 $Date: 2013/06/13 14:36:03 $
  28
  29 =back
  30
  31 =head1 SYNOPSIS
  32
  33  Usage: nag.pl [-u|sage] [-ve|rbose] [-d|ebug] [-nos|ign] [-noe|xec]
  34                [-not|ag]
  35
  36  Where:
  37
  38  -u|sage:     Displays this usage
  39  -ve|rbose:   Be verbose
  40  -d|ebug:     Output debug messages
  41
  42  -noe|xec:     No execute mode - just echo out what would have
  43                been done (Default: exec)
  44  -not|ag:      Tag message with a signature detailing how many
  45                times we've sent this email and when was the last time we
  46                sent it (Default: Don't tag)
  47  -nos|ign:     Include random signature from ~/.signatures (Default: Don't
  48                sign)
  49  -f|ile <file> Use <file> as naglist (Default: ~/.nag/list)
  50
  51 =head1 DESCRIPTION
  52
  53 This script read a file indicating who to remind. The format for this file is:
  54
  55  <email>|<subject>|<when>|<msgfile>|<sent>|<date>
  56
  57 nag.pl will change a message that was set to send on a particular day of the
  58 week to daily after 3 messages were sent. So if you set the message to be send
  59 on say Mon it will be sent to 3 weeks and then flip to be sent daily.
  60
  61 =head1 The following things should be done to improve this system:
  62
  63 =over
  64
  65 =item *
  66
  67 Move naglist and message files to a database
  68
  69 =item *
  70
  71 Change MAPS to recognize when a message is returned from a nag message. Perhaps
  72 tag it with X-Nag: <nag id> (will this come back when the user replies?). MAPS
  73 would then white list the sender and deliver the email as well as put the nag in
  74 a pending state.
  75
  76 =cut
  77
  78 use strict;
  79 use warnings;
  80
  81 use FindBin;
  82 use Getopt::Long;
  83
  84 use lib "$FindBin::Bin/../lib";
  85
  86 use DateUtils;
  87 use Display;
  88 use Mail;
  89 use Utils;
  90
  91 my $VERSION = '1.0';
  92
  93 my $exec = 1;
  94 my ($tag, $sign);
  95
  96 my $nagfile = "$ENV{HOME}/.nag/list";
  97
  98 sub dow () {
  99   my @days = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
 100
 101   return $days[(localtime (time)) [6]];
 102 } # dow
 103
 104 sub sign () {
 105   my $sigfile = "$ENV{HOME}/.signatures";
 106
 107   return unless -r $sigfile;
 108
 109   my $signature  = "-- <br>";
 110
 111   open my $sigs, '<', $sigfile
 112     or error "Unable to open signature file $sigfile - $!", 1;
 113
 114   my @sigs = <$sigs>;
 115   chomp @sigs;
 116
 117   close $sigs;
 118
 119   $signature .= '<font color="#bbbbbb">';
 120   $signature .= splice (@sigs, int (rand (@sigs)), 1);
 121   $signature .= '</font>';
 122
 123   return $signature;
 124 } # sign
 125
 126 sub tag ($$) {
 127   my ($sent, $date) = @_;
 128
 129   return ''
 130     unless $sent;
 131
 132   my $tagStr  = '<hr><p style="text-align: center;">';
 133      $tagStr .= "This message has been sent to you $sent time";
 134
 135      $tagStr .= 's'
 136        if $sent > 1;
 137
 138      $tagStr .= " before<br>";
 139      $tagStr .= "The last time this message was sent to you was $date<br>";
 140      $tagStr .= "$FindBin::Script $VERSION<br></p>";
 141
 142   return $tagStr;
 143 } # tag
 144
 145 ## Main
 146 GetOptions (
 147   usage    => sub { Usage },
 148   verbose  => sub { set_verbose },
 149   debug    => sub { set_debug },
 150   'exec!'  => \$exec,
 151   'tag!',  => \$tag,
 152   'sign!', => \$sign,
 153   'file',  => \$nagfile,
 154 ) or Usage 'Invalid parameter';
 155
 156 my $nagfilenew = "$nagfile.$$";
 157
 158 open my $nagsIn, '<', $nagfile
 159   or error "Unable to open $nagfile for read access - $!", 1;
 160
 161 open my $nagsOut, '>', $nagfilenew
 162   or error "Unable to open new nagfile $nagfilenew for write access - $!", 1;
 163
 164 while (<$nagsIn>) {
 165   if (/^#/ or /^$/) {
 166     print $nagsOut $_;
 167     next;
 168   } # if
 169
 170   chomp;
 171
 172   my ($email, $subject, $when, $msgfile, $sent, $date) = split /\|/;
 173
 174   $sent ||= 0;
 175
 176   my $dow = dow;
 177
 178   if ($when =~ /$dow/i or $when =~ /daily/i) {
 179     verbose "Nagging $email with $msgfile...";
 180
 181     my $footing = '';
 182
 183     $footing = tag $sent, $date
 184       if $tag;
 185
 186     $footing .= sign
 187       if $sign;
 188
 189     my $msg;
 190
 191     my $msgfilename = $msgfile;
 192        $msgfilename =~ s/~/$ENV{HOME}/;
 193
 194     open $msg, '<', $msgfilename
 195       or error "Unable to open message file $msgfile - $!", 1;
 196
 197     mail (
 198       to      => $email,
 199       subject => $subject,
 200       mode    => 'html',
 201       data    => $msg,
 202       footing => $footing,
 203     );
 204
 205     close $msg
 206       or error "Unable to close message file $msg - $!", 1;
 207
 208     $sent++;
 209     $date = YMDHM;
 210     $when = "Daily"
 211       if $sent > 3;
 212
 213     print $nagsOut "$email|$subject|$when|$msgfile|$sent|$date\n";
 214   } else {
 215     print $nagsOut "$_\n";
 216   } # if
 217 } # while
 218
 219 close $nagsIn
 220   or error "Unable to close $nagfile - $!", 1;
 221
 222 close $nagsOut
 223   or error "Unable to close $nagfilenew - $!", 1;
 224
 225 rename $nagfilenew, $nagfile
 226   or error "Unable to rename $nagfilenew to $nagfile", 1;
 227
 228 =pod
 229
 230 =head1 CONFIGURATION AND ENVIRONMENT
 231
 232 DEBUG: If set then $debug is set to this level.
 233
 234 VERBOSE: If set then $verbose is set to this level.
 235
 236 TRACE: If set then $trace is set to this level.
 237
 238 =head1 DEPENDENCIES
 239
 240 =head2 Perl Modules
 241
 242 L<FindBin>
 243
 244 L<Getopt::Long|Getopt::Long>
 245
 246 =head2 ClearSCM Perl Modules
 247
 248 =begin man
 249
 250  DateUtils
 251  Display
 252  Mail
 253  Utils
 254
 255 =end man
 256
 257 =begin html
 258
 259 <blockquote>
 260 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
 261 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
 262 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
 263 <a href="http://clearscm.com/php/scm_man.php?file=lib/Utils.pm">Utils</a><br>
 264 </blockquote>
 265
 266 =end html
 267
 268 =head1 BUGS AND LIMITATIONS
 269
 270 There are no known bugs in this script
 271
 272 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 273
 274 =head1 LICENSE AND COPYRIGHT
 275
 276 Copyright (c) 2004, ClearSCM, Inc. All rights reserved.
 277
 278 =cut