home *** CD-ROM | disk | FTP | other *** search
/ ftp.sunet.sepub/pictures / 2014.11.ftp.sunet.se-pictures.tar / ftp.sunet.se / pub / pictures / ACiD-artpacks / www / mirrors / acheron / discus_admin_116439176 / source / src-board-subs-5 < prev    next >
Text File  |  1999-01-29  |  34KB  |  919 lines
  1. # FILE: src-board-subs-5
  2. #-------------------------------------------------------------------------------
  3. # This script is copyright (c) 1998 by DiscusWare, LLC, all rights reserved.
  4. # Its use is subject to the license agreement that can be found at the following
  5. # URL:  http://www.chem.hope.edu/discus/license
  6. #-------------------------------------------------------------------------------
  7.  
  8. #---SEPARATOR---#
  9. #REQ:extract_colorsonly
  10.  
  11. sub preview_admin_message {
  12.     local ($message_source, $message_formatted, $username, $referer, $action, $mtitle) = @_;
  13.     &header;
  14.     print "<HTML><HEAD><TITLE>Preview of $mtitle</TITLE>\n";
  15.     print "<SCRIPT LANGUAGE=\"JavaScript\">\n";
  16.     print "<!--\n";
  17.     print "function setStatus(msg) {\n";
  18.     print "  window.status=msg\n";
  19.     print "  return true\n";
  20.     print "}\n";
  21.     print "//-->\n";
  22.     print "</SCRIPT></HEAD>\n";
  23.     ($bgcolor, $text, $link, $vlink, $alink, $face, $size, $img) = &extract_colorsonly;
  24.     print "<BODY BGCOLOR=\"ffffff\" TEXT=\"000000\" LINK=\"$link\" ";
  25.     print "VLINK=\"$vlink\" onLoad=\"window.defaultStatus='Preview of $mtitle'\">$fs\n";
  26.     print "<FONT SIZE=3><CENTER><B>Preview of $mtitle</B></CENTER></FONT>\n<HR>\n";
  27.     if ($mtitle eq "About Message" || $mtitle eq "Announcement") {
  28.         local (@array) = ("$topic_number:$topic_name");
  29.         foreach $key (sort by_number keys(%level_number)) {
  30.             push (@array, "$level_number{$key}:$level_name{$key}");
  31.         }
  32.         print "<B><A HREF=\"$cgiurlm?username=$username&action=mgr_1";
  33.         print "&HTTP_REFERER=$page_referer\" onMouseOver=\"return setStatus('";
  34.         print "Return to topic selection screen')\"><FONT COLOR=#0000ff>Page Manager</FONT></A>:\n";
  35.         foreach $line (@array) {
  36.             ($number,$name) = split(/:/, $line, 2);
  37.             print "<A HREF=\"$cgiurlm?username=$username&action=page_editor";
  38.             print "&HTTP_REFERER=//$topic_number/$number.$ext\" onMouseOver=\"return ";
  39.             $str = &JavaScript_prepare($name);
  40.             print "setStatus('Return to editing $str')\">";
  41.             print "<FONT COLOR=#0000ff>$name</FONT>";
  42.             print "</A>: \n";
  43.         }
  44.     } elsif ($mtitle eq "Main Message" || $mtitle eq "Title Message" || $mtitle eq "Topic Description") {
  45.         print "<B><A HREF=\"$cgiurlm?username=$username&cmd=board_mgr\" onMouseOver=\"";
  46.         print "return setStatus('Return to Board Manager')\"><FONT COLOR=#0000ff>Board Manager</FONT></A>:\n";
  47.     } elsif ($mtitle eq "Welcome Message") {
  48.         print "<B><A HREF=\"$cgiurlm?username=$username&cmd=options_mgr\" onMouseOver=\"";
  49.         print "return setStatus('Return to Options Manager')\"><FONT COLOR=#0000ff>Options Manager</FONT></A>: ";
  50.         print "<A HREF=\"$cgiurlm?username=$username&cmd=reg_configurator\" onMouseOver=\"";
  51.         print "return setStatus('Return to Self Registration Configurator')\"><FONT COLOR=#0000ff>Self Registration Configurator</FONT></A>: ";
  52.     }
  53.     print "Preview of $mtitle</B>\n";
  54.     print "<HR><P>\n";
  55.     print "A preview of your message appears below.  If you used any ";
  56.     print "formatting tags in your message, please check to see that your ";
  57.     print "formatting is displayed correctly in the preview.<P>\n";
  58.     print "<TABLE BORDER=1 WIDTH=100% HEIGHT=40%>\n";
  59.     print "<TR><TD VALIGN=TOP BGCOLOR=\"$bgcolor\" BACKGROUND=\"$img\"><FONT COLOR=\"$text\" FACE=\"$face\" SIZE=\"$size\">$message_formatted</FONT>";
  60.     print "</TD></TR></TABLE><P>\n";
  61.     print "<HR><P><H3>Revise $mtitle</H3>\n";
  62.     print "<TABLE BGCOLOR=ffffcc BORDER=1 WIDTH=100%><TR><TD>";
  63.     print "<FORM ACTION=\"$cgiurl1\" METHOD=POST>\n" if ($mtitle eq "About Message" || $mtitle eq "Announcement");
  64.     print "<FORM ACTION=\"$cgiurl2\" METHOD=POST>\n" if ($mtitle eq "Main Message" || $mtitle eq "Topic Description" || $mtitle eq "Title Message");
  65.     print "<FORM ACTION=\"$cgiurl\" METHOD=POST>\n" if ($mtitle eq "Welcome Message");
  66.     print "<TABLE><TR><TD><TEXTAREA NAME=message ROWS=6 COLS=60 WRAP=VIRTUAL>";
  67.     print "$message_source</TEXTAREA></TD></TR></TABLE><P>\n\n";
  68.     print "<input type=hidden name=\"action\" value=\"$action\">\n";
  69.     print "<input type=hidden name=\"username\" value=\"$username\">\n";
  70.     print "<input type=submit name=submit value=\"Refresh Preview\">\n";
  71.     print "<input type=submit name=submit value=\"Save Message\">\n" if $message_formatted !~ /<H3>FORMATTING/i;
  72.     print "<input type=hidden name=\"HTTP_REFERER\" value=\"$referer\">\n" if $referer;
  73.     print "</TD></TR></TABLE></FORM></BODY></HTML>\n";
  74.     exit(0);
  75. }
  76.  
  77. #---SEPARATOR---#
  78.  
  79. sub change_about_message {
  80.     local ($file, $source, $formatted) = @_;
  81.     local (@file, $messageflag, $line, $source_esc, $topic, $page);
  82.     if ($file =~ m|/(\d+)/(\d+)\.$ext|) {
  83.         ($topic, $page) = ($1, $2);
  84.     } else {
  85.         &error_message("Change About Message Error", "Could not open requested file");
  86.     }
  87.     &lock("$message_dir/$topic/$page.$ext");
  88.     local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic, $page);
  89.     &set_page($topic, $page, $head, $color, $lm, $ann, $ann_src, $sublist, $formatted, &escape($source), $message, $message_src);
  90.     &unlock("$message_dir/$topic/$page.$ext");
  91. }
  92.  
  93. #---SEPARATOR---#
  94. #REQ:recurse
  95.  
  96. sub remove_page {
  97.     local ($topic_number, $parent, $page_number) = @_;
  98.     local ($pn, @pn, @lines, $line, $filename, $filenumber, @ps);
  99.     @pn = split(/,/, $page_number);
  100.     foreach $pn (@pn) {
  101.         $pn =~ s/^0//g;
  102.     }
  103.     &lock("$message_dir/$topic_number/$parent.$ext");
  104.     local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic_number, $parent);
  105.     @lines = split(/\n/, $sublist);
  106.     foreach $line (@lines) {
  107.         $filenumber = "-NONE-";
  108.         $filenumber = $1 if $line =~ m|<!-Top: (\d+)-!>|;
  109.         $filenumber = $1 if $line =~ m|<!-URL: (\d+)-!>|;
  110.         if (grep(/^$filenumber$/, @pn)) {
  111.             $line = "";
  112.             push (@ps, $filenumber);            
  113.         }
  114.     }
  115.     $sublist = join("\n", grep(/\S/, @lines));
  116.     &set_page($topic_number, $parent, $head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src);
  117.     &unlock("$message_dir/$topic_number/$parent.$ext");
  118.     foreach $filenumber (@ps) {
  119.         &recurse ($topic_number, $filenumber, "delete");
  120.     }
  121. }
  122.  
  123. #---SEPARATOR---#
  124. #REQ:get_date_time
  125. #REQ:manage_images
  126. #REQ:manage_attachments
  127. #REQ:reapply_webtags
  128.  
  129. sub move_page {
  130.     local ($old_topic, $page_number, $old_parent, $new_topic, $new_parent) = @_;
  131.     return 1 if ($old_topic == $new_topic && $old_parent == $new_parent);
  132.     &lock("$message_dir/$old_topic/$old_parent.$ext");
  133.     local ($head1, $color1, $lm1, $ann1, $ann_src1, $sublist1, $about1, $about_src1, $message1, $message_src1) = &get_page($old_topic, $old_parent);
  134.     local (@temp, $headstr, $nextkey, $owner, $line, $param, @tomove, $temp, @pn);
  135.     local ($t1, $t2, $t3);
  136.     undef @message_move_move_page;
  137.     @pn = split(/,/, $page_number);
  138.     @temp = split(/\n/, $sublist1);
  139.     foreach $line (@temp) {
  140.         $line =~ m|<!-(\w+): (\d+)-!>|;
  141.         $temp = $2;
  142.         if (grep(/^$temp$/, @pn)) {
  143.             push (@tomove, $line) if ($old_topic != $new_topic || $old_parent != $new_parent);
  144.             $line = "";
  145.         }
  146.     }
  147.     $sublist1 = join("\n", grep(/\S/, @temp));
  148.     &set_page($old_topic, $old_parent, $head1, $color1, $lm1, $ann1, $ann_src1, $sublist1, $about1, $about_src1, $message1, $message_src1);
  149.     &unlock("$message_dir/$old_topic/$old_parent.$ext");
  150.     &lock("$message_dir/$new_topic/$new_parent.$ext");
  151.     local ($head2, $color2, $lm2, $ann2, $ann_src2, $sublist2, $about2, $about_src2, $message2, $message_src2) = &get_page($new_topic, $new_parent);
  152.     if ($new_topic != $old_topic) {
  153.         foreach $line (@tomove) {
  154.             $line =~ s|/messages/$old_topic/(\d+).$ext|/messages/$new_topic/$1.$ext|g;
  155.         }
  156.     }
  157.     $sublist2 .= join("\n", @tomove);
  158.     @temp = split(/\n/, $head2);
  159.     foreach $line (@temp) {
  160.         if ($line =~ m|<!--Topic:|) {
  161.             $headstr .= "$line\n";
  162.         } elsif ($line =~ m|<!--Owner: (.*)-->|) {
  163.             $owner = $1;
  164.         } elsif ($line =~ m|<!--Level (\d+): (\d+)/(.*)-->|) {
  165.             ($t1, $t2, $t3) = ($1, $2, $3);
  166.             $headstr .= "$line\n";
  167.             $nextkey = $t1;
  168.         } elsif ($line =~ m|<!--Param: (.*)-->|) {
  169.             $param = $1;
  170.         }
  171.     }
  172.     $nextkey += 1;
  173.     &set_page($new_topic, $new_parent, $head2, $color2, $lm2, $ann2, $ann_src2, $sublist2, $about2, $about_src2, $message2, $message_src2);
  174.     &unlock("$message_dir/$new_topic/$new_parent.$ext");
  175.     foreach $line (@tomove) {
  176.         if ($line =~ m|<!-Top: (\d+)-!>|) {
  177.             ®enerate_pages($headstr, $old_topic, $1, "", $owner, $new_topic, $nextkey, $new_parent);
  178.         }
  179.     }
  180.     if (scalar(@message_move_move_page)) {
  181.         local (@LOG);
  182.         &lock("$admin_dir/log.txt");
  183.         open (LOG, "$admin_dir/log.txt");
  184.         @LOG = <LOG>;
  185.         close (LOG);
  186.         local ($indx, $who, $when, $where, $rest);
  187.         foreach $line (@LOG) {
  188.             ($indx, $who, $when, $where, $rest) = split(/;/, $line, 5);
  189.             if (grep(/^$indx$/, @message_move_move_page)) {
  190.                 ($tpc, $page) = split(/\//, $where);
  191.                 $line = join(";", $indx, $who, $when, "$new_topic/$page", $rest);
  192.             }
  193.         }
  194.         open (LOG, ">$admin_dir/log.txt");
  195.         print LOG @LOG;
  196.         close (LOG);
  197.         &unlock("$admin_dir/log.txt");
  198.     }
  199. }
  200.  
  201. sub regenerate_pages {
  202.     local ($headstr, $topic, $page, $additional, $owner, $new_topic, $nextkey, $parent) = @_;
  203.     &lock("$message_dir/$topic/$page.$ext");
  204.     local ($head1, $color1, $lm1, $ann, $ann_src, $sublist1, $about1, $about_src1, $message1, $message_src1) = &get_page($topic, $page);
  205.     &unlock("$message_dir/$topic/$page.$ext");
  206.     local ($line, @head, $newhead, $me_name, $param, $me_number);
  207.     @head = split(/\n/, $head1);
  208.     foreach $line (@head) {
  209.         if ($line =~ m|<!--Me: (\d+)/(.*)-->|) {
  210.             ($me_number, $me_name) = ($1, $2);
  211.         } elsif ($line =~ m|<!--Param: (.*)-->|) {
  212.             $param = $1;
  213.         }
  214.     }
  215.     $newhead = $headstr;
  216.     $newhead .= $additional;
  217.     $newhead .= "<!--Level $nextkey: $page/$me_name-->\n";
  218.     $additional .= "<!--Level $nextkey: $page/$me_name-->\n";
  219.     $nextkey += 1;
  220.     $newhead .= "<!--Me: $page/$me_name-->\n";
  221.     $newhead .= "<!--Parent: $parent-->\n";
  222.     $newhead .= "<!--Owner: $owner-->\n";
  223.     $newhead .= "<!--Param: $param-->\n";
  224.     local ($numb, $exten, @msg);
  225.     &unlock("$message_dir/$topic/$page.$ext");
  226.     @msg = split(/\n/, $sublist1);
  227.     foreach $line (@msg) {
  228.         if ($line =~ m|<!-Top: (\d+)-!>|) {
  229.             $numb = $1;
  230.             if ($new_topic != $topic) {
  231.                 $line =~ s|/messages/$topic/(\d+).$ext|/messages/$new_topic/$1.$ext|g;
  232.             }
  233.             ®enerate_pages($headstr, $topic, $numb, $additional, $owner, $new_topic, $nextkey, $me_number);
  234.         }
  235.     }
  236.     $sublist1 = join("\n", @msg);
  237.     $p_temp = $message1;
  238.     while ($p_temp =~ m|<!-Post: (\d+)-!>|) {
  239.         push (@message_move_move_page, $1);
  240.         $p_temp = join("", $`, $');
  241.     }
  242.     undef @files_move;
  243.     @files_move = &manage_images(&unescape($message_src1), $topic, 0, "list");
  244.     @files_move_2 = &manage_attachments(&unescape($message_src1), $topic, 0, "list") if $pro;
  245.     foreach $f (@files_move_2) {
  246.         push (@files_move, $f);
  247.     }
  248.     if (scalar(@files_move) > 0) {
  249.         $topic_number = $new_topic;
  250.         foreach $file_in (@files_move) {
  251.             if ($file_in =~ m|^(.*)/(\d+)/([^/]+)$|) {
  252.                 $filename = $3;
  253.                 $dest = "$message_dir/$new_topic/$filename" if -e "$message_dir/$new_topic";
  254.                 $dest = "$secdir/$new_topic/$filename" if -e "$secdir/$new_topic";
  255.                 open (SRC, "$file_in");
  256.                 eval 'binmode(SRC);';
  257.                 @src = <SRC>;
  258.                 close (SRC);
  259.                 open (DEST, ">$dest");
  260.                 eval 'binmode(DEST);';
  261.                 print DEST @src;            
  262.                 close (DEST);
  263.                 unlink($file_in);
  264.             }
  265.         }
  266.         $message1 = &reapply_webtags($message_src1, $message1);
  267.     }    
  268.     &set_page($new_topic, $page, $newhead, $color1, $lm1, $ann, $ann_src, $sublist1, $about1, $about_src1, $message1, $message_src1);
  269.     if ($new_topic != $topic) {
  270.         unlink ("$secdir/$topic/$page.$ext") if !-e "$html_dir/messages/$topic/$page.$ext";
  271.         unlink ("$html_dir/messages/$topic/$page.$ext") if -e "$html_dir/messages/$topic/$page.$ext";
  272.     }
  273. }
  274.  
  275. #---SEPARATOR---#
  276. #REQ:determine_addmessage
  277.  
  278. sub printuntil {
  279.     local ($start, $finish, $topic_number, $title, $flag, $cache) = @_;
  280.     if (!$cache) {
  281.         ($template, $addfile) = &determine_addmessage($topic_number);
  282.         @PrintUntil_FILE = split(/\n/, $template);
  283.         if ($flag != 1) {
  284.             ($bgcolor, $text, $link, $vlink, $alink, $face, $size, $image) = &ex('extract_colorsonly', 1);
  285.         }
  286.         foreach $line (@PrintUntil_FILE) {
  287.             $line .= "\n";
  288.             while ($line =~ /\$(\w+)/) {
  289.                 $this = eval "\$$1";
  290.                 $line = $` . $this . $';
  291.             }
  292.         }
  293.     }
  294.     $cpos = 0;
  295.     foreach $line (@PrintUntil_FILE) {
  296.         if ($line =~ m|<!--Start-->|) {
  297.             $cpos = 1;
  298.         } elsif ($line =~ m|<!--Bigtitle-->|) {
  299.             $cpos = 2;
  300.         } elsif ($line =~ m|<!--/Bigtitle-->|) {
  301.             $cpos = 3;
  302.         } elsif ($line =~ m|<!--Navbar-->|) {
  303.             $cpos = 4;
  304.         } elsif ($line =~ m|<!--/Navbar-->|) {
  305.             $cpos = 5;
  306.         } elsif ($line =~ m|<!--Announcement-->|) {
  307.             $cpos = 0;
  308.         } elsif ($line =~ m|<!--/Announcement-->|) {
  309.             $cpos = 5;
  310.         } elsif ($line =~ m|<!--Sublist-->|) {
  311.             $cpos = 6;
  312.         } elsif ($line =~ m|<!--/Sublist-->|) {
  313.             $cpos = 7;
  314.         } elsif ($line =~ m|<!--Create-->|) {
  315.             $cpos = 8;
  316.         } elsif ($line =~ m|<!--/Create-->|) {
  317.             $cpos = 9;
  318.         } elsif ($line =~ m|<!--About-->|) {
  319.             $cpos = 10;
  320.         } elsif ($line =~ m|<!--/About-->|) {
  321.             $cpos = 11;
  322.         } elsif ($line =~ m|<!--Messages-->|) {
  323.             $cpos = 12;
  324.         } elsif ($line =~ m|<!--/Messages-->|) {
  325.             $cpos = 13;
  326.         } elsif ($line =~ m|<!--Add-->|) {
  327.             $cpos = 14;
  328.         } elsif ($line =~ m|<!--/Add-->|) {
  329.             $cpos = 15;
  330.         } elsif ($line =~ m|<!--Message Source|) {
  331.             $cpos = 16;
  332.         } elsif ($line =~ m|-->| && $cpos == 16) {
  333.             $cpos = 17;
  334.         } elsif ($line =~ m|<META|i && $line !~ m|<!-ShowMeta-!>|) {
  335.             # Skip
  336.         } elsif ($line =~ m|^<!-AdminFromHere-!>|) {
  337.             # Skip
  338.         } elsif ($start == $finish && $cpos == $start) {
  339.             print $line if $line =~ /\S/;
  340.         } elsif ($start != $finish && $cpos >= $start && $cpos <= $finish && $cpos % 2 == 1) {
  341.             print $line if $line =~ /\S/;
  342.         }
  343.     }
  344. }
  345.  
  346. #---SEPARATOR---#
  347.  
  348. sub remove_swearing {
  349.     local ($message_in, $code, $star_flag) = @_;
  350.     if (open(CUSS, "$admin_dir/cuss.txt")) {
  351.         @cuss = <CUSS>;
  352.         close (CUSS);
  353.         @cuss = grep(!/^#/, @cuss);
  354.         foreach $line (@cuss) {
  355.             $line =~ s/\s//g;
  356.             next if length($line) == 0;
  357.             if ($line =~ m|!|) {
  358.                 $line = $';
  359.                 $line =~ tr/a-zA-Z/b-zaB-ZA/;
  360.             }
  361.             $stars = "\\char{149}" x length($line);
  362.             $stars = join("", "\\red{", $stars, "}") if $code != 3;
  363.             $stars = "•" x length($line) if $star_flag;
  364.             $message_in =~ s/\b$line\b/$stars/gi;
  365.         }
  366.     }
  367.     return $message_in;
  368. }
  369.  
  370. #---SEPARATOR---#
  371.  
  372. sub access_mgr_2 {
  373.     local ($topic, $username) = @_;
  374.     local (@read, @post, $rl, $pl);
  375.     &extract("//$topic/$topic.$ext");
  376.     open (SECURITY, "$admin_dir/posting.txt"); @post = <SECURITY>; close (SECURITY);
  377.     ($pl) = grep(/^$topic:/, @post);
  378.     open (SECURITY, "$admin_dir/postoptions.txt"); @options = <SECURITY>; close (SECURITY);
  379.     ($ps) = grep(/^$topic:/, @options);
  380.     open (GROUPS, "$admin_dir/groups.txt"); @grp = <GROUPS>; close (GROUPS);
  381.     foreach $grp (@grp) {
  382.         $grp =~ m|^(\w+):|; $grp = $1;
  383.     }
  384.     &header;
  385.     print "<HTML><HEAD><TITLE>Access Manager</TITLE>\n";
  386.     print "<SCRIPT LANGUAGE=\"JavaScript\"> <!-- Hide\n";
  387.     print "function setStatus(msg) {\n";
  388.     print "  window.status=msg\n";
  389.     print "  return true\n";
  390.     print "}\n";
  391.     print "//-->\n";
  392.     print "</SCRIPT></HEAD>\n";
  393.     print '<BODY BGCOLOR="ffffff" TEXT="000000" LINK="0000FF" VLINK="0000FF" ';
  394.     print "onLoad=\"window.defaultStatus = 'Access Editor: ";
  395.     print &JavaScript_prepare($topic_name);
  396.     print "'\">$fs\n";
  397.     print "<FONT SIZE=3><CENTER><B>Access Editor: $topic_name</B></CENTER></FONT>\n";
  398.     print "<HR><B><A HREF=$cgiurlm?action=access_mgr_1&username=$username onMouseOver=\"return setStatus('Return to topic selection screen')\">Access Manager</A>:\n";
  399.     print "Access Editor</B>\n";
  400.     print "<HR><H3>Posting Privileges</H3>";
  401.     print "<FORM ACTION=\"$cgiurl\" METHOD=POST NAME=\"POSTFORM\">\n";
  402.     print "<TABLE BGCOLOR=#ffffcc BORDER=1 WIDTH=100%><TR><TD>\n";
  403.     ($topic, $ip, $usrgrp, $modgrp, $pass) = split(/:/, $pl);
  404.     @usrgrp = split(/,/, $usrgrp); @modgrp = split(/,/, $modgrp);
  405.     @ip = split(/,/, $ip);
  406.     print "$fs\n";
  407.     print "<INPUT TYPE=HIDDEN NAME=topic VALUE=$topic_number>\n";
  408.     print "<INPUT TYPE=HIDDEN NAME=username VALUE=$username>\n";
  409.     print "<INPUT TYPE=HIDDEN NAME=action VALUE=access_edit_simple>\n";
  410.     print "<INPUT TYPE=HIDDEN NAME=interface VALUE=simple>\n";
  411.     print "<B>Unrestricted:</B><BR>\n";        
  412.     print "  <INPUT TYPE=CHECKBOX NAME=\"publicbox\" VALUE=on ";
  413.     print "CHECKED " if grep(/^~$/, @ip);
  414.     print " onClick=\"if (document.forms[0].publicbox.checked) { document.forms[0].modgroup.checked = 0; document.forms[0].usergroup.checked = 0; document.forms[0].modall.checked = 0; document.forms[0].userall.checked = 0; }\"> Public Posting (anyone at all)";
  415.     print "<P>\n";
  416.     print "<B>Restricted to:</B><BR>\n";
  417.     print "  <INPUT TYPE=CHECKBOX NAME=modgroup VALUE=on ";
  418.     print "CHECKED" if grep(/^$owner$/, @modgrp);
  419.     print "CHECKED" if grep(/^~$/, @modgrp);
  420.     print " onClick=\"document.forms[0].publicbox.checked = 0;\"";
  421.     print "> Moderators in this group (\u$owner)";
  422.     print "<BR>\n";
  423.     print "  <INPUT TYPE=CHECKBOX NAME=usergroup VALUE=on ";
  424.     print "CHECKED" if grep(/^$owner$/, @usrgrp);
  425.     print "CHECKED" if grep(/^~$/, @usrgrp);
  426.     print " onClick=\"document.forms[0].publicbox.checked = 0;\"";
  427.     print "> Users in this group (\u$owner)";
  428.     print "<BR>\n";
  429.     print "  <INPUT TYPE=CHECKBOX NAME=modall VALUE=on ";
  430.     print "CHECKED" if grep(/^~$/, @modgrp);
  431.     print " onClick=\"document.forms[0].publicbox.checked = 0;\"";
  432.     print "> Moderators in every group";
  433.     print "<BR>\n";
  434.     print "  <INPUT TYPE=CHECKBOX NAME=userall VALUE=on ";
  435.     print "CHECKED" if grep(/^~$/, @usrgrp);
  436.     print " onClick=\"document.forms[0].publicbox.checked = 0;\"";
  437.     print "> Users in every group";
  438.     $ps =~ s/\s*$//;
  439.     print "<P>\n";
  440.     ($topicnumb, $anon, $stamp, $emaild) = split(/:/, $ps);
  441.     print "<INPUT TYPE=CHECKBOX NAME=anondisable VALUE=1 ";
  442.     print "CHECKED" if $anon == 1;
  443.     print "> Disable anonymous posts\n";
  444.     print "<BR>\n";
  445.     print "<INPUT TYPE=CHECKBOX NAME=emaildisable VALUE=1 ";
  446.     print "CHECKED" if $emaild == 1;
  447.     print "> Disable e-mail link on posts\n";
  448.     print "<BR>\n";
  449.     print "<INPUT TYPE=CHECKBOX NAME=stampdisable VALUE=1 ";
  450.     print "CHECKED" if $stamp == 1;
  451.     print "> Disable full name on posts\n";
  452.     print "<P><INPUT TYPE=SUBMIT VALUE='Save'>\n";
  453.     print "<INPUT TYPE=SUBMIT name=kill VALUE='Disable All Posting'>\n";
  454.     print "</TD></TR></TABLE>\n";
  455.     print "</FORM>\n";
  456.     print "</BODY></HTML>\n";        
  457. }
  458.  
  459. #---SEPARATOR---#
  460.  
  461. sub send_email_message {
  462.     local ($addresses, $subject_line, $text_out, $footer, $topic_number, $me_number) = @_;
  463.     
  464.     if ($GLOBAL_OPTIONS{'options_used'}) {
  465.         if ($GLOBAL_OPTIONS{'capable'} eq "0") {
  466.             return 0;
  467.         }
  468.         if ($GLOBAL_OPTIONS{'capable'} eq "" && $GLOBAL_OPTIONS{'email'} == 0) {
  469.             return 0;
  470.         }
  471.     }    
  472.     
  473.     # Important note:  Each address in '$addresses' was checked in the calling
  474.     # subroutine to meet the following pattern:
  475.     #    m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$|
  476.     
  477.     undef %email;
  478.     
  479.     # The following code checks for an "email.txt" file in your source directory
  480.     # and if it exists, it uses it.  We use this in our demonstration service,
  481.     # although it is unlikely that anyone else would need to use this.
  482.     
  483.     if (open(CFG, "$admin_dir/source/email.txt")) {
  484.         @cfg = <CFG>;
  485.         close (CFG);
  486.     } elsif (open (CFG, "$admin_dir/email.txt")) {
  487.         @cfg = <CFG>;
  488.         close (CFG);
  489.     } else {
  490.         return 0;
  491.     }
  492.     foreach $line (@cfg) {
  493.         if ($line =~ m|^(\w+)=(.*)|) {
  494.             $o = $1; $t = $2;
  495.             $t = &unescape($t) if $t !~ /\s/;
  496.             $email{$o} = $t;
  497.         }
  498.     }
  499.     $command = $email{'command_line'};
  500.     $input = $email{'input_stream'};
  501.     $command =~ s/\$SUBJECT/$subject_line/g;
  502.     $input =~ s/\$SUBJECT/$subject_line/g;
  503.     $command =~ s/\$REPLYTO/$reply_to/g;
  504.     $input =~ s/\$REPLYTO/$reply_to/g;
  505.     if ($email{'1message'} == 1) {
  506.         @addresses = split(/,/, $addresses);
  507.         foreach $line (@addresses) {
  508.             ($email, $user, $pass) = split(/\|\|/, $line);
  509.             $line = $email;
  510.         }
  511.         $addresses = join(",", @addresses);    
  512.         $command =~ s/\$BCC/$addresses/g;
  513.         $input =~ s/\$BCC/$addresses/g;
  514.         if ($email{'tempfile'} == 0) {
  515.             open (MAIL, $command);
  516.         } else {
  517.             $pid = $$; $pid =~ s/\D//g; $time = time;
  518.             $tempfile = "$message_dir/$time-$pid.tmp";
  519.             open (MAIL, ">$tempfile");
  520.         }            
  521.         print MAIL $input;
  522.         print MAIL "\n";
  523.         print MAIL $text_out;
  524.         print MAIL $footer if $footer;
  525.         close (MAIL);
  526.         if ($email{'tempfile'} == 1) {
  527.             $command =~ s%^\|\s*%%;
  528.             $pr = $email{'mail_program'};
  529.             if ($command =~ m|$pr|) {
  530.                 $stuff = $';
  531.                 $command = $pr;
  532.             } else {
  533.                 $stuff = "";
  534.             }
  535.             if ($^O eq "MSWin32") {
  536.                 $mail_prog = $pr;
  537.                 $mail_prog =~ s/\//\\/g;
  538.                 $tempfile =~ s/\//\\/g;
  539.                 $stuff =~ s/'/"/g;
  540.                 $stuff =~ s/^\s*//;
  541.                 if ($mail_prog =~ m|(.*)\\|) {
  542.                     $cwd = $1;
  543.                 } else {
  544.                     $cwd = ".";
  545.                 }
  546.                 eval '
  547.                     use Win32::Process;
  548.                     use Win32;
  549.                     Win32::Process::Create($ProcessObj, $mail_prog, "$mail_prog $tempfile $stuff", 0, DETACHED_PROCESS, $cwd) || &error_message("Windows Process Creation Error", Win32::FormatMessage(Win32::GetLastError()));
  550.                     $ProcessObj->Wait(INFINITE);
  551.                 ';
  552.             } else {
  553.                 system("$command_line", "$tempfile", "$stuff");
  554.             }
  555.             unlink ($tempfile);
  556.         }
  557.     } else {
  558.         @addresses = split(/,/, $addresses);
  559.         foreach $address (@addresses) {
  560.             ($email, $user, $pass) = split(/\|\|/, $address);
  561.             $address = $email;
  562.             $command_temp = $command;
  563.             $input_temp = $input;
  564.             $command_temp =~ s/\$TO/$address/g;
  565.             $input_temp =~ s/\$TO/$address/g;
  566.             if ($email{'tempfile'} == 0) {
  567.                 open (MAIL, $command_temp);
  568.             } else {
  569.                 $command_temp =~ s%^\|\s*%%;
  570.                 $pid = $$; $pid =~ s/\D//g; $time = time;
  571.                 $tempfile = "$message_dir/$time-$pid.tmp";
  572.                 open (MAIL, ">$tempfile");
  573.             }            
  574.             print MAIL $input_temp;
  575.             print MAIL "\n";
  576.             print MAIL $text_out;
  577.             print MAIL $footer if $footer;
  578.             if ($reply_by_email) {
  579.                 print MAIL " ***||$user||", crypt($pass, "cookie"), "||$topic_number||$me_number||***\n\n";
  580.                 print MAIL "$L{BPR_GOTOLINK}\n";
  581.                 print MAIL "$script_url/show.$cgi_extension?$topic/$page\n\n";
  582.             }
  583.             close (MAIL);
  584.             if ($email{'tempfile'} == 1) {
  585.                 $pr = $email{'mail_program'};
  586.                 if ($command_temp =~ m|$pr|) {
  587.                     $stuff = $';
  588.                     $command_temp = $pr;
  589.                 } else {
  590.                     $stuff = "";
  591.                 }
  592.                 if ($^O eq "MSWin32") {
  593.                     $mail_prog = $pr;
  594.                     $mail_prog =~ s/\//\\/g;
  595.                     $tempfile =~ s/\//\\/g;
  596.                     $stuff =~ s/'/"/g;
  597.                     $stuff =~ s/^\s*//;
  598.                     if ($mail_prog =~ m|(.*)\\|) {
  599.                         $cwd = $1;
  600.                     } else {
  601.                         $cwd = ".";
  602.                     }
  603.                     eval '
  604.                         use Win32::Process;
  605.                         use Win32;
  606.                         Win32::Process::Create($ProcessObj, $mail_prog, "$mail_prog $tempfile $stuff", 0, DETACHED_PROCESS, $cwd) || &error_message("Windows Process Creation Error", Win32::FormatMessage(Win32::GetLastError()));
  607.                         $ProcessObj->Wait(INFINITE);
  608.                     ';
  609.                 } else {
  610.                     system("$command_line", "$tempfile", "$stuff");
  611.                 }
  612.                 unlink ($tempfile);
  613.             }
  614.         }    
  615.     }
  616. }
  617.  
  618.  
  619. #---SEPARATOR---#
  620.  
  621. sub change_announce_message {
  622.     local ($file, $source, $formatted) = @_;
  623.     local (@file, $messageflag, $line, $source_esc, $topic, $page);
  624.     if ($file =~ m|/(\d+)/(\d+)\.$ext|) {
  625.         ($topic, $page) = ($1, $2);
  626.     } else {
  627.         &error_message("Change Announcement Error", "Could not open requested file", 0, 1);
  628.     }
  629.     &lock("$message_dir/$topic/$page.$ext");
  630.     local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic, $page);
  631.     &set_page($topic, $page, $head, $color, $lm, $formatted, &escape($source), $sublist, $about, $about_src, $message, $message_src);
  632.     &unlock("$message_dir/$topic/$page.$ext");
  633. }
  634.  
  635. #---SEPARATOR---#
  636.  
  637. sub manage_images {
  638.     local ($source_in, $topic_number, $queue, $action) = @_;
  639.     local (@file);
  640.     while ($source_in =~ m|\\image_alreadyuploaded\{(\d+)|) {
  641.         push (@file, "$1.gif");
  642.         $source_in = join("", $`, $');
  643.     }
  644.     while ($source_in =~ m|\\jpeg_alreadyuploaded\{(\d+)|) {
  645.         push (@file, "$1.jpg");
  646.         $source_in = join("", $`, $');
  647.     }
  648.     if ($queue != 0) {
  649.         $dir = "";
  650.     } else {
  651.         if (-e "$message_dir/$topic_number") {
  652.             $dir = "$message_dir/$topic_number";
  653.         } else {
  654.             $dir = "$secdir/$topic_number";
  655.         }
  656.     }
  657.     if ($action eq "delete") {
  658.         foreach $line (@file) {
  659.             (unlink("$dir/$line"));
  660.         }
  661.     } elsif ($action eq "list") {
  662.         foreach $line (@file) {
  663.             $line = "$dir/$line";
  664.         }
  665.         return @file;
  666.     }
  667. }
  668.  
  669. #---SEPARATOR---#
  670. #REQ:webtags
  671.  
  672. sub reapply_webtags {
  673.     local ($text, $message) = @_;
  674.     local (%source);
  675.     $flag = 0;
  676.     @lines = split(/\n/, $text);
  677.     foreach $line (@lines) {
  678.         if ($line =~ m|<!-Source: (\d+)-!>|) {
  679.             $flag = $1;
  680.         } elsif ($line =~ m|<!-/Source: $flag-!>|) {
  681.             $flag = 0;
  682.         } elsif ($flag) {
  683.             $source{$flag} .= $line;
  684.         }
  685.     }
  686.     foreach $key (keys(%source)) {
  687.         $u = &unescape($source{$key});
  688.         if ($u =~ m|\\image_alreadyuploaded| || $u =~ m|\\jpeg_alreadyuploaded| || $u =~ m|attachment_alreadyuploaded|) {
  689.             ($lint, $message_var_replace) = &webtags($u, 0, 1);
  690.             @lines = split(/\n/, $message);
  691.             $ctr = 0; $flag = 0;
  692.             foreach $line (@lines) {
  693.                 $ctr += 1;
  694.                 if ($line =~ m|<!-/Post: $key-!>|) {
  695.                     $flag = ($ctr - 1);
  696.                     last;
  697.                 }
  698.             }
  699.             if ($flag) {
  700.                 $lines[$flag-1] = $message_var_replace;
  701.             }
  702.             $message = join("\n", @lines);
  703.         }
  704.     }
  705.     return $message;
  706. }
  707.  
  708. #---SEPARATOR---#
  709. #REQ:printuntil
  710.  
  711. sub profile_editor_screen {
  712.     local ($file, $username, $group, $username_editing, $action_url, $action, $editflag) = @_;
  713.     $file =~ tr/A-Z/a-z/;
  714.     $IS_MODERATOR = 0;
  715.     open (FILE, "$admin_dir/$file.txt"); @file = <FILE>; close (FILE);
  716.     if ($file eq "passwd") {
  717.         ($uline) = grep(/^$username:/, @file);
  718.         $IS_MODERATOR = 1;
  719.     } else {    
  720.         @u = grep(/^$username:/, @file);
  721.         ($uline) = grep(/:$group\s*$/, @u);
  722.     }
  723.     chop ($uline) if $uline =~ m|\n$|;
  724.     if ($uline eq "") {    
  725.         &error_message("Edit Profile Error", "Could not find entry for $username in file $file!");
  726.     }
  727.     ($username, $password, $email, $fullname, $editing, $email_notify, $lastcheck, $group) = split(/:/, $uline);
  728.     @emt = split(/,/, $email_notify);
  729.     foreach $l (@emt) {
  730.         if ($l =~ m|^(\d+)/|) {
  731.             $l = $1;
  732.         }
  733.     }
  734.     &header;
  735.     &printuntil(1, 1, 0, $L{PROFEDIT_TITLE});
  736.     print "<FONT SIZE=3><CENTER><B>$L{PROFEDIT_TITLE}";
  737.     print ": \u$username" if $editing;
  738.     print "</B></CENTER></FONT>\n";
  739.     print "<HR>\n";
  740.     if ($editflag == 1) {
  741.         print "<B><A HREF=\"$cgiurlm?username=$username_editing&cmd=user_mgr\" ";
  742.         print "onMouseOver=\"return setStatus('Return to User Manager group selection screen')\">";
  743.         print "User Manager</A>:\n";
  744.         print "<A HREF=\"$cgiurlm?username=$username_editing&cmd=user_mgr_2&group=$group\" ";
  745.         print "onMouseOver=\"return setStatus('Return to editing users in \u$group')\">";
  746.         print "Edit \u$group</A>:\n";
  747.         print "Edit \u$username</B><HR>\n";
  748.     } elsif ($editflag == 2) {
  749.         print "<B><A HREF=\"$cgiurlm?username=$username_editing&cmd=moderator_mgr\" ";
  750.         print "onMouseOver=\"return setStatus('Return to Moderator Manager')\">";
  751.         print "Moderator Manager</A>:\n";
  752.         print "Edit \u$username</B><HR>\n";
  753.     }
  754.     print "<H4>$L{PROFEDIT_INFO}</H4>\n";
  755.     print "<FORM ACTION=$action_url METHOD=POST>\n";
  756.     print "<INPUT TYPE=HIDDEN NAME=action VALUE=$action>\n";
  757.     print "<INPUT TYPE=HIDDEN NAME=action2 VALUE=infosave>\n";
  758.     print "<INPUT TYPE=HIDDEN NAME=username VALUE=$username_editing>\n";
  759.     print "<INPUT TYPE=HIDDEN NAME=username_edit VALUE=$username>\n";
  760.     print "<INPUT TYPE=HIDDEN NAME=group VALUE=$group>\n";
  761.     print "<INPUT TYPE=HIDDEN NAME=password VALUE=\"$FORM{'password'}\">\n";
  762.     print "<TABLE WIDTH=100% BORDER=1><TR><TD>\n";
  763.     print "<TABLE>\n";
  764.     print "<TR><TD>$fs<B>$L{PROFEDIT_YOURUSERNAME}</B></FONT><TD><TD>$fs<B>\u$username</B></FONT></TD></TR>\n";
  765.     print "<TR><TD>$fs<B>$L{PROFEDIT_YOURFULLNAME}</B></FONT><TD><TD><INPUT TYPE=TEXT NAME=profile_fullname SIZE=35 VALUE=\"$fullname\" MAXLENGTH=40></TD></TR>\n";
  766.     print "<TR><TD>$fs<B>$L{PROFEDIT_YOUREMAIL}</B></FONT><TD><TD><INPUT TYPE=TEXT NAME=profile_email SIZE=35 VALUE=\"$email\" MAXLENGTH=40></TD></TR>\n";
  767.     print "</TABLE><P>$fs<INPUT TYPE=SUBMIT VALUE=\"$L{PROFEDIT_SAVEINFO}\"></FONT>\n";
  768.     print "</TD></TR></TABLE></FORM>\n";
  769.     if ($GLOBAL_OPTIONS{'email'}) {
  770.         print "<HR>\n";
  771.         print "<H4>$L{PROFEDIT_EMAILNOTIFY}</H4>\n";
  772.         print "<FORM ACTION=$action_url METHOD=POST>\n";
  773.         print "<INPUT TYPE=HIDDEN NAME=username VALUE=$username_editing>\n";
  774.         print "<INPUT TYPE=HIDDEN NAME=username_edit VALUE=$username>\n";
  775.         print "<INPUT TYPE=HIDDEN NAME=action VALUE=$action>\n";
  776.         print "<INPUT TYPE=HIDDEN NAME=action2 VALUE=notifysave>\n";
  777.         print "<INPUT TYPE=HIDDEN NAME=group VALUE=$group>\n";
  778.         print "<INPUT TYPE=HIDDEN NAME=password VALUE=\"$FORM{'password'}\">\n";
  779.         print "<TABLE WIDTH=100% BORDER=1><TR><TD>$fs\n";
  780.         print "$L{PROFEDIT_CHOOSETOPICS}\n<P><UL>";
  781.         open (TOP, "$message_dir/board-topics.html"); @top = <TOP>; close (TOP);
  782.         @topics = grep(/^<!-Top:/, @top);
  783.         foreach $t (@topics) {
  784.             if ($t =~ m|<!-Top: (\d+)-!>|) {
  785.                 $o = $1;
  786.                 &extract("//$o/$o.$ext");
  787.                 print "<INPUT TYPE=CHECKBOX NAME=notify_$o VALUE=1";
  788.                 print " CHECKED" if grep(/^$o$/, @emt);
  789.                 print "> $topic_name<BR>\n";
  790.             }
  791.         }
  792.         print "</UL><P>$L{PROFEDIT_MYPOSTS}\n<P><UL>\n";
  793.         print "<INPUT TYPE=CHECKBOX NAME=notify_0 VALUE=1";
  794.         print " CHECKED" if grep(/^0$/, @emt);
  795.         print "> $L{PROFEDIT_MYPOSTSBOX}<P></UL>\n";
  796.         print "<P><INPUT TYPE=SUBMIT VALUE=\"$L{PROFEDIT_SAVEINFO}\"></FONT></TD></TR></TABLE></FORM>\n";
  797.     }
  798.     if ($GLOBAL_OPTIONS{'pwchange'} ne "0" || $editflag || $IS_MODERATOR) {
  799.         print "<HR>\n";
  800.         print "<H4>$L{PROFEDIT_CHANGEPASSWORD}</H4>\n";
  801.         print "<FORM ACTION=$action_url METHOD=POST>\n";
  802.         print "<INPUT TYPE=HIDDEN NAME=username VALUE=$username_editing>\n";
  803.         print "<INPUT TYPE=HIDDEN NAME=username_edit VALUE=$username>\n";
  804.         print "<INPUT TYPE=HIDDEN NAME=action VALUE=$action>\n";
  805.         print "<INPUT TYPE=HIDDEN NAME=group VALUE=$group>\n";
  806.         print "<INPUT TYPE=HIDDEN NAME=action2 VALUE=changepass>\n";
  807.         print "<INPUT TYPE=HIDDEN NAME=password VALUE=\"$FORM{'password'}\">\n";
  808.         print "<TABLE WIDTH=100% BORDER=1><TR><TD>$fs\n";
  809.         print "$L{PROFEDIT_CHANGEPASSWORD_INSTR}<P>";
  810.         print "<TABLE><TR><TD>$fs<B>$L{PROFEDIT_NEWPASS}</B></FONT></TD><TD><INPUT TYPE=PASSWORD NAME=pass_1 SIZE=15></TD></TR>\n";
  811.         print "<TR><TD>$fs<B>$L{PROFEDIT_VERIFY}</B></FONT></TD><TD><INPUT TYPE=PASSWORD NAME=pass_2 SIZE=15></TD></TR>\n";
  812.         print "</TABLE>\n";
  813.         print "<P><INPUT TYPE=SUBMIT VALUE=\"$L{PROFEDIT_SAVEBUTTON}\">\n";
  814.         print "</TD></TR></TABLE>";
  815.         print "</FORM>\n";
  816.     }
  817.     if ($editflag) {
  818.         print "<HR>\n";
  819.         print "<H4>Editing Privileges</H4>\n";
  820.         print "<FORM ACTION=$action_url METHOD=POST>\n";
  821.         print "<INPUT TYPE=HIDDEN NAME=username VALUE=$username_editing>\n";
  822.         print "<INPUT TYPE=HIDDEN NAME=username_edit VALUE=$username>\n";
  823.         print "<INPUT TYPE=HIDDEN NAME=action VALUE=$action>\n";
  824.         print "<INPUT TYPE=HIDDEN NAME=action2 VALUE=editpriv>\n";
  825.         print "<INPUT TYPE=HIDDEN NAME=group VALUE=$group>\n";
  826.         print "<TABLE WIDTH=100% BORDER=1><TR><TD>$fs\n";
  827.         print "Choose whether this person is able to edit his or her own profile.<P>\n";
  828.         print "<UL>\n";
  829.         print "<INPUT TYPE=RADIO NAME=editing VALUE=1";
  830.         print " CHECKED" if $editing == 1;
  831.         print "> Editing is <FONT COLOR=00aa00><B>enabled</B></FONT><BR>\n";
  832.         print "<INPUT TYPE=RADIO NAME=editing VALUE=0";
  833.         print " CHECKED" if $editing == 0;
  834.         print "> Editing is <FONT COLOR=ff0000><B>disabled</B></FONT><BR>\n";
  835.         print "</UL><P>\n";
  836.         print "<INPUT TYPE=SUBMIT VALUE=\"Save Editing Setting\">\n";    
  837.         print "</TD></TR></TABLE></FORM>\n";
  838.     }
  839.     &ex('printuntil', 3, 17, 0, "", 0, 1);
  840.     exit(0);
  841. }
  842.  
  843. #---SEPARATOR---#
  844.  
  845. sub verify_owner {
  846.     local ($owner, $username) = @_;
  847.     $username =~ tr/A-Z/a-z/;
  848.     local (@group_data, $group, $usernames, @username, $groupname);
  849.     open (GROUP, "$admin_dir/groups.txt") || &error_message("File Error", "Cannot open group file (groups.txt)!");
  850.     @group_data = <GROUP>;
  851.     close (GROUP);
  852.     foreach $group (@group_data) {
  853.         chop ($group) if $group =~ /\n$/;
  854.         ($groupname, $usernames) = split(/:/, $group);
  855.         if ($groupname eq $owner) {
  856.             @username = split(/,/, $usernames);
  857.             if (grep (/^$username$/, @username)) {
  858.                 return 1;
  859.             } else {
  860.                 return 0;
  861.             }
  862.         }
  863.     }
  864.     return 0;
  865. }
  866.  
  867. #---SEPARATOR---#
  868.  
  869. sub profanity_editor {
  870.     &header;
  871.     print "<HTML><HEAD><TITLE>Profanity List Editor</TITLE>\n";
  872.     print '<BODY BGCOLOR="ffffff" TEXT="000000" LINK="0000FF" VLINK="0000FF" ';
  873.     print "onLoad=\"window.defaultStatus = 'Profanity List Editor'\">$fs\n";
  874.     print "<FONT SIZE=3><CENTER><B>Profanity List Editor</B></CENTER></FONT>\n";
  875.     print "<HR>\n";
  876.     print "<B><A HREF=\"$cgiurlm?cmd=options_mgr&username=$superuser\" onMouseOver=\"";
  877.     print "window.status = 'Return to the Options Manager'; return true\">Options Manager";
  878.     print "</A>: Profanity List Editor</B>\n<HR>\n";    
  879.     print "<FORM ACTION=$cgiurl METHOD=POST>\n";
  880.     print "<INPUT NAME=action TYPE=HIDDEN VALUE=cuss_save>\n";
  881.     print "<INPUT NAME=username TYPE=HIDDEN VALUE=$superuser>\n";
  882.     print "<TABLE BGCOLOR=#ffffcc BORDER=1 WIDTH=100%><TR><TD>$fs";
  883.     print "Using the box below, enter profanity/cuss words that are to be blocked out.\n";
  884.     print "<B>Enter one word per line</B>.<P>\n";
  885.     print "<TEXTAREA NAME=cusswords COLS=20 ROWS=6>";
  886.     open (CUSS, "$admin_dir/cuss.txt"); @cuss = <CUSS>; close (CUSS);
  887.     undef @word;
  888.     foreach $line (@cuss) {
  889.         if ($line =~ m|^!(.*)|) {
  890.             $word = $1;
  891.             $word =~ tr/a-zA-Z/b-zaB-ZA/;
  892.             push (@word, $word);
  893.         }
  894.     }
  895.     foreach $line (sort(@word)) {
  896.         print "$line\n";
  897.     }
  898.     print "</TEXTAREA><P>\n";
  899.     print "$fs<INPUT TYPE=SUBMIT VALUE=\"Save List\"></TD></TR></TABLE>\n";
  900.     print "</FORM></BODY></HTML>\n";
  901.     exit(0);
  902. }
  903.  
  904. #---SEPARATOR---#
  905.  
  906. sub cuss_save {
  907.     local ($words) = @_;
  908.     &lock("$admin_dir/cuss.txt");
  909.     @words = split(/\n/, $words);
  910.     @words = grep(/\S/, @words);
  911.     undef @cuss;
  912.     foreach $word (@words) {
  913.         $word =~ tr/b-zaB-ZA/a-zA-Z/;
  914.         $word =~ s/^\s+//; $word =~ s/\s+$//;
  915.         push (@cuss, "!$word\n");
  916.     }
  917.     open (CUSS, ">$admin_dir/cuss.txt"); print CUSS @cuss; close (CUSS);
  918.     &unlock("$admin_dir/cuss.txt");
  919. }