home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / adm-appr.pl < prev    next >
Text File  |  2009-11-06  |  25KB  |  694 lines
  1. # FILE: adm-appr.pl
  2. # DESCRIPTION: Appearance Manager Interfaces
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### APPEAR_admin
  20. ###
  21. ### Run the Appearance Manager
  22. ###
  23.  
  24. sub APPEAR_admin {
  25.     my ($FORMref) = @_;
  26.     my $subst = {};
  27.     my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  28.     bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  29.     bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  30.     $subst->{'general'}->{'username'} = $result->[0]->{'user'};
  31.     appear_mgr($FORMref, $result, $subst) if $FORMref->{action} eq "appear_mgr";
  32.     appear_select_skin($FORMref, $result) if $FORMref->{action} eq "appear_skinsel";
  33.     appear_preview_skin($FORMref, $result) if $FORMref->{action} eq "appear_prevskin";
  34.     appear_file_editor($FORMref, $result) if $FORMref->{action} eq "appear_ted";
  35.     appear_skin_editor($FORMref, $result) if $FORMref->{action} eq "appear_sked";
  36.     appear_file_validator($FORMref, $result) if $FORMref->{action} eq "appear_val";
  37.     appear_receive_direct_upload($FORMref, $result) if $FORMref->{action} eq "appear_skinupload";
  38.     if ($FORMref->{action} eq "appear_saveskin") {
  39.         appear_save_skin($FORMref);
  40.         $FORMref->{menu} = 5;
  41.         $subst->{stuff}->{regen_recommended} = 1;
  42.     }
  43.     if ($FORMref->{action} eq "appear_bigtitle") {
  44.         dreq("webtags");
  45.         my ($messages, $formatted) = webtags($FORMref->{msg}, 1, 1, 1, 1);
  46.         error_message(read_language()->{FORMATTINGERROR}, $formatted, 0, 1) if $messages eq "!Error";
  47.         dreq("adm-opts");
  48.         options_save({ title_words => $formatted});
  49.         $FORMref->{menu} = 0;
  50.     }
  51.     if ($FORMref->{action} eq "appear_regen") {
  52.         $FORMref->{menu} = 5;
  53.         if ($FORMref->{topic} eq "TPC") {
  54.             dreq("topic-pg");
  55.             regenerate_topic_page();
  56.         } else {
  57.             dreq("fcn-regn");
  58.             my $u = REGEN_admin($FORMref);
  59.             $subst->{stuff}->{regen_taskman} = $u * $GLOBAL_OPTIONS->{discus_taskman} * $GLOBAL_OPTIONS->{taskman_regen};
  60.         }
  61.     }
  62.     if ($FORMref->{action} eq "appear_altcolors") {
  63.         my $ar1 = {};
  64.         for (my $i = 1; $i <= 20; $i++) { ## ALT_COLOR_MAX
  65.             $ar1->{"alt_color_$i"} = trim($FORMref->{"alt_color_$i"});
  66.         }
  67.         dreq("adm-opts");
  68.         options_save($ar1);
  69.         $FORMref->{'menu'} = 5;
  70.         $subst->{stuff}->{regen_recommended} = 1;
  71.     }
  72.     if ($FORMref->{'action'} eq "appear_savecolors") {
  73.         my $ar1 = {};
  74.         foreach my $key ('bgcolor', 'text', 'link', 'alink', 'vlink', 'image', 'face', 'size', 'image') {
  75.             $ar1->{"COLOR_$key"} = trim($FORMref->{$key});
  76.         }
  77.         dreq("adm-opts");
  78.         options_save($ar1);
  79.         $FORMref->{'menu'} = 5;
  80.         $subst->{stuff}->{regen_recommended} = 1;
  81.     }
  82.     if ($FORMref->{'action'} eq "appear_colors") {
  83.         foreach my $key ('bgcolor', 'text', 'link', 'alink', 'vlink', 'image', 'face', 'size', 'image') {
  84.             $subst->{'color'}->{$key} = trim($FORMref->{$key});
  85.         }
  86.         $subst->{'color_override'} = 1;
  87.         $subst->{'FORMref'} = $FORMref;
  88.         screen_out("chbrdclr", $subst);
  89.     }
  90.     if ($FORMref->{'action'} eq "appear_interface") {
  91.         dreq("adm-opts");
  92.         my $v = $FORMref->{ui_topics_from} == 0 ? 0 : 1;
  93.         options_save( { use_static_ui_documents => 0, use_static_topic_document => $v });
  94.         $subst->{stuff}->{saved} = 1;
  95.     }
  96.     if ($FORMref->{'action'} eq "appear_frames") {
  97.         dreq("adm-opts");
  98.         my $u = ( $FORMref->{ui_from} == 0 ? 0 : 1 );
  99.         my $o = $GLOBAL_OPTIONS->{use_no_frames};
  100.         options_save( { use_no_frames => $u });
  101.         $subst->{stuff}->{saved} = 2;
  102.         if ($u != $o) {
  103.             $FORMref->{menu} = 5;
  104.             $subst->{stuff}->{regen_recommended} = 1;
  105.         }
  106.     }
  107.     if ($FORMref->{action} eq "appear_skindel") {
  108.         my $skins = $FORMref->{dels} eq "*" ? $FORMref->{delskin} : $FORMref->{dels};
  109.         my @s = grep { /^[\w\-]+$/ && $_ ne $GLOBAL_OPTIONS->{skinchoice} && -e "$DCONF->{admin_dir}/skins/$_.tmpl" } split(/,/, $skins);
  110.         error_message("Skin Delete Error", "No valid skins were selected for removal", 0, 1) if scalar @s == 0;
  111.         my $ctr = 0;
  112.         foreach my $skindel (@s) {
  113.             my $skin = join("/", $DCONF->{admin_dir}, "skins", "$skindel.tmpl");
  114.             my $icon = join("/", $DCONF->{html_dir}, $DCONF->{icon_dir}, $skindel);
  115.             if (unlink $skin) {
  116.                 if (-e $icon) {
  117.                     if (opendir(ICONDIR, $icon)) {
  118.                         my @fd = map { join("/", $icon, $_) } grep { ! /^\.+$/ } readdir(ICONDIR);
  119.                         closedir(ICONDIR);
  120.                         foreach my $fd (@fd) {
  121.                             unlink $fd || log_error("adm-appr.pl", "APPEAR_admin", "Could not remove icon $fd: $!");;
  122.                         }
  123.                     }
  124.                     rmdir $icon || log_error("adm-appr.pl", "APPEAR_admin", "Could not remove directory $icon: $!");
  125.                 }
  126.                 $ctr++;
  127.             }
  128.         }
  129.         $FORMref->{menu} = 3;
  130.         $subst->{stuff}->{skinsdel} = $ctr;
  131.         appear_mgr($FORMref, $result, $subst);
  132.     }
  133.     if ($FORMref->{'action'} eq "appear_title" || $FORMref->{'action'} eq "appear_main") {
  134.         $subst->{'general'}->{'location'} = 2 if $FORMref->{'action'} eq "appear_title";
  135.         $subst->{'general'}->{'location'} = 3 if $FORMref->{'action'} eq "appear_main";
  136.         dreq("webtags");
  137.         $FORMref->{msg} = $FORMref->{message} if ! defined $FORMref->{msg};
  138.         my ($messages, $formatted) = &webtags($FORMref->{msg}, 1, 1, 1, 1);
  139.         if ($messages eq "!Error") {
  140.             $FORMref->{preview} = 1;
  141.             $subst->{'preview'}->{'error'} = 1;
  142.         }
  143.         if ($FORMref->{preview} == 1 || $subst->{'preview'} == 1) {
  144.             $subst->{'FORMref'} = $FORMref;
  145.             my $input = $FORMref->{msg};
  146.             $input =~ s/&/&/g;
  147.             $input =~ s/</</g;
  148.             $input =~ s/>/>/g;
  149.             $input =~ s/"/"/g;
  150.             $subst->{'general'}->{'source'} = $input;
  151.             $subst->{'general'}->{'message_text'} = $formatted;
  152.             $subst->{'general'}->{'hr'} = $FORMref->{hr};
  153.             $subst->{'general'}->{'cancel'} = "$PARAMS->{cgiurl}?username=$FORMref->{username}&action=appear_mgr&menu=0";
  154.             screen_out("adminmsg", $subst);
  155.         }
  156.         my $param_ref = {};
  157.         $param_ref->{'text'} = $formatted;
  158.         $param_ref->{'hr'} = $FORMref->{hr};
  159.         set_title_message($param_ref) if $FORMref->{'action'} eq "appear_title";
  160.         set_main_message($param_ref) if $FORMref->{'action'} eq "appear_main";
  161.         $FORMref->{'action'} = "appear_mgr";
  162.     }
  163.     appear_mgr($FORMref, $result, $subst);
  164. }
  165.  
  166. ###
  167. ### appear_receive_other_data
  168. ###
  169. ### Parses other data
  170. ###
  171.  
  172. sub appear_receive_other_data {
  173.     my ($data) = @_;
  174.     my @out = ();
  175.     my @fi = split(/&/, $data);
  176.     foreach my $F (@fi) {
  177.         my ($name, $checksum, $data) = split(/=/, $F);
  178.         my $data_orig = $data;
  179.         my $content = "";
  180.         while ($data =~ /^([0-9a-f][0-9a-f])/) {
  181.             $data = $'; $content .= pack("C", hex($1));
  182.         }
  183.         my $checksum2 = unpack("%16C*", $data_orig);
  184.         template_error("Uploaded data file ($name) had wrong checksum!  Try uploading again.", $checksum, $checksum2) if $checksum != $checksum2;
  185.         push @out, { file => $name, checksum => $checksum, data => $content };
  186.     }
  187.     return \@out;
  188. }
  189.  
  190.  
  191. ###
  192. ### appear_receive_direct_upload
  193. ###
  194. ### Receives a skin from the DiscusWare skin gallery
  195. ###
  196.  
  197. sub appear_receive_direct_upload {
  198.     my ($FORMref, $result) = @_;
  199.     $FORMref->{skin} = $` if $FORMref->{skin} =~ /\.tmpl\s*$/;
  200.     error_message("Invalid Skin Name", "Skin name is invalid!  It may contain only alphanumeric characters and '-'.", 0, 1) if $FORMref->{skin} !~ /^[\w\-]+$/;
  201.     my $content = unescape($FORMref->{content});
  202.     if (length $content != $FORMref->{slength}) {
  203.         my $len = length $content;
  204.         template_error("Uploaded skin had the wrong size (received size: $len; expected size: $FORMref->{slength})!  Try uploading again.", 0, 1);
  205.     }
  206.     if (unpack("%16C*", $content) != $FORMref->{checksum}) {
  207.         template_error("Uploaded skin had the wrong checksum!  Try uploading again.", 0, 1);
  208.     }
  209.     my $subst = {};
  210.     my $exist_flag = -e "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl";
  211.     $exist_flag = 0 if $FORMref->{overwrite} == 1;
  212.     if ($FORMref->{confirm} == 1 && ! $exist_flag) {
  213.         if (-e "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl") {
  214.             chmod(oct($DCONF->{perms0666}), "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl");
  215.             if (-w "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl") {
  216.                 my $ic_dir = "$DCONF->{html_dir}/$DCONF->{icon_dir}/$FORMref->{skin}";
  217.                 if (-e $ic_dir) {
  218.                     chmod(oct($DCONF->{perms0777}), $ic_dir);
  219.                     if (opendir(DIR, $ic_dir)) {
  220.                         my @dir = map { join("/", $ic_dir, $_) } grep { ! /^\.+$/ } readdir(DIR);
  221.                         closedir(DIR);
  222.                         foreach my $file (@dir) {
  223.                             if (! unlink($file)) {
  224.                                 log_error("adm-appr.pl", "appear_receive_direct_upload", "Could not remove icon file $file: $!");
  225.                             }
  226.                         }
  227.                     } else {
  228.                         log_error("adm-appr.pl", "appear_receive_direct_upload", "Could not read icon directory: $!");
  229.                     }
  230.                     rmdir($ic_dir) || log_error("adm-appr.pl", "appear_receive_direct_upload", "Could not remove icon directory: $!");
  231.                 }
  232.             }
  233.         }
  234.         if (open (NEWSKIN, "> $DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl")) {
  235.             binmode(NEWSKIN);
  236.             print NEWSKIN $content;
  237.             close (NEWSKIN);
  238.             chmod(oct($DCONF->{perms0666}), "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl");
  239.             if (-s "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl" == length($content)) {
  240.                 $subst->{general}->{completed} = 1;
  241.             } else {
  242.                 $subst->{general}->{error_size} = 1;
  243.                 unlink "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl";
  244.             }
  245.             my $ic_dir = "$DCONF->{html_dir}/$DCONF->{icon_dir}/$FORMref->{skin}";
  246.             if (! -e "$DCONF->{html_dir}/$DCONF->{icon_dir}/$FORMref->{skin}") {
  247.                 mkdir($ic_dir, oct($DCONF->{perms0777}));
  248.                 chmod(oct($DCONF->{perms0777}), $ic_dir);
  249.             }
  250.             my $files = appear_receive_other_data($FORMref->{other_data});
  251.             foreach my $file (@{ $files }) {
  252.                 next if $file->{file} eq "";
  253.                 next if -e "$ic_dir/$file->{file}";
  254.                 open (ICON, "> $ic_dir/$file->{file}");
  255.                 binmode ICON;
  256.                 print ICON $file->{data};
  257.                 close (ICON);
  258.                 chmod(oct($DCONF->{perms0666}), "$ic_dir/$file->{file}");
  259.             }
  260.         } else {
  261.             $subst->{general}->{error_permissions} = 1;
  262.         }
  263.     } elsif (-e "$DCONF->{admin_dir}/skins/$FORMref->{skin}.tmpl") {
  264.         $subst->{general}->{needs_new_filename} = 1;
  265.     }
  266.     $subst->{general}->{skin} = $FORMref->{skin};
  267.     $subst->{general}->{dumpstr} = escape($content);
  268.     $subst->{general}->{checksum} = unpack("%16C*", $content);
  269.     $subst->{general}->{slength} = length($content);
  270.     $subst->{general}->{username} = $result->[0]->{user};
  271.     $subst->{general}->{other_data} = $FORMref->{other_data};
  272.     screen_out("newskin", $subst);
  273. }
  274.  
  275. ###
  276. ### appear_file_validator
  277. ###
  278. ### Validates file to check for proper use of formatting language
  279. ###
  280.  
  281. sub appear_file_validator {
  282.     my ($FORMref, $result) = @_;
  283.     my $filename = $FORMref->{file};
  284.     my $dir = ""; my $file = "";
  285.     if ($filename =~ m%^(\w+)/([\w\-]+)$%) {
  286.         $dir = $1; $file = join(".", $2, "tmpl");
  287.     } elsif ($filename =~ m%^(\w+)/(\w+)/([\w\-]+)$%) {
  288.         $dir = join("/", $1, $2); $file = join(".", $3, "tmpl");
  289.     } else {
  290.         error_message("File Edit Error", "File $filename is not valid!", 0, 1);
  291.     }
  292.     my $path = join("/", $DCONF->{admin_dir}, $dir, $file); $path =~ s%/+%/%g;
  293.     error_message("File Edit Error", "Selected file '$path' does not exist!", 0, 1) if ! -f $path;
  294.     dreq("fcn-val");
  295.     my $subst = template_validator($path);
  296.     screen_out("validate", $subst);
  297. }
  298.  
  299. ###
  300. ### appear_file_editor
  301. ###
  302. ### Handler for editing of files
  303. ###
  304.  
  305. sub appear_file_editor {
  306.     my ($FORMref, $result) = @_;
  307.     my $filename = $FORMref->{file};
  308.     my $dir = ""; my $file = "";
  309.     if ($filename =~ m%^(\w+)/([\w\-]+)$%) {
  310.         $dir = $1; $file = join(".", $2, "tmpl");
  311.     } elsif ($filename =~ m%^(\w+)/(\w+)/([\w\-]+)$%) {
  312.         $dir = join("/", $1, $2); $file = join(".", $3, "tmpl");
  313.     } elsif ($filename =~ m%^([\w\-]+)\.conf$%) {
  314.         $file = join(".", $1, "conf");
  315.     } else {
  316.         error_message("File Edit Error", "File $filename is not valid!", 0, 1);
  317.     }
  318.     my $path = join("/", $DCONF->{admin_dir}, $dir, $file); $path =~ s%/+%/%g;
  319.     error_message("File Edit Error", "Selected file '$path' does not exist!", 0, 1) if ! -f $path;
  320.     my $Z = readfile($path, "appear_file_editor", { zero_ok => 1 });
  321.     my $c = 0;
  322.     my $subst = {};
  323.     if (defined $FORMref->{text}) {
  324.         my $bufile = join("/", $DCONF->{admin_dir}, 'backups', $file);
  325.         $c++ while (-f join(".", $bufile, sprintf("%02d", $c)) && $c <= 1000);
  326.         if (-f join(".", $bufile, sprintf("%02d", $c))) {
  327.             unlink map { join(".", $bufile, sprintf("%02d", $_)) } ( 0 .. 90 );
  328.             $c = 0;
  329.         }
  330.         $bufile .= join("", ".", sprintf("%02d", $c));
  331.         my $k = readfile($path, "appear_file_editor", { no_unlock => 1, zero_ok => 1 });
  332.         writefile($bufile, $k, "appear_file_editor", { zero_ok => 1, no_lock => 1, no_unlock => 1 });
  333.         my @x = map { join("", $_, "\n") } split(/\n/, $FORMref->{text});
  334.         writefile($path, \@x, "appear_file_editor", { zero_ok => 1, no_lock => 1 });
  335.         $subst->{editor}->{source} = $FORMref->{text};
  336.         chmod(oct($DCONF->{perms0666}), $path);
  337.         chmod(oct($DCONF->{perms0666}), $bufile);
  338.         $subst->{general}->{saved} = 1;
  339.     } else {
  340.         $subst->{editor}->{source} = join("", @{$Z});
  341.     }
  342.     $subst->{editor}->{cols} = $GLOBAL_OPTIONS->{'templ_box_cols'} ? $GLOBAL_OPTIONS->{'templ_box_cols'} : 75;
  343.     $subst->{editor}->{rows} = $GLOBAL_OPTIONS->{'templ_box_rows'} ? $GLOBAL_OPTIONS->{'templ_box_rows'} : 20;
  344.     $subst->{general}->{filename} = $file;
  345.     $subst->{general}->{username} = $result->[0]->{user};
  346.     $subst->{general}->{path} = $filename;
  347.     screen_out("fileedit", $subst);
  348. }
  349.  
  350. ###
  351. ### appear_skin_editor
  352. ###
  353. ### Handler for editing of skins
  354. ###
  355.  
  356. sub appear_skin_editor {
  357.     my ($FORMref, $result) = @_;
  358.     my $filename = $FORMref->{file};
  359.     my $dir = ""; my $file = "";
  360.     if ($filename =~ m%^(\w+)/([\w\-]+)$%) {
  361.         $dir = 'skins'; $file = join(".", $2, "tmpl");
  362.     } else {
  363.         error_message("File Edit Error", "File $filename is not valid!", 0, 1);
  364.     }
  365.     my $path = join("/", $DCONF->{admin_dir}, $dir, $file); $path =~ s%/+%/%g;
  366.     error_message("File Edit Error", "Selected file '$path' does not exist!", 0, 1) if ! -f $path;
  367.     my $subst = {};
  368.     if (defined $FORMref->{partid}) {
  369.         my $bufile = join("/", $DCONF->{admin_dir}, 'backups', $file);
  370.         my $c = 0;
  371.         $c++ while (-f join(".", $bufile, sprintf("%02d", $c)) && $c <= 1000);
  372.         if (-f join(".", $bufile, sprintf("%02d", $c))) {
  373.             unlink map { join(".", $bufile, sprintf("%02d", $_)) } ( 0 .. 90 );
  374.             $c = 0;
  375.         }
  376.         $bufile .= join("", ".", sprintf("%02d", $c));
  377.         my $k = readfile($path, "appear_file_editor", { no_unlock => 1, zero_ok => 1 });
  378.         writefile($bufile, $k, "appear_file_editor", { zero_ok => 1, no_lock => 1, no_unlock => 1 });
  379.         my @x = map { join("", "# ", $_, "\n") } ("User-edited skin", scalar localtime(time), $DCONF->{html_url});
  380.         foreach my $party (split(/,/, $FORMref->{partid})) {
  381.             next if $party !~ /\//;
  382.             my ($part, $parthold) = ($`, $');
  383.             push @x, "<#part \"$part\"#>\n";
  384.             push @x, map { join("", $_, "\n") } split(/\n/, $FORMref->{"text$parthold"});
  385.             push @x, "<#/part#>\n";
  386.         }
  387.         push @x, "\n";
  388.         writefile($path, \@x, "appear_file_editor", { zero_ok => 1, no_lock => 1 });
  389.         chmod(oct($DCONF->{perms0666}), $path);
  390.         chmod(oct($DCONF->{perms0666}), $bufile);
  391.         $subst->{general}->{saved} = 1;
  392.     }
  393.     my $Z = readfile($path, "appear_file_editor", { zero_ok => 1 });
  394.     $subst->{parts} = [];
  395.     my $flag = "";
  396.     my @cur = ();
  397.     my $ctr = 0;
  398.     foreach my $line (@{$Z}) {
  399.         if ($line =~ m|^\s*<#\s*part\s*"(.*?)"\s*#>\s*$|) {
  400.             $flag = $1;
  401.         } elsif ($line =~ m|^\s*<#\s*/\s*part\s*#>\s*$|) {
  402.             $ctr++;
  403.             push @{$subst->{parts}}, { parthold => $ctr, part => $flag, source => join("", @cur) };
  404.             $flag = ""; @cur = ();
  405.         } elsif ($flag) {
  406.             push @cur, $line;
  407.         }
  408.     }
  409.     $subst->{editor}->{cols} = $GLOBAL_OPTIONS->{'templ_box_cols'} ? $GLOBAL_OPTIONS->{'templ_box_cols'} : 75;
  410.     $subst->{editor}->{rows} = $GLOBAL_OPTIONS->{'templ_box_rows'} ? $GLOBAL_OPTIONS->{'templ_box_rows'} : 20;
  411.     $subst->{general}->{filename} = $file;
  412.     $subst->{general}->{username} = $result->[0]->{user};
  413.     $subst->{general}->{path} = $filename;
  414.     screen_out("skinedit", $subst);
  415. }
  416.  
  417. ###
  418. ### appear_mgr
  419. ###
  420. ### Generates the appearance manager screen
  421. ###
  422.  
  423. sub appear_mgr {
  424.     my ($FORMref, $result, $subst) = @_;
  425.     $subst->{general}->{menu} = $FORMref->{'menu'};
  426.     $subst->{general}->{url} = "$PARAMS->{cgiurl}?username=$result->[0]->{user}&action=appear_mgr";
  427.     if ($FORMref->{'menu'} == 0) {
  428.         dreq("topic-pg");
  429.         my $toppage = read_topic_page( { lock => 1, unlock => 1 } );
  430.         dreq("webtags");
  431.         $subst->{'texts'}->{'title'} = inverse_webtags($toppage->{titlemsg}->{text}, undef);
  432.         $subst->{'texts'}->{'title_words'} = inverse_webtags($GLOBAL_OPTIONS->{title_words}, undef);
  433.         $subst->{'texts'}->{'main'} = inverse_webtags($toppage->{mainmsg}->{text}, undef);
  434.         $subst->{'hr'}->{'title'} = $toppage->{titlemsg}->{hr};
  435.         $subst->{'hr'}->{'main'} = $toppage->{mainmsg}->{hr};
  436.     }
  437.     if ($FORMref->{menu} == 1) {
  438.         undef $subst->{'altcolor_array'};
  439.         for (my $i = 1; $i <= 20; $i++) {
  440.             undef my $hashref;
  441.             $hashref->{number} = $i;
  442.             $hashref->{color} = $GLOBAL_OPTIONS->{"alt_color_$i"};
  443.             push (@{ $subst->{'altcolor_array'} }, $hashref);
  444.         }
  445.         $subst->{'skin'} = get_skin_info($GLOBAL_OPTIONS->{skinchoice});
  446.     }
  447.     if ($FORMref->{menu} == 3 || $FORMref->{menu} == 4) {
  448.         my $rows = $GLOBAL_OPTIONS->{'templ_box_rows'} ? $GLOBAL_OPTIONS->{'templ_box_rows'} : 20;
  449.         my $cols = $GLOBAL_OPTIONS->{'templ_box_cols'} ? $GLOBAL_OPTIONS->{'templ_box_cols'} : 75;
  450.         $subst->{'general'}->{'width'} = int((600/75)*$cols) + 75;
  451.         $subst->{'general'}->{'height'} = int(16*$rows) + 200;
  452.         my @skin = map { get_skin_info((split(/\./, $_, 2))[0]) } sort { $a cmp $b } @{directory_list("$DCONF->{admin_dir}/skins", '.tmpl$', 1)};
  453.         $subst->{'skin'} = \@skin;
  454.         $subst->{'skin2'} = \@skin;
  455.     }
  456.     if ($FORMref->{menu} == 4) {
  457.         my @tmpl = ();
  458.         push @tmpl, @{directory_list("$DCONF->{admin_dir}/template/custom", '.tmpl')};
  459.         push @tmpl, @{directory_list("$DCONF->{admin_dir}/template/pro", '.tmpl')};
  460.         push @tmpl, @{directory_list("$DCONF->{admin_dir}/template/ui", '.tmpl')};
  461.         push @tmpl, @{directory_list("$DCONF->{admin_dir}/template/admin", '.tmpl')};
  462.         push @tmpl, @{directory_list("$DCONF->{admin_dir}/template/mailmesg", '.tmpl')};
  463.         my %u = undef;
  464.         my @out = ();
  465.         foreach my $file (@tmpl) {
  466.             if ($file =~ m|/(\w+)/([\w\-]+)\.tmpl$|) {
  467.                 my ($path, $file) = ($1, $2);
  468.                 next if $u{$file};
  469.                 $u{$file} = 1;
  470.                 push @out, { dir => $path, file => $file, descr => get_template_info($path, $file) };
  471.             }
  472.         }
  473.         @out = sort { my $j = $a->{dir} cmp $b->{dir}; return $j if $j; return $a->{file} cmp $b->{file} } @out;
  474.         $subst->{templates} = \@out;
  475.     }
  476.     if ($FORMref->{menu} == 5) {
  477.         $subst->{topics} = board_topics();
  478.     }
  479.     screen_out("appr-mgr", $subst);
  480. }
  481.  
  482.  
  483. ###
  484. ### get_template_info
  485. ###
  486. ### Gets information from 'Description' comment in template file
  487. ###
  488.  
  489. sub get_template_info {
  490.     my ($dir, $file) = @_;
  491.     return "" if ! open(FILE, "$DCONF->{admin_dir}/template/$dir/$file.tmpl");
  492.     while (<FILE>) {
  493.         if (m|^\s*#\s*DESCRIPTION:\s*(.*)|) {
  494.             close (FILE);
  495.             return $1;
  496.         }
  497.     }
  498.     close (FILE);
  499.     return "";
  500. }
  501.  
  502. ###
  503. ### appear_select_skin
  504. ###
  505. ### Confirms user's selection of a skin
  506. ###
  507.  
  508. sub appear_select_skin {
  509.     my ($FORMref) = @_;
  510.     my $skinname = $FORMref->{skname};
  511.     error_message("Skin Selection Error", "That skin name is invalid.  Skin file names must contain only alphanumeric characters.", 0, 1) if $skinname !~ m|^[\w\-\.]+$|;
  512.     my $subst = {};
  513.     $subst->{general}->{username} = $FORMref->{username};
  514.     $subst->{skin} = get_skin_info($skinname);
  515.     $subst->{opt} = $subst->{skin}->{opt};
  516.     my @i = ();
  517.     for (my $i = 1; $i <= 20; $i++) { ## ALT_COLOR_MAX
  518.         my $u = {};
  519.         $u->{number} = $i;
  520.         $u->{used_for} = $subst->{skin}->{"_alt_color_$i"};
  521.         $u->{value} = $subst->{opt}->{"alt_color_$i"};
  522.         push @i, $u;
  523.     }
  524.     $subst->{altcols} = \@i;
  525.     if (ref $subst->{skin}->{optf} eq 'HASH') {
  526.         $subst->{skin}->{has_forced_options} = 1;
  527.         my @k = ();
  528.         foreach my $k (keys %{ $subst->{skin}->{optf} }) {
  529.             push @k, { name => $k, value => $subst->{skin}->{optf}->{$k}->{value}, explanation => $subst->{skin}->{optf}->{$k}->{explanation} };
  530.         }
  531.         $subst->{forced} = \@k;
  532.     }
  533.     screen_out("appr-sel", $subst);
  534. }
  535.  
  536. ###
  537. ### appear_save_skin
  538. ###
  539. ### Saves the skin in the options file
  540. ###
  541.  
  542. sub appear_save_skin {
  543.     my ($FORMref) = @_;
  544.     my $skinname = $FORMref->{choice};
  545.     error_message("Skin Selection Error", "That skin name is invalid.  Skin file names must contain only alphanumeric characters.", 0, 1) if $skinname !~ m|^[\w\-\.]+$|;
  546.     dreq("adm-opts");
  547.     my $new_opt = {};
  548.     $new_opt->{skinchoice} = $skinname;
  549.     my $o = get_skin_info($skinname);
  550.     if ($FORMref->{colors}) {
  551.         foreach my $t (keys(%{ $o->{opt} })) {
  552.             $new_opt->{$t} = $o->{opt}->{$t};
  553.         }
  554.     }
  555.     if ($FORMref->{fa} ne "") {
  556.         my %u = map { $_, 1 } split(/,/, $FORMref->{fa});
  557.         foreach my $key (keys %{ $o->{optf} }) {
  558.             $new_opt->{$key} = $o->{optf}->{$key}->{value} if $u{$key};
  559.         }
  560.     }
  561.     options_save($new_opt);
  562. }
  563.  
  564.  
  565. ###
  566. ### appear_preview_skin
  567. ###
  568. ### Preview the appearance of a skin that is not as of yet applied
  569. ###
  570.  
  571. sub appear_preview_skin {
  572.     my ($FORMref) = @_;
  573.     my $sc = $FORMref->{'template'};
  574.     $sc =~ s/[^\w\-]//g;
  575.     $GLOBAL_OPTIONS->{'skinchoice'} = $sc;
  576.     $GLOBAL_OPTIONS->{'tcache'} = 0;
  577.     hash_merge($GLOBAL_OPTIONS, get_skin_info($sc)->{opt}, 1);
  578.     my $s = undef;
  579.     if ($FORMref->{page} =~ m|^(\d+)/(\d+)$|) {
  580.         my $y = GetPage($1, $2);
  581.         $y->{general}->{secure} = 0;
  582.         $y->{general}->{subtopic_raw} = 0;
  583.         $y->{general}->{messages_raw} = 0;
  584.         $y->{sublist} = expand_sublist($y->{sublist}, $1, undef);
  585.         if ($DCONF->{pro}) {
  586.             dreq("authwrap-PRO");
  587.             $y->{messages} = auth_wrap_attachments($y->{messages});
  588.         }
  589.         $s = SetPage($y, { return_val => 1 });
  590.     } elsif ($DCONF->{pro} && $FORMref->{file} =~ m|^(\d+)/([\w\-\.]+)\.(\w+)$|) {
  591.         dreq("authwrap-PRO");
  592.         auth_wrapped_attachment($1, $2, $3, $FORMref->{content});
  593.     } else {
  594.         dreq("topic-pg");
  595.         my $f = read_topic_page();
  596.         $f->{return_val} = 1;
  597.         $s = write_topic_page($f);
  598.     }
  599.     my $murl = quotemeta($DCONF->{message_url});
  600.     my $cgi = quotemeta($DCONF->{cgi_extension});
  601.     my $surl = quotemeta($DCONF->{script_url});
  602.     my $btf = quotemeta($DCONF->{board_topics_file});
  603.     my $ext = quotemeta($DCONF->{ext});
  604.     my $bdauth = quotemeta($DCONF->{authorize_reader});
  605.  
  606.     $s =~ s%$murl/(\d+)/(\d+)\.$ext\??\d*%$DCONF->{script_url}/board-admin\.$DCONF->{cgi_extension}\?action=appear_prevskin&template=$FORMref->{template}&username=$FORMref->{username}&page=$1/$2%g;
  607.     $s =~ s%$murl/$btf%$DCONF->{script_url}/board-admin\.$DCONF->{cgi_extension}\?action=appear_prevskin&template=$FORMref->{template}&username=$FORMref->{username}%g;
  608.     $s =~ s%$bdauth\?file=/(\d+)/(\d+)\.$DCONF->{ext}(&lm=\d+)?%$DCONF->{script_url}/board-admin\.$DCONF->{cgi_extension}\?action=appear_prevskin&template=$FORMref->{template}&username=$FORMref->{username}&page=$1/$2%g;
  609.     $s =~ s%$surl/discus\.$cgi\?pg=topics%$DCONF->{script_url}/board-admin\.$DCONF->{cgi_extension}\?action=appear_prevskin&template=$FORMref->{template}&username=$FORMref->{username}%g;
  610.     $s =~ s%$surl/board-post\.$cgi\??([^"\s]*)%%g;
  611.  
  612.     header();
  613.     print $s;
  614.     program_exit(0);
  615. }
  616.  
  617. ###
  618. ### set_title_message
  619. ###
  620. ### Sets the "title message" on the topics page
  621. ###
  622.  
  623. sub set_title_message {
  624.     my ($param_ref) = @_;
  625.     $param_ref->{message} = "titlemsg";
  626.     return set_topic_message($param_ref);
  627. }
  628.  
  629. ###
  630. ### set_main_message
  631. ###
  632. ### Sets the "main message" on the topics page
  633. ###
  634.  
  635. sub set_main_message {
  636.     my ($param_ref) = @_;
  637.     $param_ref->{message} = "mainmsg";
  638.     return set_topic_message($param_ref);
  639. }
  640.  
  641. ###
  642. ### set_topic_message
  643. ###
  644. ### Sets either the title message or the main message
  645. ###
  646.  
  647. sub set_topic_message {
  648.     my ($param_ref) = @_;
  649.     return 0 if $param_ref->{'message'} eq "";
  650.     dreq("topic-pg");
  651.     my $arg = read_topic_page({ lock => 1});
  652.     $arg->{ $param_ref->{message} }->{text} = $param_ref->{text};
  653.     $arg->{ $param_ref->{message} }->{hr} = ( $param_ref->{hr} == 1 ? 1 : 0 );
  654.     write_topic_page($arg, { unlock => 1 });
  655.     return 1;
  656. }
  657.  
  658. ###
  659. ### get_skin_info
  660. ###
  661. ### Reads parameters from a skin
  662. ###
  663.  
  664. sub get_skin_info {
  665.     my ($tfile) = @_;
  666.     my $file = readfile("$DCONF->{admin_dir}/skins/$tfile.tmpl", "APPEAR_admin", { no_lock => 1, no_unlock => 1 } );
  667.     my $file_as_string = join("", @{$file});
  668.     if ($file_as_string =~ m%\n\s*<#part "info"#>\s+(.*?)\s*\n\s*<#/part#>%is) {
  669.         my @split = split(/\n/, $1);
  670.         my $output = {};
  671.         foreach my $x (@split) {
  672.             next if $x =~ m|^#|;
  673.             next if $x !~ m|\S|;
  674.             $x = $` if $x =~ m|##|;
  675.             my ($name, $text) = split(/\s+/, $x, 2);
  676.             $output->{$name} = $text;
  677.             if ($name =~ m|^\*|) {
  678.                 $output->{opt}->{$'} = $text;
  679.             } elsif ($name =~ m|^setoption_(\w+)|) {
  680.                 $output->{optf}->{$1}->{value} = trim($text);
  681.             } elsif ($name =~ m|^explainoption_(\w+)|) {
  682.                 $output->{optf}->{$1}->{explanation} = trim($text);
  683.             }
  684.         }
  685.         $output->{skinfile} = $tfile;
  686.         $output->{has_color_scheme} = (defined $output->{opt} ? 1 : 0);
  687.         return $output;
  688.     } else {
  689.         error_message("Error Reading Skin File", "Skin file [$tfile] is not valid, as it does not contain an information section.", 0, 1);
  690.     }
  691. }
  692.  
  693. 1;
  694.