bin/nag.pl

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 =head1 NAME $RCSfile: nag.pl,v $
   6
   7 Nag: A progressively more aggressive 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 reads 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 =back
  77
  78 =cut
  79
  80 use strict;
  81 use warnings;
  82
  83 use FindBin;
  84 use Getopt::Long;
  85
  86 use lib "$FindBin::Bin/../lib";
  87
  88 use DateUtils;
  89 use Display;
  90 use Mail;
  91 use Utils;
  92
  93 my $VERSION = '1.0';
  94
  95 my $exec = 1;
  96 my ($tag, $sign);
  97
  98 my $nagfile = "$ENV{HOME}/.nag/list";
  99
 100 sub dow () {
 101   my @days = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
 102
 103   return $days[(localtime (time)) [6]];
 104 } # dow
 105
 106 sub sign () {
 107   my $sigfile = "$ENV{HOME}/.signatures";
 108
 109   return unless -r $sigfile;
 110
 111   my $signature  = "-- <br>";
 112
 113   open my $sigs, '<', $sigfile
 114     or error "Unable to open signature file $sigfile - $!", 1;
 115
 116   my @sigs = <$sigs>;
 117   chomp @sigs;
 118
 119   close $sigs;
 120
 121   $signature .= '<font color="#bbbbbb">';
 122   $signature .= splice (@sigs, int (rand (@sigs)), 1);
 123   $signature .= '</font>';
 124
 125   return $signature;
 126 } # sign
 127
 128 sub tag ($$) {
 129   my ($sent, $date) = @_;
 130
 131   return ''
 132     unless $sent;
 133
 134   my $tagStr  = '<hr><p style="text-align: center;">';
 135      $tagStr .= "This message has been sent to you $sent time";
 136
 137      $tagStr .= 's'
 138        if $sent > 1;
 139
 140      $tagStr .= " before<br>";
 141      $tagStr .= "The last time this message was sent to you was $date<br>";
 142      $tagStr .= "$FindBin::Script $VERSION<br></p>";
 143
 144   return $tagStr;
 145 } # tag
 146
 147 ## Main
 148 GetOptions (
 149   usage    => sub { Usage },
 150   verbose  => sub { set_verbose },
 151   debug    => sub { set_debug },
 152   'exec!'  => \$exec,
 153   'tag!',  => \$tag,
 154   'sign!', => \$sign,
 155   'file',  => \$nagfile,
 156 ) or Usage 'Invalid parameter';
 157
 158 my $nagfilenew = "$nagfile.$$";
 159
 160 open my $nagsIn, '<', $nagfile
 161   or error "Unable to open $nagfile for read access - $!", 1;
 162
 163 open my $nagsOut, '>', $nagfilenew
 164   or error "Unable to open new nagfile $nagfilenew for write access - $!", 1;
 165
 166 while (<$nagsIn>) {
 167   if (/^#/ or /^$/) {
 168     print $nagsOut $_;
 169     next;
 170   } # if
 171
 172   chomp;
 173
 174   my ($email, $subject, $when, $msgfile, $sent, $date) = split /\|/;
 175
 176   $sent ||= 0;
 177
 178   my $dow = dow;
 179
 180   if ($when =~ /$dow/i or $when =~ /daily/i) {
 181     verbose "Nagging $email with $msgfile...";
 182
 183     my $footing = '';
 184
 185     $footing = tag $sent, $date
 186       if $tag;
 187
 188     $footing .= sign
 189       if $sign;
 190
 191     my $msg;
 192
 193     my $msgfilename = $msgfile;
 194        $msgfilename =~ s/~/$ENV{HOME}/;
 195
 196     open $msg, '<', $msgfilename
 197       or error "Unable to open message file $msgfile - $!", 1;
 198
 199     mail (
 200       to            => $email,
 201       subject       => $subject,
 202       mode          => 'html',
 203       data          => $msg,
 204       footing       => $footing,
 205       randomizeFrom => 1,
 206     );
 207
 208     close $msg
 209       or error "Unable to close message file $msg - $!", 1;
 210
 211     $sent++;
 212     $date = YMDHM;
 213     $when = "Daily"
 214       if $sent > 3;
 215
 216     print $nagsOut "$email|$subject|$when|$msgfile|$sent|$date\n";
 217   } else {
 218     print $nagsOut "$_\n";
 219   } # if
 220 } # while
 221
 222 close $nagsIn
 223   or error "Unable to close $nagfile - $!", 1;
 224
 225 close $nagsOut
 226   or error "Unable to close $nagfilenew - $!", 1;
 227
 228 rename $nagfilenew, $nagfile
 229   or error "Unable to rename $nagfilenew to $nagfile", 1;
 230
 231 =pod
 232
 233 =head1 CONFIGURATION AND ENVIRONMENT
 234
 235 DEBUG: If set then $debug is set to this level.
 236
 237 VERBOSE: If set then $verbose is set to this level.
 238
 239 TRACE: If set then $trace is set to this level.
 240
 241 =head1 DEPENDENCIES
 242
 243 =head2 Perl Modules
 244
 245 L<FindBin>
 246
 247 L<Getopt::Long|Getopt::Long>
 248
 249 =head2 ClearSCM Perl Modules
 250
 251 =begin man
 252
 253  DateUtils
 254  Display
 255  Mail
 256  Utils
 257
 258 =end man
 259
 260 =begin html
 261
 262 <blockquote>
 263 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
 264 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
 265 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
 266 <a href="http://clearscm.com/php/scm_man.php?file=lib/Utils.pm">Utils</a><br>
 267 </blockquote>
 268
 269 =end html
 270
 271 =head1 BUGS AND LIMITATIONS
 272
 273 There are no known bugs in this script
 274
 275 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 276
 277 =head1 LICENSE AND COPYRIGHT
 278
 279 Copyright (c) 2004, ClearSCM, Inc. All rights reserved.
 280
 281 =cut