maps/bin/MAPSDB.pm

   1 #!/usr/bin/perl
   2 #################################################################################
   3 #
   4 # File:         $RCSfile: MAPSDB.pm,v $
   5 # Revision:        $Revision: 1.1 $
   6 # Description:  MAPS Database routines
   7 # Author:       Andrew@DeFaria.com
   8 # Created:      Fri Nov 29 14:17:21  2002
   9 # Modified:     $Date: 2013/06/12 14:05:47 $
  10 # Language:     perl
  11 #
  12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 package MAPSDB;
  16
  17 use strict;
  18 use vars qw (@ISA @EXPORT);
  19 use DBI;
  20 use Carp;
  21
  22 use MAPSUtil;
  23
  24 @ISA = qw (Exporter);
  25
  26 # Globals
  27 my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER};
  28 my %useropts;
  29 my $DB;
  30
  31 @EXPORT = qw (
  32   AddLog
  33   CheckOnList
  34   CloseDB
  35   DBError
  36   OpenDB
  37   RecordHit
  38 );
  39
  40 # Forwards
  41 sub AddEmail;
  42 sub AddList;
  43 sub AddLog;
  44 sub AddUser;
  45 sub AddUserOption;
  46 sub CheckOnList;
  47 sub CleanEmail;
  48 sub CleanLog;
  49 sub CleanList;
  50 sub CloseDB;
  51 sub CountMsg;
  52 sub DBError;
  53 sub Decrypt;
  54 sub DeleteEmail;
  55 sub DeleteList;
  56 sub Encrypt;
  57 sub FindEmail;
  58 sub FindList;
  59 sub FindLog;
  60 sub FindUser;
  61 sub GetContext;
  62 sub GetEmail;
  63 sub GetList;
  64 sub GetLog;
  65 sub GetNextSequenceNo;
  66 sub GetUser;
  67 sub GetUserInfo;
  68 sub GetUserOptions;
  69 sub OpenDB;
  70 sub OptimizeDB;
  71 sub ResequenceList;
  72 sub ReturnEmails;
  73 sub ReturnList;
  74 sub ReturnListEntry;
  75 sub SetContext;
  76 sub Space;
  77 sub UpdateList;
  78 sub UpdateUser;
  79 sub UpdateUserOption;
  80 sub UserExists;
  81 sub count;
  82 sub countlog;
  83
  84 sub AddEmail ($$$) {
  85   my ($sender, $subject, $data) = @_;
  86
  87   # "Sanitize" some fields so that characters that are illegal to SQL are escaped
  88   $sender = 'Unknown'
  89     if (!defined $sender || $sender eq '');
  90   $sender  = $DB->quote ($sender);
  91   $subject = $DB->quote ($subject);
  92   $data    = $DB->quote ($data);
  93
  94   my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
  95   my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)";
  96
  97   $DB->do ($statement)
  98     or DBError 'AddEmail: Unable to do statement', $statement;
  99
 100   return;
 101 } # AddEmail
 102
 103 sub AddList ($$$;$$$) {
 104   my ($listtype, $pattern, $sequence, $comment, $hitcount, $last_hit) = @_;
 105
 106   $hitcount ||= 0;
 107
 108   my ($user, $domain)  = split /\@/, $pattern;
 109
 110   if (!$domain || $domain eq '') {
 111     $domain  = 'NULL';
 112     $pattern = $DB->quote ($user);
 113   } else {
 114     $domain  = "'$domain'";
 115     if ($user eq '') {
 116       $pattern = 'NULL';
 117     } else {
 118       $pattern = $DB->quote ($user);
 119     } # if
 120   } # if
 121
 122   if (!$comment || $comment eq '') {
 123     $comment = 'NULL';
 124   } else {
 125     $comment = $DB->quote ($comment);
 126   } # if
 127
 128   # Get next sequence #
 129   if ($sequence == 0) {
 130     $sequence = GetNextSequenceNo $userid, $listtype;
 131   } # if
 132
 133   $last_hit //= UnixDatetime2SQLDatetime (scalar (localtime));
 134
 135   my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hitcount, \"$last_hit\")";
 136
 137   $DB->do ($statement)
 138     or DBError 'AddList: Unable to do statement', $statement;
 139
 140   return;
 141 } # AddList
 142
 143 sub AddLog ($$$) {
 144   my ($type, $sender, $msg) = @_;
 145
 146   my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
 147   my $statement;
 148
 149   # Use quote to protect ourselves
 150   $msg = $DB->quote ($msg);
 151
 152   if ($sender eq '') {
 153     $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)";
 154   } else {
 155     $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)";
 156   } # if
 157
 158   $DB->do ($statement)
 159     or DBError 'AddLog: Unable to do statement', $statement;
 160
 161   return;
 162 } # AddLog
 163
 164 sub AddUser ($$$$) {
 165   my ($userid, $realname, $email, $password) = @_;
 166
 167   $password = Encrypt $password, $userid;
 168
 169   if (UserExists $userid) {
 170     return 1;
 171   } else {
 172     my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')";
 173
 174     $DB->do ($statement)
 175       or DBError 'AddUser: Unable to do statement', $statement;
 176   } # if
 177
 178   return 0;
 179 } # AddUser
 180
 181 sub AddUserOption ($$$) {
 182   my ($userid, $name, $value) = @_;
 183
 184   if (!UserExists $userid) {
 185     return 1;
 186   } # if
 187
 188   my $statement = "insert into useropts values ('$userid', '$name', '$value')";
 189
 190   $DB->do ($statement)
 191     or DBError 'AddUserOption: Unable to do statement', $statement;
 192
 193   return 0;
 194 } # AddUserOption
 195
 196 sub RecordHit ($$$) {
 197   my ($listtype, $sequence, $hit_count) = @_;
 198
 199   my $current_date = UnixDatetime2SQLDatetime (scalar (localtime));
 200
 201   my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
 202
 203   $DB->do ($statement)
 204     or DBError 'AddList: Unable to do statement', $statement;
 205
 206   return;
 207 } # RecordHit
 208
 209 sub CheckOnList ($$) {
 210   # CheckOnList will check to see if the $sender is on the $listfile.
 211   # Return 1 if found 0 if not.
 212   my ($listtype, $sender) = @_;
 213
 214   my $status   = 0;
 215   my $rule;
 216
 217   my $statement = "select pattern, domain, comment, sequence, hit_count from list where userid = '$userid' and type = '$listtype'";
 218
 219   my $sth = $DB->prepare ($statement)
 220     or DBError 'CheckOnList: Unable to prepare statement', $statement;
 221
 222   $sth->execute
 223     or DBError 'CheckOnList: Unable to execute statement', $statement;
 224
 225   while (my @row = $sth->fetchrow_array) {
 226     last if !@row;
 227
 228     my $hit_count = pop (@row);
 229     my $sequence  = pop (@row);
 230     my $comment   = pop (@row);
 231     my $domain    = pop (@row);
 232     my $pattern   = pop (@row);
 233     my $email_on_file;
 234
 235     unless ($domain) {
 236       $email_on_file = $pattern;
 237     } else {
 238       unless ($pattern) {
 239         $email_on_file = '@' . $domain;
 240       } else {
 241         $email_on_file = $pattern . '@' . $domain;
 242       } # if
 243     } # unless
 244
 245     # Escape some special characters
 246     $email_on_file =~ s/\@/\\@/;
 247     $email_on_file =~ s/^\*/.\*/;
 248
 249     # We want to terminate the search string with a "$" iff there's an
 250     # "@" in there. This is because some "email_on_file" may have no
 251     # domain (e.g. "mailer-daemon" with no domain). In that case we
 252     # don't want to terminate the search string with a "$" rather we
 253     # wish to terminate it with an "@". But in the case of say
 254     # "@ti.com" if we don't terminate the search string with "$" then
 255     # "@ti.com" would also match "@tixcom.com"!
 256     my $search_for = $email_on_file =~ /\@/
 257                    ? "$email_on_file\$"
 258                    : !defined $domain
 259                    ? "$email_on_file\@"
 260                    : $email_on_file;
 261
 262     if ($sender =~ /$search_for/i) {
 263       $rule   = "Matching rule: ($listtype:$sequence) \"$email_on_file\"";
 264       $rule  .= " - $comment" if $comment and $comment ne '';
 265       $status = 1;
 266
 267       RecordHit $listtype, $sequence, ++$hit_count;
 268
 269       last;
 270     } # if
 271   } # while
 272
 273   $sth->finish;
 274
 275   return ($status, $rule);
 276 } # CheckOnList
 277
 278 sub CleanEmail ($) {
 279   my ($timestamp) = @_;
 280
 281   # First see if anything needs to be deleted
 282   my $count = 0;
 283
 284   my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'";
 285
 286   # Prepare statement
 287   my $sth = $DB->prepare ($statement)
 288     or DBError 'CleanEmail: Unable to prepare statement', $statement;
 289
 290   # Execute statement
 291   $sth->execute
 292     or DBError 'CleanEmail: Unable to execute statement', $statement;
 293
 294   # Get return value, which should be how many entries were deleted
 295   my @row = $sth->fetchrow_array;
 296
 297   # Done with $sth
 298   $sth->finish;
 299
 300   # Retrieve returned value
 301   unless ($row[0]) {
 302     $count = 0
 303   } else {
 304     $count = $row[0];
 305   } # unless
 306
 307   # Just return if there's nothing to delete
 308   return $count if ($count == 0);
 309
 310   # Delete emails for userid whose older than $timestamp
 311   $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
 312
 313   # Prepare statement
 314   $sth = $DB->prepare ($statement)
 315     or DBError 'CleanEmail: Unable to prepare statement', $statement;
 316
 317   # Execute statement
 318   $sth->execute
 319     or DBError 'CleanEmail: Unable to execute statement', $statement;
 320
 321   return $count;
 322 } # CleanEmail
 323
 324 sub CleanLog  ($) {
 325   my ($timestamp) = @_;
 326
 327   # First see if anything needs to be deleted
 328   my $count = 0;
 329
 330   my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'";
 331
 332   # Prepare statement
 333   my $sth = $DB->prepare ($statement)
 334     or DBError $DB, 'CleanLog: Unable to prepare statement', $statement;
 335
 336   # Execute statement
 337   $sth->execute
 338     or DBError 'CleanLog: Unable to execute statement', $statement;
 339
 340   # Get return value, which should be how many entries were deleted
 341   my @row = $sth->fetchrow_array;
 342
 343   # Done with $sth
 344   $sth->finish;
 345
 346   # Retrieve returned value
 347   unless ($row[0]) {
 348     $count = 0
 349   } else {
 350     $count = $row[0];
 351   } # unless
 352
 353   # Just return if there's nothing to delete
 354   return $count if ($count == 0);
 355
 356   # Delete log entries for userid whose older than $timestamp
 357   $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
 358
 359   # Prepare statement
 360   $sth = $DB->prepare ($statement)
 361     or DBError 'CleanLog: Unable to prepare statement', $statement;
 362
 363   # Execute statement
 364   $sth->execute
 365     or DBError 'CleanLog: Unable to execute statement', $statement;
 366
 367   return $count;
 368 } # CleanLog
 369
 370 sub CleanList ($;$) {
 371   my ($timestamp, $listtype) = @_;
 372
 373   $listtype = 'null' if !$listtype;
 374
 375   # First see if anything needs to be deleted
 376   my $count = 0;
 377
 378   my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
 379
 380   # Prepare statement
 381   my $sth = $DB->prepare ($statement)
 382     or DBError $DB, 'CleanList: Unable to prepare statement', $statement;
 383
 384   # Execute statement
 385   $sth->execute
 386     or DBError 'CleanList: Unable to execute statement', $statement;
 387
 388   # Get return value, which should be how many entries were deleted
 389   my @row = $sth->fetchrow_array;
 390
 391   # Done with $sth
 392   $sth->finish;
 393
 394   # Retrieve returned value
 395   $count = $row[0] ? $row[0] : 0;
 396
 397   # Just return if there's nothing to delete
 398   return $count if ($count == 0);
 399
 400   # Get data for these entries
 401   $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
 402
 403   # Prepare statement
 404   $sth = $DB->prepare ($statement)
 405     or DBError 'CleanList: Unable to prepare statement', $statement;
 406
 407   # Execute statement
 408   $sth->execute
 409     or DBError 'CleanList: Unable to execute statement', $statement;
 410
 411   $count = 0;
 412
 413   while (my @row = $sth->fetchrow_array) {
 414     last if !@row;
 415
 416     my $hit_count = pop (@row);
 417     my $sequence  = pop (@row);
 418     my $listtype  = pop (@row);
 419
 420     if ($hit_count == 0) {
 421       $count++;
 422
 423       $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence";
 424       $DB->do ($statement)
 425         or DBError 'CleanList: Unable to execute statement', $statement;
 426     } else {
 427       # Age entry: Sometimes entries are initially very popular and
 428       # the $hit_count gets very high quickly. Then the domain is
 429       # abandoned and no activity happens. One case recently observed
 430       # was for phentermine.com. The $hit_count initially soared to
 431       # 1920 within a few weeks. Then it all stopped as of
 432       # 07/13/2007. Obvisously this domain was shutdown. With the
 433       # previous aging algorithm of simply subtracting 1 this
 434       # phentermine.com entry would hang around for over 5 years!
 435       #
 436       # So the tack here is to age the entry by dividing it's
 437       # $hit_count in half. Sucessive halfing then will quickly age
 438       # the entry down to size. However we don't want to age small
 439       # $hit_count's too quickly, therefore once their numbers drop to
 440       # < 30 we revert to the old method of subtracting 1.
 441       if ($hit_count < 30) {
 442         $hit_count--;
 443       } else {
 444         $hit_count = $hit_count / 2;
 445       } # if
 446
 447       $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;";
 448       $DB->do ($statement)
 449         or DBError 'CleanList: Unable to execute statement', $statement;
 450     } # if
 451   } # while
 452
 453   ResequenceList $userid, $listtype if $count > 0;
 454
 455   return $count;
 456 } # CleanList
 457
 458 sub CloseDB () {
 459   $DB->disconnect;
 460
 461   return;
 462 } # CloseDB
 463
 464 sub CountMsg ($) {
 465   my ($sender) = @_;
 466
 467   return count ('email', "userid = '$userid' and sender like '%$sender%'");
 468 } # CountMsg
 469
 470 sub DBError ($$) {
 471   my ($msg, $statement) = @_;
 472
 473   print 'MAPSDB::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n";
 474
 475   if ($statement) {
 476     print "SQL Statement: $statement\n";
 477   } # if
 478
 479   exit $DB->err;
 480 } # DBError
 481
 482 sub Decrypt ($$) {
 483   my ($password, $userid) = @_;
 484
 485   my $statement = "select decode('$password','$userid')";
 486
 487   my $sth = $DB->prepare ($statement)
 488     or DBError 'Decrypt: Unable to prepare statement', $statement;
 489
 490   $sth->execute
 491     or DBError 'Decrypt: Unable to execute statement', $statement;
 492
 493   # Get return value, which should be the encoded password
 494   my @row = $sth->fetchrow_array;
 495
 496   # Done with $sth
 497   $sth->finish;
 498
 499   return $row[0]
 500 } # Decrypt
 501
 502 sub DeleteEmail ($) {
 503   my $sender = shift;
 504
 505   my ($username, $domain) = split /@/, $sender;
 506   my $condition;
 507
 508   if ($username eq '') {
 509     $condition = "userid = '$userid' and sender like '%\@$domain'";
 510   } else {
 511     $condition = "userid = '$userid' and sender = '$sender'";
 512   } # if
 513
 514   # First see if anything needs to be deleted
 515   my $count = count ('email', $condition);
 516
 517   # Just return if there's nothing to delete
 518   return $count if ($count == 0);
 519
 520   my $statement = 'delete from email where ' . $condition;
 521
 522   $DB->do ($statement)
 523     or DBError 'DeleteEmail: Unable to execute statement', $statement;
 524
 525   return $count;
 526 } # DeleteEmail
 527
 528 sub DeleteList ($$) {
 529   my ($type, $sequence) = @_;
 530
 531   # First see if anything needs to be deleted
 532   my $count = count ('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
 533
 534   # Just return if there's nothing to delete
 535   return $count if ($count == 0);
 536
 537   my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
 538
 539   $DB->do ($statement)
 540     or DBError 'DeleteList: Unable to execute statement', $statement;
 541
 542   return $count;
 543 } # DeleteList
 544
 545 sub DeleteLog ($) {
 546   my ($sender) = @_;
 547
 548   my ($username, $domain) = split /@/, $sender;
 549   my $condition;
 550
 551   if ($username eq '') {
 552     $condition = "userid = '$userid' and sender like '%\@$domain'";
 553   } else {
 554     $condition = "userid = '$userid' and sender = '$sender'";
 555   } # if
 556
 557   # First see if anything needs to be deleted
 558   my $count = count ('log', $condition);
 559
 560   # Just return if there's nothing to delete
 561   return $count if ($count == 0);
 562
 563   my $statement = 'delete from log where ' . $condition;
 564
 565   $DB->do ($statement)
 566     or DBError 'DeleteLog: Unable to execute statement', $statement;
 567
 568   return $count;
 569 } # DeleteLog
 570
 571 sub Encrypt ($$) {
 572   my ($password, $userid) = @_;
 573
 574   my $statement = "select encode('$password','$userid')";
 575
 576   my $sth = $DB->prepare ($statement)
 577     or DBError 'Encrypt: Unable to prepare statement', $statement;
 578
 579   $sth->execute
 580     or DBError 'Encrypt: Unable to execute statement', $statement;
 581
 582   # Get return value, which should be the encoded password
 583   my @row = $sth->fetchrow_array;
 584
 585   # Done with $sth
 586   $sth->finish;
 587
 588   return $row[0]
 589 } # Encrypt
 590
 591 sub FindEmail (;$) {
 592   my ($sender) = @_;
 593
 594   my $statement;
 595
 596   if (!defined $sender || $sender eq '') {
 597     $statement = "select * from email where userid = '$userid'";
 598   } else {
 599     $statement = "select * from email where userid = '$userid' and sender = '$sender'";
 600   } # if
 601
 602   my $sth = $DB->prepare ($statement)
 603     or DBError 'FindEmail: Unable to prepare statement', $statement;
 604
 605   $sth->execute
 606     or DBError 'FindEmail: Unable to execute statement', $statement;
 607
 608   return $sth;
 609 } # FindEmail
 610
 611 sub FindList ($;$) {
 612   my ($type, $sender) = @_;
 613
 614   my $statement;
 615
 616   unless ($sender) {
 617     $statement = "select * from list where userid = '$userid' and type = '$type'";
 618   } else {
 619     my ($pattern, $domain) = split /\@/, $sender;
 620     $statement = "select * from list where userid = '$userid' and type = '$type' " .
 621                  "and pattern = '$pattern' and domain = '$domain'";
 622   } # unless
 623
 624   # Prepare statement
 625   my $sth = $DB->prepare ($statement)
 626     or DBError 'FindList: Unable to prepare statement', $statement;
 627
 628   # Execute statement
 629   $sth->execute
 630     or DBError 'FindList: Unable to execute statement', $statement;
 631
 632   # Get return value, which should be how many entries were deleted
 633   return $sth;
 634 } # FindList
 635
 636 sub FindLog ($$) {
 637   my ($start_at, $end_at) = @_;
 638
 639   my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
 640
 641   # Prepare statement
 642   my $sth = $DB->prepare ($statement)
 643     or DBError 'FindLog: Unable to prepare statement', $statement;
 644
 645   # Execute statement
 646   $sth->execute
 647     or DBError 'FindLog: Unable to execute statement', $statement;
 648
 649   # Get return value, which should be how many entries were deleted
 650   return $sth;
 651 } # FindLog
 652
 653 sub FindUser (;$) {
 654   my ($userid) = @_;
 655
 656   my $statement;
 657
 658   if (!defined $userid || $userid eq '') {
 659     $statement = 'select * from user';
 660   } else {
 661     $statement = "select * from user where userid = '$userid'";
 662   } # if
 663
 664   my $sth = $DB->prepare ($statement)
 665     or DBError 'FindUser: Unable to prepare statement', $statement;
 666
 667   $sth->execute
 668     or DBError 'FindUser: Unable to execute statement', $statement;
 669
 670   return $sth;
 671 } # FindUser
 672
 673 sub GetContext () {
 674   return $userid;
 675 } # GetContext
 676
 677 sub GetEmail ($) {
 678   my ($sth) = @_;
 679
 680   my @email;
 681
 682   if (@email = $sth->fetchrow_array) {
 683     my $message   = pop @email;
 684     my $timestamp = pop @email;
 685     my $subject   = pop @email;
 686     my $sender    = pop @email;
 687     my $userid    = pop @email;
 688     return $userid, $sender, $subject, $timestamp, $message;
 689   } else {
 690     return;
 691   } # if
 692 } # GetEmail
 693
 694 sub GetList ($) {
 695   my ($sth) = @_;
 696
 697   my @list;
 698
 699   if (@list = $sth->fetchrow_array) {
 700     my $last_hit  = pop @list;
 701     my $hit_count = pop @list;
 702     my $sequence  = pop @list;
 703     my $comment   = pop @list;
 704     my $domain    = pop @list;
 705     my $pattern   = pop @list;
 706     my $type      = pop @list;
 707     my $userid    = pop @list;
 708     return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
 709   } else {
 710     return;
 711   } # if
 712 } # GetList
 713
 714 sub GetLog ($) {
 715   my ($sth) = @_;
 716
 717   my @log;
 718
 719   if (@log = $sth->fetchrow_array) {
 720     my $message   = pop @log;
 721     my $type      = pop @log;
 722     my $sender    = pop @log;
 723     my $timestamp = pop @log;
 724     my $userid    = pop @log;
 725     return $userid, $timestamp, $sender, $type, $message;
 726   } else {
 727     return;
 728   } # if
 729 } # GetLog
 730
 731 sub GetNextSequenceNo ($$) {
 732   my ($userid, $listtype) = @_;
 733
 734   my $count = count ('list', "userid = '$userid' and type = '$listtype'");
 735
 736   return $count + 1;
 737 } # GetNextSequenceNo
 738
 739 sub GetUser ($) {
 740   my ($sth) = @_;
 741
 742   my @user;
 743
 744   if (@user = $sth->fetchrow_array) {
 745     my $password = pop @user;
 746     my $email    = pop @user;
 747     my $name     = pop @user;
 748     my $userid   = pop @user;
 749     return ($userid, $name, $email, $password);
 750   } else {
 751     return;
 752   } # if
 753 } # GetUser
 754
 755 sub GetUserInfo ($) {
 756   my ($userid) = @_;
 757
 758   my $statement = "select name, email from user where userid='$userid'";
 759
 760   my $sth = $DB->prepare ($statement)
 761     or DBError 'GetUserInfo: Unable to prepare statement', $statement;
 762
 763   $sth->execute
 764     or DBError 'GetUserInfo: Unable to execute statement', $statement;
 765
 766   my @userinfo   = $sth->fetchrow_array;
 767   my $user_email = lc (pop @userinfo);
 768   my $username   = lc (pop @userinfo);
 769
 770   $sth->finish;
 771
 772   return ($username, $user_email);
 773 } # GetUserInfo
 774
 775 sub GetUserOptions ($) {
 776   my ($userid) = @_;
 777
 778   my $statement = "select * from useropts where userid = '$userid'";
 779
 780   my $sth = $DB->prepare ($statement)
 781     or DBError 'GetUserOptions: Unable to prepare statement', $statement;
 782
 783   $sth->execute
 784     or DBError 'GetUserOptions: Unable to execute statement', $statement;
 785
 786   my @useropts;
 787
 788   # Empty hash
 789   %useropts = ();
 790
 791   while (@useropts = $sth->fetchrow_array) {
 792     my $value = pop @useropts;
 793     my $name  = pop @useropts;
 794     pop @useropts;
 795     $useropts{$name} = $value;
 796   } # while
 797
 798   $sth->finish;
 799
 800   return %useropts;
 801 } # GetUserOptions
 802
 803 sub GetRows ($) {
 804   my ($statement) = @_;
 805
 806   my $sth = $DB->prepare ($statement)
 807     or DBError 'Unable to prepare statement' , $statement;
 808
 809   $sth->execute
 810     or DBError 'Unable to execute statement' , $statement;
 811
 812   my @array;
 813
 814   while (my @row = $sth->fetchrow_array) {
 815     foreach (@row) {
 816       push @array, $_;
 817     } # foreach
 818   } # while
 819
 820   return @array;
 821 } # GetRows
 822
 823 sub OpenDB ($$) {
 824   my ($username, $password) = @_;
 825
 826   my $dbname   = 'MAPS';
 827   my $dbdriver = 'mysql';
 828   my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
 829
 830   if (!$DB || $DB eq '') {
 831     #$dbserver='localhost';
 832     $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
 833       or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
 834   } # if
 835
 836   return $DB;
 837 } # OpenDB
 838
 839 sub OptimizeDB () {
 840   my $statement = 'lock tables email read, list read, log read, user read, useropts read';
 841   my $sth = $DB->prepare ($statement)
 842       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 843
 844   $sth->execute
 845     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 846
 847   $statement = 'check table email, list, log, user, useropts';
 848   $sth = $DB->prepare ($statement)
 849       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 850
 851   $sth->execute
 852     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 853
 854   $statement = 'unlock tables';
 855   $sth = $DB->prepare ($statement)
 856       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 857
 858   $sth->execute
 859     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 860
 861   $statement = 'optimize table email, list, log, user, useropts';
 862   $sth = $DB->prepare ($statement)
 863       or DBError 'OptimizeDB: Unable to prepare statement', $statement;
 864
 865   $sth->execute
 866     or DBError 'OptimizeDB: Unable to execute statement', $statement;
 867
 868   return;
 869 } # OptimizeDB
 870
 871 sub ResequenceList ($$) {
 872   my ($userid, $type) = @_;
 873
 874   if ($type ne 'white' && $type ne 'black' && $type ne 'null') {
 875     return 1;
 876   } # if
 877
 878   if (!UserExists $userid) {
 879     return 2;
 880   } # if
 881
 882   my $statement = "select sequence from list where userid = '$userid' ".
 883                   " and type = '$type' order by sequence";
 884
 885   my $sth = $DB->prepare ($statement)
 886       or DBError 'ResequenceList: Unable to prepare statement', $statement;
 887
 888   $sth->execute
 889     or DBError 'ResequenceList: Unable to execute statement', $statement;
 890
 891   my $sequence = 1;
 892
 893   while (my @row = $sth->fetchrow_array) {
 894     last if !@row;
 895     my $old_sequence = pop (@row);
 896
 897     if ($old_sequence != $sequence) {
 898       my $update_statement = "update list set sequence = $sequence " .
 899                              "where userid = '$userid' and " .
 900                              "type = '$type' and sequence = $old_sequence";
 901       $DB->do ($update_statement)
 902         or DBError 'ResequenceList: Unable to do statement', $statement;
 903     } # if
 904
 905     $sequence++;
 906   } # while
 907
 908   return 0;
 909 } # ResequenceList
 910
 911 # This subroutine returns an array of senders in reverse chronological
 912 # order based on time timestamp from the log table of when we returned
 913 # their message. The complication here is that a single sender may
 914 # send multiple times in a single day. So if spammer@foo.com sends
 915 # spam @ 1 second after midnight and then again at 2 Pm there will be
 916 # at least two records in the log table saying that we returned his
 917 # email. Getting records sorted by timestamp desc will have
 918 # spammer@foo.com listed twice. But we want him listed only once, as
 919 # the first entry in the returned array. Plus we may be called
 920 # repeatedly with different $start_at's. Therefore we need to process
 921 # the whole list of returns for today, eliminate duplicate entries for
 922 # a single sender then slice the resulting array.
 923 sub ReturnSenders ($$$;$$) {
 924   my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
 925
 926   $start_at ||= 0;
 927
 928   my $dateCond = '';
 929
 930   if ($date) {
 931     my $sod = $date . ' 00:00:00';
 932     my $eod = $date . ' 23:59:59';
 933
 934     $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
 935   } # if
 936
 937   my $statement = <<"END";
 938 select
 939   sender,
 940   timestamp
 941 from
 942   log
 943 where
 944   userid = '$userid' and
 945   type   = '$type'
 946   $dateCond
 947 order by
 948   timestamp desc
 949 END
 950
 951   my $sth = $DB->prepare ($statement)
 952     or DBError 'ReturnSenders: Unable to prepare statement', $statement;
 953
 954   $sth->execute
 955     or DBError 'ReturnSenders: Unable to execute statement', $statement;
 956
 957   # Watch the distinction between senders (plural) and sender (singular)
 958   my (%senders, %sendersByTimestamp);
 959
 960   # Run through the results and add to %senders by sender key. This
 961   # results in a hash that has the sender in it and the first
 962   # timestamp value. Since we already sorted timestamp desc by the
 963   # above select statement, and we've narrowed it down to only log
 964   # message that occurred for the given $date, we will have a hash
 965   # containing 1 sender and the latest timestamp for the day.
 966   while (my $senderRef = $sth->fetchrow_hashref) {
 967     my %sender = %{$senderRef};
 968
 969     $senders{$sender{sender}} = $sender{timestamp}
 970       unless $senders{$sender{sender}};
 971   } # while
 972
 973   $sth->finish;
 974
 975   # Make a hash whose keys are the timestamp (so we can later sort on
 976   # them).
 977   while (my ($key, $value) = each %senders) {
 978     $sendersByTimestamp{$value} = $key;
 979   } # while
 980
 981   my @senders;
 982
 983   # Sort by timestamp desc and push on to the @senders array
 984   push @senders, $sendersByTimestamp{$_}
 985     foreach (sort { $b cmp $a } keys %sendersByTimestamp);
 986
 987   # Finally slice for the given range
 988   my $end_at = $start_at + $nbr_emails - 1;
 989
 990   $end_at = (@senders - 1)
 991     if $end_at > @senders;
 992
 993   return (@senders) [$start_at .. $end_at];
 994 } # ReturnSenders
 995
 996 sub ReturnMessages ($$) {
 997   my ($userid, $sender) = @_;
 998
 999   my $statement = <<"END";
1000 select
1001   subject,
1002   timestamp
1003 from
1004   email
1005 where
1006   userid = '$userid' and
1007   sender = '$sender'
1008 group by
1009   timestamp desc
1010 END
1011
1012   my $sth = $DB->prepare ($statement)
1013     or DBError 'ReturnMessages: Unable to prepare statement', $statement;
1014
1015   $sth->execute
1016     or DBError 'ReturnMessages: Unable to execute statement', $statement;
1017
1018   my @messages;
1019
1020   while (my @row = $sth->fetchrow_array) {
1021     my $date    = pop @row;
1022     my $subject = pop @row;
1023
1024     push @messages, [$subject, $date];
1025   } # while
1026
1027   $sth->finish;
1028
1029   return @messages;
1030 } # ReturnMessages
1031
1032 sub ReturnEmails ($$$;$$) {
1033   my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1034
1035   $start_at ||= 0;
1036
1037   my $statement;
1038
1039   if ($date) {
1040     my $sod = $date . ' 00:00:00';
1041     my $eod = $date . ' 23:59:59';
1042
1043     if ($type eq 'returned') {
1044       $statement = <<"END";
1045 select
1046   log.sender
1047 from
1048   log,
1049   email
1050 where
1051   log.sender    = email.sender and
1052   log.userid    = '$userid'    and
1053   log.timestamp > '$sod'       and
1054   log.timestamp < '$eod'       and
1055   log.type      = '$type'
1056 group by
1057   log.sender
1058 limit
1059   $start_at, $nbr_emails
1060 END
1061     } else {
1062       $statement = <<"END";
1063 select
1064   sender
1065 from
1066   log
1067 where
1068   userid    = '$userid'    and
1069   timestamp > '$sod'       and
1070   timestamp < '$eod'       and
1071   type      = '$type'
1072 group by
1073   sender
1074 limit
1075   $start_at, $nbr_emails
1076 END
1077     } # if
1078   } else {
1079     if ($type eq 'returned') {
1080       $statement = <<"END";
1081 select
1082   log.sender
1083 from
1084   log,
1085   email
1086 where
1087   log.sender   = email.sender and
1088   log.userid   = '$userid'    and
1089   log.type     = '$type'
1090 group by
1091   log.sender
1092 order by
1093   log.timestamp desc
1094 limit
1095   $start_at, $nbr_emails
1096 END
1097     } else {
1098       $statement = <<"END";
1099 select
1100   sender
1101 from
1102   log
1103 where
1104   userid   = '$userid'    and
1105   type     = '$type'
1106 group by
1107   sender
1108 order by
1109   timestamp desc
1110 limit
1111   $start_at, $nbr_emails
1112 END
1113     } # if
1114   } # if
1115
1116   my $sth = $DB->prepare ($statement)
1117     or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1118
1119   $sth->execute
1120     or DBError 'ReturnEmails: Unable to execute statement', $statement;
1121
1122   my @emails;
1123
1124   while (my $sender = $sth->fetchrow_array) {
1125     my $earliestDate;
1126
1127     # Get emails for this sender. Format an array of subjects and timestamps.
1128     my @messages;
1129
1130     $statement = "select timestamp, subject from email where userid = '$userid' " .
1131                  "and sender = '$sender'";
1132
1133     my $sth2 = $DB->prepare ($statement)
1134       or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1135
1136     $sth2->execute
1137       or DBError 'ReturnEmails: Unable to execute statement', $statement;
1138
1139     while (my @row = $sth2->fetchrow_array) {
1140       my $subject = pop @row;
1141       my $date    = pop @row;
1142
1143       if ($earliestDate) {
1144         my $earliestDateShort = substr $earliestDate, 0, 10;
1145         my $dateShort         = substr $date,         0, 10;
1146
1147         if ($earliestDateShort eq $dateShort and
1148             $earliestDate > $date) {
1149           $earliestDate = $date
1150             if $earliestDateShort eq $dateShort;
1151         } # if
1152       } else {
1153         $earliestDate = $date;
1154       } # if
1155
1156       push @messages, [$subject, $date];
1157     } # while
1158
1159     # Done with sth2
1160     $sth2->finish;
1161
1162     $earliestDate ||= '';
1163
1164     unless ($type eq 'returned') {
1165       push @emails, [$earliestDate, [$sender, @messages]];
1166     } else {
1167       push @emails, [$earliestDate, [$sender, @messages]]
1168         if @messages > 0;
1169     } # unless
1170   } # while
1171
1172   # Done with $sth
1173   $sth->finish;
1174
1175   return @emails;
1176 } # ReturnEmails
1177
1178 sub ReturnList ($$$) {
1179   my ($type, $start_at, $lines) = @_;
1180
1181   $lines ||= 10;
1182
1183   my $statement;
1184
1185   if ($start_at) {
1186     $statement = "select * from list where userid = '$userid' " .
1187                  "and type = '$type' order by sequence "        .
1188                  "limit $start_at, $lines";
1189   } else {
1190     $statement = "select * from list where userid = '$userid' "        .
1191                  "and type = '$type' order by sequence";
1192   } # if
1193
1194   my $sth = $DB->prepare ($statement)
1195     or DBError 'ReturnList: Unable to prepare statement', $statement;
1196
1197   $sth->execute
1198     or DBError 'ReturnList: Unable to execute statement', $statement;
1199
1200   my @list;
1201   my $i = 0;
1202
1203   while (my @row = $sth->fetchrow_array) {
1204     last if $i++ > $lines;
1205
1206     my %list;
1207
1208     $list {last_hit}  = pop @row;
1209     $list {hit_count} = pop @row;
1210     $list {sequence}  = pop @row;
1211     $list {comment}   = pop @row;
1212     $list {domain}    = pop @row;
1213     $list {pattern}   = pop @row;
1214     $list {type}      = pop @row;
1215     $list {userid}    = pop @row;
1216     push @list, \%list;
1217   } # for
1218
1219   return @list;
1220 } # ReturnList
1221
1222 sub ReturnListEntry ($$) {
1223   my ($type, $sequence) = @_;
1224
1225   my $statement = "select * from list where userid = '$userid' "        .
1226                  "and type = '$type' and sequence = '$sequence'";
1227
1228   my $sth = $DB->prepare ($statement)
1229     or DBError 'ReturnListEntry: Unable to prepare statement', $statement;
1230
1231   $sth->execute
1232     or DBError 'ReturnListEntry: Unable to execute statement', $statement;
1233
1234   my %list;
1235   my @row = $sth->fetchrow_array;
1236
1237   $list {sequence} = pop @row;
1238   $list {comment}  = pop @row;
1239   $list {domain}   = pop @row;
1240   $list {pattern}  = pop @row;
1241   $list {type}     = pop @row;
1242   $list {userid}   = pop @row;
1243
1244   return %list;
1245 } # ReturnListEntry
1246
1247 sub UpdateList ($$$$$$$) {
1248   my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1249
1250   if (!$pattern || $pattern eq '') {
1251     $pattern = 'NULL';
1252   } else {
1253     $pattern = "'" . quotemeta ($pattern) . "'";
1254   } # if
1255
1256   if (!$domain || $domain eq '') {
1257     $domain = 'NULL';
1258   } else {
1259     $domain = "'" . quotemeta ($domain) . "'";
1260   } # if
1261
1262   if (!$comment || $comment eq '') {
1263     $comment = 'NULL';
1264   } else {
1265     $comment = "'" . quotemeta ($comment) . "'";
1266   } # if
1267
1268   if (!$hit_count || $hit_count eq '') {
1269     $hit_count = 0;
1270   #} else {
1271   # TODO: Check if numeric
1272   } # fi
1273
1274   my $statement =
1275     'update list set ' .
1276     "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
1277     "where userid = '$userid' and type = '$type' and sequence = $sequence";
1278
1279   $DB->do ($statement)
1280     or DBError 'UpdateList: Unable to do statement', $statement;
1281
1282   return 0;
1283 } # UpdateList
1284
1285 sub SearchEmails ($$) {
1286   my ($userid, $searchfield) = @_;
1287
1288   my @emails;
1289
1290   my $statement =
1291     "select sender, subject, timestamp from email where userid = '$userid' and (
1292      sender like '%$searchfield%' or subject like '%$searchfield%')
1293      order by timestamp desc";
1294
1295   my $sth = $DB->prepare ($statement)
1296     or DBError 'SearchEmails: Unable to prepare statement', $statement;
1297
1298   $sth->execute
1299     or DBError 'SearchEmails: Unable to execute statement', $statement;
1300
1301   while (my @row = $sth->fetchrow_array) {
1302     my $date    = pop @row;
1303     my $subject = pop @row;
1304     my $sender  = pop @row;
1305
1306     push @emails, [$sender, $subject, $date];
1307   } # while
1308
1309   $sth->finish;
1310
1311   return @emails;
1312 } # SearchEmails
1313
1314 sub SetContext ($) {
1315   my ($to_user) = @_;
1316
1317   my $old_user = $userid;
1318
1319   if (UserExists $to_user) {
1320     $userid = $to_user;
1321     GetUserOptions $userid;
1322     return GetUserInfo $userid;
1323   } else {
1324     return 0;
1325   } # if
1326 } # SetContext
1327
1328 sub Space ($) {
1329   my ($userid) = @_;
1330
1331   my $total_space        = 0;
1332   my %msg_space;
1333
1334   my $statement = "select * from email where userid = '$userid'";
1335   my $sth = $DB->prepare ($statement)
1336     or DBError 'Unable to prepare statement', $statement;
1337
1338   $sth->execute
1339     or DBError 'Unable to execute statement', $statement;
1340
1341   while (my @row = $sth->fetchrow_array) {
1342     last if !@row;
1343     my $data      = pop @row;
1344     my $timestamp = pop @row;
1345     my $subject   = pop @row;
1346     my $sender    = pop @row;
1347     my $user      = pop @row;
1348
1349     my $msg_space =
1350       length ($userid)    +
1351       length ($sender)    +
1352       length ($subject)   +
1353       length ($timestamp) +
1354       length ($data);
1355
1356     $total_space        += $msg_space;
1357     $msg_space{$sender} += $msg_space;
1358   } # while
1359
1360   $sth->finish;
1361
1362   return wantarray ? %msg_space : $total_space;
1363 } # Space
1364
1365 sub UpdateUser ($$$$) {
1366   my ($userid, $fullname, $email, $password) = @_;
1367
1368   if (!UserExists $userid) {
1369     return 1;
1370   } # if
1371
1372   my $statement;
1373
1374   if (!defined $password || $password eq '') {
1375     $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1376   } else {
1377     $password = Encrypt $password, $userid;
1378     $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1379   } # if
1380
1381   $DB->do ($statement)
1382     or DBError 'UpdateUser: Unable to do statement', $statement;
1383
1384   return 0;
1385 } # UpdateUser
1386
1387 sub UpdateUserOption ($$$) {
1388   my ($userid, $name, $value) = @_;
1389
1390   if (!UserExists $userid) {
1391     return 1;
1392   } # if
1393
1394   my $statement = "update useropts set value='$value' where userid='$userid' and name='$name'";
1395
1396   $DB->do ($statement)
1397     or DBError 'UpdateUserOption: Unable to do statement', $statement;
1398
1399   return 0;
1400 } # UpdateUserOptions
1401
1402 sub UserExists ($) {
1403   my ($userid) = @_;
1404
1405   return 0
1406     unless $userid;
1407
1408   my $statement = "select userid, password from user where userid = '$userid'";
1409
1410   my $sth = $DB->prepare ($statement)
1411       or DBError 'UserExists: Unable to prepare statement', $statement;
1412
1413   $sth->execute
1414     or DBError 'UserExists: Unable to execute statement', $statement;
1415
1416   my @userdata = $sth->fetchrow_array;
1417
1418   $sth->finish;
1419
1420   return 0 if scalar (@userdata) == 0;
1421
1422   my $dbpassword = pop @userdata;
1423   my $dbuserid   = pop @userdata;
1424
1425   if ($dbuserid ne $userid) {
1426     return 0;
1427   } else {
1428     return $dbpassword;
1429   } # if
1430 } # UserExists
1431
1432 sub count ($$) {
1433   my ($table, $condition) = @_;
1434
1435   my $statement;
1436
1437   if ($condition) {
1438     $statement = "select count(*) from $table where $condition";
1439   } else {
1440     $statement = "select count(*) from $table";
1441   } # if
1442
1443   my $sth = $DB->prepare ($statement)
1444     or DBError 'count: Unable to prepare statement', $statement;
1445
1446   $sth->execute
1447     or DBError 'count: Unable to execute statement', $statement;
1448
1449   # Get return value, which should be how many message there are
1450   my @row = $sth->fetchrow_array;
1451
1452   # Done with $sth
1453   $sth->finish;
1454
1455   my $count;
1456
1457   # Retrieve returned value
1458   unless ($row[0]) {
1459     $count = 0
1460   } else {
1461     $count = $row[0];
1462   } # unless
1463
1464   return $count
1465 } # count
1466
1467 sub count_distinct ($$$) {
1468   my ($table, $column, $condition) = @_;
1469
1470   my $statement;
1471
1472   if ($condition) {
1473     $statement = "select count(distinct $column) from $table where $condition";
1474   } else {
1475     $statement = "select count(distinct $column) from $table";
1476   } # if
1477
1478   my $sth = $DB->prepare ($statement)
1479     or DBError 'count: Unable to prepare statement', $statement;
1480
1481   $sth->execute
1482     or DBError 'count: Unable to execute statement', $statement;
1483
1484   # Get return value, which should be how many message there are
1485   my @row = $sth->fetchrow_array;
1486
1487   # Done with $sth
1488   $sth->finish;
1489
1490   # Retrieve returned value
1491   unless ($row[0]) {
1492     return 0;
1493   } else {
1494     return $row[0];
1495   } # unless
1496 } # count_distinct
1497
1498 sub countlog (;$$) {
1499   my ($additional_condition, $type) = @_;
1500
1501   $type ||= '';
1502
1503   my $condition;
1504
1505   $condition  = "userid=\'$userid\' ";
1506
1507   $condition .= "and $additional_condition"
1508     if $additional_condition;
1509
1510   return count_distinct ('log', 'sender', $condition);
1511 } # countlog
1512
1513 1;