#
#  BBMAN - The BBMATIC BBS FOR THE WEB Manager
#
#     Filename: bbman.pl
#    Copyright: 1997,1998,1999 by Joe DePasquale
# Last revised: August 1, 1999
#       E-Mail: crypt@getcruising.com
#      Website: http://www.GetCruising.com
#
###########################################################################
#
# This script and accompanying files may be distributed freely
# and modified, provided this header with my name, E-Mail address and
# this notice remain intact. Ownership rights remain with me. You may
# not sell this script without my approval.
#
# This script comes with no guarantee or warranty except for my good
# intentions. By using this code you agree to indemnify me from any
# liability that might arise from it's use.
#
# There is no technical support for this script, neither am I a
# professional programmer. Refer to 'HELPME.TXT' for further guidance.
#
###########################################################################
# Setup stuff

sub bbman {

print qq|<html>\n<head><title>$headTitle</title></head>\n|;
print qq|$bodyTag\n$bodyTitle\n<p>\n|;

&passtest ($BBMPWD);

########################################################################
# Case: Delete and archive posts by age

if ($Form{'deletebyage'})
{
  if ($Form{'minmonths'})
  { $minSpan = $Form{'minmonths'} *100;
    if ($dateStamp %10000 < $minSpan +100)
    { $minDate = $dateStamp -$minSpan -8800;
    } else
    { $minDate = $dateStamp -$minSpan;
    }
  } else
  { &endMan ("Must select minimum months of inactivity 1-12");
  }
  open (LOCK,">$BBMFLK") || &endMan ("Write: $BBMFLK");
  if (!flock (LOCK,2)) { &endMan ("Lock: $BBMFLK"); }

  open (BBM,"+<$BBMDAT") || &endMan ("Read\/Write: $BBMDAT");
  flock (BBM,2); seek (BBM,0,0);
  $startSize = @bbmFile = <BBM>;
  $lineNbr =0;
  $subjCnt =0; $fileCnt =0;

  while ($lineNbr <=$#bbmFile)
  { $postCnt =0; $lastDate =0;
    do
    { @fields = split (/\|/,$bbmFile[$lineNbr+$postCnt]);
      if ($postCnt ==0) { $subjNbr = $fields[0]; }
      $endFlag = 'Y';
      if ($fields[0] == $subjNbr)
      { ($mm,$dd,$yy) = split (/\//,$fields[5]);
        $postDate = $yy *10000 + $mm *100 + $dd;

        if ($postDate > $lastDate) { $lastDate = $postDate; }
        $postCnt++; $endFlag = 'N';
      }
    } until ($endFlag eq 'Y');

    if ($lastDate < $minDate)
    { push (@purgeList,$subjNbr);

      $SUBJFILE = "$scriptDir/bbm$subjNbr.txt";
      undef @subjFile;

      if (-e $SUBJFILE)
      { open (SUBJECT,"<$SUBJFILE") || &endMan ("Read: $SUBJFILE");
        flock (SUBJECT,1); seek (SUBJECT,0,0);
        @subjFile = <SUBJECT>;
        close (SUBJECT);
      }
      $x =0;
      for $y ($lineNbr..$lineNbr+$postCnt-1)
      {
        $oldLine = $bbmFile[$y];
        if ($subjFile[$x])
        { $oldLine =~ s/\n$//;
          $oldLine .= "$subjFile[$x]";
        }
        push (@oldFile,$oldLine);
        $x++;
      }
      splice (@bbmFile,$lineNbr,$postCnt);
      $subjCnt++;
    } else
    { $lineNbr = $lineNbr+$postCnt;
    }
  }
  if ($subjCnt > 0)
  {
    # Add pastdate postings to the archive file
    open (OLD,"+<$BBMOLD") || &endMan ("Read\/Write: $BBMOLD");
    flock (OLD,2); seek (OLD,0,0);
    @unsorted = <OLD>;
    push (@unsorted,@oldFile);

    for $x (0..$#unsorted)
    { @index = split (/\|/,$unsorted[$x],3);
      $OldFile{$x} = $index[0]+($index[1]/10000);
    }
    seek (OLD,0,0);
    foreach $index (sort {$OldFile{$b} <=> $OldFile{$a}} keys %OldFile)
    { print OLD "$unsorted[$index]";
    }
    truncate (OLD,tell(OLD)); close (OLD);

    # Write the new bbmdata file
    seek (BBM,0,0);
    print (BBM @bbmFile);
    truncate (BBM,tell(BBM));

    # Delete pastdate subject files
    foreach $subjNbr (@purgeList)
    { $SUBJFILE = "$scriptDir/bbm$subjNbr.txt";
      { if (-e $SUBJFILE)
        { unlink $SUBJFILE;
          $fileCnt++;
        }
      }
    }
  }
  close (BBM);
  close (LOCK);
  $lineCnt = @oldFile;
  $endSize = @bbmFile;

  print qq|<font color="#0000FF">MAINTENANCE COMPLETED.</font>\n<p>\n|;
  print qq|<b>Summary of records processed</b>:<br>\nBBMDAT File: "$BBMDAT"<br>\n|;
  print qq| $subjCnt subjects were purged totaling $lineCnt lines.<br>\n|;
  print qq| Originally $startSize lines, now $endSize lines in file.<br>\n|;
  print qq|$fileCnt related SUBJECT FILES were deleted from "$scriptDir/".\n<p>\n|;

  &manager ($Form{'minmonths'});
  &footer;
} # end deletebyage

######################################################################
# CASE: Print list of all posts

elsif ($Form{'listbynumber'})
{
  open (BBM,"<$BBMDAT") || &endMan ("Read: $BBMDAT");
  flock (BBM,1); seek (BBM,0,0);
  @bbmFile = <BBM>;
  close (BBM);

  print qq|<form action="$scriptUrl" method=POST>\n|;
  print qq|<input type=hidden name=password value="$Form{'password'}">\n|;
  print qq|<input type=hidden name=manager value=1>\n|;
  print qq|<input type=hidden name=script value="$script">\n|;
  print qq|<b>Select Subjects and/or Comments to be deleted:</b>\n<p>\n|;
  print qq|<font color="#0000FF">SUBJECTS are printed BLUE. Deleting a subject line will ALSO delete the attached comment lines AND the extra subject and comment text lines stored in the subject file, if any.</font><br>\n|;
  print qq|<font color="#006600">COMMENTS are printed GREEN. Deleting a comment line will ONLY delete that particular comment line AND the extra comment text line stored in the subject file, if any.</font><br>\n|;
  print qq|<font size=2>\n|;

  for $lineNbr (0..$#bbmFile)
  { @fields = split (/\|/,$bbmFile[$lineNbr]);
    $commNbr = $fields[1];

    if ($commNbr ==0)
    { $subjNbr = $fields[0]; 
      print qq|<hr>\n<font color="#0000FF"><b>SUBJECT $subjNbr <input type=checkbox name=subjdelete value="$subjNbr"></b>: $fields[2]|;

      if (-e "$scriptDir/bbm$subjNbr.txt") { print qq|&nbsp; (View <b><a href="$bbmatUrl/$script/bbm$subjNbr.txt" target="BBM_NEW">bbm$subjNbr.txt</a></b>?)|; }
      print qq|<br>\n$fields[6]<br>\n<b>NAME</b>: $fields[3] <b>EMAIL</b>: $fields[4] <b>DATE</b>: $fields[5]</font>\n|;
    } elsif ($subjNbr == $fields[0])
    { print qq|<br>\n<font color="#006600"><b>COMMENT $subjNbr\.$commNbr <input type=checkbox name=commdelete value="$subjNbr;$commNbr"></b>: $fields[6]<br>\n|;
      print qq|NAME: $fields[3] EMAIL: $fields[4] DATE: $fields[5]</font>\n|;
    }
  }
  print qq|<p></font>\n<input type=submit name=deletebynumber value="DELETE!">&nbsp;|;
  print qq|<input type=reset value=" CLEAR ">&nbsp;<input type=submit value="IGNORE"></form>\n|;

  &footer;
} # end listbynumber

######################################################################
# CASE: Delete posts by number

elsif ($Form{'deletebynumber'})
{
  open (LOCK,">$BBMFLK") || &endMan ("Write: $BBMFLK");
  if (!flock (LOCK,2)) { &endMan ("Lock: $BBMFLK"); }

  open (BBM,"+<$BBMDAT") || &endMan ("Read\/Write: $BBMDAT");
  flock (BBM,2); seek (BBM,0,0);
  $startSize = @bbmFile = <BBM>;
  $subjCnt =0; $commCnt =0; $fileCnt =0;

  if ($Form{'subjdelete'})
  { @subjects = split (/\0/,$Form{'subjdelete'});
    for $x (0..$#subjects)
    { $Subjects{$subjects[$x]} = 'Y';
    }
    $deleteFlag = 'Y';
  }
  if ($Form{'commdelete'})
  { @comments = split (/\0/,$Form{'commdelete'});
    for $x (0..$#comments)
    { ($subject,$comment) = split (/;/,$comments[$x]);
      if (!defined $Subjects{$subject})
      { $Comments{$comments[$x]} = 'Y';
      }
      $deleteFlag = 'Y';
    }
  }
  if (!$deleteFlag) { &endMan ("No posts were selected for deletion!"); }

  $lineNbr =0;
  while ($lineNbr <=$#bbmFile)
  { @fields = split (/\|/,$bbmFile[$lineNbr]);
    $subjNbr = $fields[0]; $commNbr = $fields[1];
    $SUBJFILE = "$scriptDir/bbm$subjNbr.txt";

    if ($Subjects{$subjNbr})
    { splice (@bbmFile,$lineNbr,1);
      if ($commNbr == 0)
      { $subjCnt++; 

        # delete subject file
        if (-e $SUBJFILE)
        { unlink $SUBJFILE;
          $fileCnt++;
        }
      } else
      { $commCnt++;
      }
    } elsif ($Comments{"$subjNbr;$commNbr"})
    { splice (@bbmFile,$lineNbr,1);
      $commCnt++;

      # remove comment from subject file
      if (-e $SUBJFILE)
      { open (SUBJECT,"+<$SUBJFILE") || &endMan ("Read\/Write: $SUBJFILE");
        flock (SUBJECT,2); seek (SUBJECT,0,0);
        @subjFile = <SUBJECT>;

        $subjFile[$commNbr] = "\n";
        seek (SUBJECT,0,0);
        print SUBJECT @subjFile;
        truncate (SUBJECT,tell(SUBJECT)); close (SUBJECT);
      }
    } else
    { $lineNbr++;
    }
    undef $SUBJFILE; undef @subjFile;
  }
  seek (BBM,0,0);
  print (BBM @bbmFile);
  truncate (BBM,tell(BBM)); close (BBM);
  close (LOCK);

  $endSize = @bbmFile;

  print qq|<font color="#0000FF">MAINTENANCE COMPLETED.</font>\n<p>\n|;
  print qq|<b>Summary of records processed</b>:<br>\nBBMDAT File: "$BBMDAT"<br>\n|;
  print qq| $subjCnt subject lines and $commCnt comment lines were purged.<br>\n|;
  print qq| Originally $startSize lines, now $endSize lines in file.<br>\n|;
  print qq|$fileCnt related SUBJECT FILES were deleted from "$scriptDir/".\n<p>\n|;

  &manager;
  &footer;

} # end deletebynumber

######################################################################
# Default case: View manager menu

else
{ &manager;
  &footer;
} # end default case
} # end bbman

######################################################################

sub manager # View BBMAN menu
{
  if ($_[0]) { $minmonths = $_[0]; } else { $minmonths = 12; }

  print qq|<form action="$scriptUrl" method=POST>\n|;
  print qq|<input type=hidden name=password value="$Form{'password'}">\n|;
  print qq|<input type=hidden name=manager value=1>\n|;
  print qq|<table border=1>\n<tr align=right><td>Select FORUM:</td>|;
  print qq|<td>Data filesize</td><td>Archive filesize</td><td>Total Bytes</td></tr>\n|;

  foreach $scriptKey (keys %Script)
  { print qq|<tr align=right><td align=left><input type=radio name=script value="$scriptKey"|;
    if ($script eq $scriptKey) { print " checked"; }

    $scriptDir = $Script{$scriptKey};
    $datB = (-s "$scriptDir/bbm.dat");
    $oldB = (-s "$scriptDir/bbmold.dat");
    $totalB = $datB + $oldB;
    print qq|\>$scriptKey</td><td>$datB</td><td>$oldB</td><td>$totalB</td></tr>\n|;
  }
  print qq|</table><br>\n|;
  print qq|<hr>\n<b><font color="#006600">Remove SUBJECTS and/or COMMENTS <input type=submit name=listbynumber value="BY  NUMBER"><br></font>\n|;
  print qq|OR <font color="#0000FF">Remove SUBJECTS inactive for <select name="minmonths" size=1>\n|;

  for $x (1..12)
  { if ($x == $minmonths)
    { print "<option selected>$x ";
    } else
    { print "<option>$x ";
    }
  }
  print qq|</select>\n or more months <input type=submit name=deletebyage value=" BY  AGE "></font></b>\n<hr>\n|;
  print qq|ONLY Posts deleted BY AGE will be saved and added to the archive file</form>\n|;

} # end manager

sub footer # print the footer
{
  print qq|<br>Completed on $timeStamp.\n|;
  print qq|<p><a href="$exitUrl">Exit $headTitle</a>\n|;
  print qq|<p><font size=2><i><b>BBMATIC BBS FOR THE WEB</b> is one of <a href="http://www.GetCruising.com/crypt" target="_top">Joe's CGI Scripts From The Crypt!</a></i></font>\n|;
  print qq|<p>\n</body></html>\n|;
} # end footer

sub passtest # Test and/or change manager's password
{
  $PASSFILE = $_[0];
  if (-s $PASSFILE)
  { if ($Form{'password'})
    { open (PASS,"<$PASSFILE");
      $passcode = <PASS>;
      close (PASS);
      chop ($passcode) if $passcode =~ /\n$/;
      $lp = length $Form{'password'};
      $salt = substr($Form{'password'},$lp-2,1).substr($Form{'password'},1,1);
      if ($passcode eq crypt ($Form{'password'},$salt))
      { if ($Form{'newpassword'})
        { $lp = length $Form{'newpassword'};
          if ($Form{'newpassword'} =~ /^\w{$lp}\b/)
          { $Form{'password'} = $Form{'newpassword'};
            $salt = substr($Form{'password'},$lp-2,1).substr($Form{'password'},1,1);
            $passcode = crypt ($Form{'password'},$salt);
            open (PASS,">$PASSFILE");
            print PASS "$passcode";
            close (PASS);
          } else
          { &passbox ("Bad choice, Creep!!");
          }
        }
      } else
      { &passbox ("Wrong, Creep!!");
      }
    } else
    { &passbox ("What's the Password, Creep?");
    }
  } else
  { &endMan ("Password File $PASSFILE Not Found");
  }
}

sub passbox # print the password form
{
  print <<__PASSBOX;
  <form action="$scriptUrl" method="POST">
  <input type=hidden name=manager value=1>
  <input type=hidden name=script value="$script">
  <table border=4>
  <tr><th colspan=2><font color="#FF0000"><b><blink>$_[0]</blink></b></font></th></tr>
  <tr><th> Enter Password:</td><th><input type=password name=password size=12 maxlength=12></th></tr>
  <tr><th>Change Password:</td><th><input type=text name=newpassword size=12 maxlength=12></th></tr>
  <th colspan=2><input type=submit value="  DO IT!  "><input type=reset value="  CLEAR  "></th></tr>
  </table><br>
  Password must be 4 to 12 alpha-numeric characters.</form><p>
__PASSBOX
  exit;
}

sub endMan # Error handling for manager scripts
{
  print qq|<font color="#FF0000"><b>ERROR:</font><br>$_[0]</b>\n<p>|;
  if ($!) { print qq|Server made a Boo-Boo! $!\n|; }
  else { print qq|Use your browser's [BACK] button and try again.\n|; }
  print qq|<p></body></html>\n|;
  exit;
} # end endIt

1; # return true
