Update of /cvs/scoop/scoop/struct
In directory lithium.sabren.com:/tmp/cvs-serv10201/struct
Modified Files:
scoop.sql
Log Message:
Bug 194, radio button rating option.
Worked first try! and radio button rating in dynamic mode is just plain cool.
-janra
Index: scoop.sql
===================================================================
RCS file: /cvs/scoop/scoop/struct/scoop.sql,v
retrieving revision 1.226
retrieving revision 1.227
diff -C2 -d -r1.226 -r1.227
*** scoop.sql 13 Mar 2006 07:49:59 -0000 1.226
--- scoop.sql 5 Apr 2006 05:37:13 -0000 1.227
***************
*** 249,253 ****
/*!40000 ALTER TABLE `box` DISABLE KEYS */;
LOCK TABLES `box` WRITE;
! INSERT INTO `box` VALUES ('cron_edit_queue','','#main sub\r\n\r\n# Get the expire time\r\nmy $expire = $S->{UI}->{VARS}->{queue_edit_max_time};\r\nmy $factors = {\r\n d => \'86400\',\r\n h => \'3600\',\r\n m => \'60\',\r\n s => \'1\'\r\n};\r\n$expire =~ s/([^\\d])$//;\r\nmy $time_sub = $expire * $factors->{$1};\r\n\r\nmy $select = {\r\n DEBUG => 0,\r\n WHAT => \"sid, score, time, displaystatus\",\r\n FROM => \'stories\',\r\n WHERE => \"displaystatus = -3 AND UNIX_TIMESTAMP(NOW()) - UNIX_TIMESTAMP(time) >= $time_sub\",\r\n ORDER_BY => \'time DESC\'\r\n};\r\n\r\nmy ($rv, $sth) = $S->db_select($select);\r\n\r\nmy $sid_move_to_moderate;\r\nwhile (my $story = $sth->fetchrow_hashref()) {\r\n # only move if the time has expired\r\n $sid_move_to_moderate = $story->{sid};\r\n $S->move_story_to_voting($story->{sid});\r\n}\r\n\r\n$sth->finish();\r\n\r\nreturn 1;\r\n','','empty_box',0),('user_box','Login','my $content;\r\nif ($S->{UID} > 0) {\r\n if ($S->have_perm(\'moderate\')) {\r\!
n my ($nstories, $tstories) = $S->_count_new_sub();\r\n my $color = \'\';\r\n my $c_end = \'\';\r\n if ($nstories) {\r\n $color = \'<font color=\"#FF0000\"><b>\';\r\n $c_end = \'</b></font>\';\r\n }\r\n $content = qq|\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/modsub\">Moderate Submissions</a> ($tstories/$color$nstories$c_end new)<BR>|;\r\n }\r\n\r\n if ($S->{TRUSTLEV} == 2 || $S->have_perm(\'super_mojo\')) {\r\n $content .= qq{%%dot%% <a class=\"light\" href=\"%%rootdir%%/search?type=comment;hidden_comments=show\">Review Hidden Comments</a><br />};\r\n }\r\n \r\n my $urlnick = $S->urlify($S->{NICK});\r\n my $diary_link = $S->{UI}->{VARS}->{use_diaries} ? \r\n qq{\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/user/$urlnick/diary\">Your Diary</a><br />\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/submitstory/Diary\">New Diary Entry</a><br /> \r\n } : \'\';\r\n my $upload_link = ($S->{UI}->{VARS}->{allow_up!
loads} && ($S->have_perm(\'upload_user\') || $S->have_perm(\'upload_ad
min\'))) ?\r\n qq{%%dot%% <a class=\"light\" href=\"%%rootdir%%/user/$urlnick/files\">Your Files</a><br />} : \'\';\r\n\r\n my $ad_link = $S->{UI}->{VARS}->{use_ads} ?\r\n qq{\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/user/$urlnick/ads\">Your Advertisements</a><br />\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/submitad\">Submit Ad</a><br />\r\n } : \'\';\r\n\r\n $content .= qq|\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/user/$urlnick\">User Info</a><br />\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/user/$urlnick/comments\">Your Comments</a><br />\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/user/$urlnick/stories\">Your Stories</a><br?>\r\n $diary_link\r\n $ad_link\r\n $upload_link\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/user/$urlnick/prefs\">User Preferences</a><br />\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/my/prefs/Interface\">Display Preferences</a><br />\r\n %%dot%% <a!
class=\"light\" href=\"%%rootdir%%/my/prefs/Comments\">Comment Preferences</a><br />\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/logout\">Logout $S->{NICK}</a><BR>|;\r\n\r\n $title = $S->{NICK};\r\n} else {\r\n $content = $S->{UI}->{BLOCKS}->{login_box};\r\n $content =~ s/%%LOGIN_ERROR%%/$S->{LOGIN_ERROR}/;\r\n}\r\nreturn {content => $content, title => $title };\r\n','the login box','box',0),('hotlist_box','Your Hotlist','if ($S->{HOTLIST} && $#{$S->{HOTLIST}} >= 0) {\r\n my $box_content;\r\n\r\n foreach my $sid (@{$S->{HOTLIST}}) {\r\n my $stories = $S->getstories(\r\n {-type => \'fullstory\',\r\n -sid => $sid});\r\n my $story = $stories->[0];\nnext unless ($story);\n\r\n\r\n my $show = $S->{UI}->{VARS}->{show_new_comments};\r\n my $num_new = $S->new_comments_since_last_seen($sid) if ($show eq \"hotlist\" || $show eq \"all\");\r\n\r\n my $end_s = ($story->{commentcount} == 1) ? \'\' : \'s\';\r\n $box_content .= qq~%%dot%% <A CLASS=\"light\" H!
REF=\"%%rootdir%%/story/$sid\">$story->{title}</a> ($story->{commentco
unt} comment$end_s~;\r\n $box_content .= \", $num_new new\" if defined($num_new);\r\n $box_content .= \")<BR>\";\r\n }\r\n\r\n return unless $box_content;\nmy $title = \"$S->{NICK}\'s Hotlist\";\r\n return {title => $title, content => $box_content };\r\n}\r\n','the hotlist box','box',1),('menu_footer','','my $submit = \'\';\r\nmy $acct = \'\';\r\n\r\nif ( $S->have_perm(\'story_post\') ) {\r\n $submit = \'<A HREF=\"%%rootdir%%/submit\">submit story</A> |\';\r\n}\r\n\r\nif ($S->{UID} < 0) {\r\n $acct = \'<A HREF=\"%%rootdir%%/newuser\">create account</A> |\';\r\n}\r\n\r\nmy $content = qq{\r\n%%norm_font%%\r\n$submit\r\n$acct\r\n<A HREF=\"%%rootdir%%/special/faq\">faq</A> |\r\n<A HREF=\"%%rootdir%%/search\">search</A>\r\n%%norm_font_end%%};\r\n\r\nreturn $content;','Text-mode main menu','blank_box',0),('older_list_box','Front Page','my $section = $S->{CGI}->param(\'section\') || \'front\';\r\nmy $stories = [];\r\n\r\nif ($section eq \'front\') {\r\n $stories = $S->ge!
tstories({-type => \'titlesonly\', -displaystatus => \'0\'});\r\n} elsif ($section eq \'__all__\') {\r\n $stories = $S->getstories({-type => \'titlesonly\', -section => \'!Diary\'});\r\n} else {\r\n $stories = $S->getstories({-type => \'titlesonly\', -section => $section});\r\n}\r\nmy $box_content;\r\n\r\nmy $date = undef;\r\nforeach my $story (@{$stories}) {\r\n if (($story->{ftime} ne $date) || !$date) {\r\n $date = $story->{ftime};\r\n $box_content .= qq|\r\n <P>\r\n <B>$story->{ftime}</B>|;\r\n }\r\n $box_content .= qq|\r\n <BR>%%dot%% <A CLASS=\"light\" HREF=\"%%rootdir%%/story/$story->{sid}\">$story->{title}</A> ($story->{commentcount} comments)|;\r\n \r\n if ($S->have_perm(\'story_list\')) {\r\n $box_content .= qq| [<A CLASS=\"light\" HREF=\"%%rootdir%%/admin/story/$story->{sid}\">edit</A>]|;\r\n }\r\n}\r\n\r\nmy $offset = $S->{UI}->{VARS}->{maxstories} + $#{$stories};\r\nmy $search_url = qq{%%rootdir%%/?op=!
search;offset=$offset};\r\n$search_url .= \';section=\'.$section if ($
section ne \'front\');\r\n\r\n$box_content .= qq|\r\n <P>\r\n <A CLASS=\"light\" HREF=\"$search_url\">Older Stories...</A>\r\n </P>|;\r\nmy $return = {content => \"%%smallfont%%$box_content%%smallfont_end%%\"};\r\nif ($section ne \'front\' && $section ne \'__all__\') {\r\n $return->{title} = $S->{SECTION_DATA}->{$section}->{title};\r\n} elsif ($section eq \'__all__\') {\r\n $return->{title} = \'All Stories\';\r\n}\r\n\r\nreturn $return;','\"Older stories\" list','box',0),('fortune_box','Inspiration','my $content = `/usr/games/fortune -s`;\r\n$content =~ s/\\n\\s+-/%%norm_font_end%%<\\/I><\\/TD><\\/TR><TR><TD ALIGN=\"right\" BGCOLOR=\"%%box_content_bg%%\">%%norm_font%%<I>/g;\r\n\r\nreturn \"%%norm_font%%<I>$content</I>%%end_norm_font%%\";\r\n','Output of the fortune program, for kicks.','box',0),('main_menu','Menu','my $submit = \'\';\r\nmy $acct = \'\';\r\n\r\nif ( $S->have_perm(\'story_post\') ) {\r\n $submit = qq{%%dot%% <A HREF=\"!
%%rootdir%%/submit\">submit story</A><BR>};\r\n}\r\nif ($S->{UID} < 0) {\r\n $acct = \'%%dot%% <A HREF=\"%%rootdir%%/newuser\">create account</A><BR>\';\r\n}\r\n\r\nmy $content = qq{\r\n%%smallfont%%\r\n$submit\r\n$acct\r\n%%dot%% <A HREF=\"%%rootdir%%/special/faq\">faq</A><BR>\r\n%%dot%% <A HREF=\"%%rootdir%%/search\">search</A>\r\n%%smallfont_end%%};\r\n\r\nreturn $content;','The menu block-- variable for perms','box',0),('poll_box','Poll','my $pollqid = shift @ARGS;\r\nmy $preview = 0;\r\n\r\nmy ($pollqid, $action) = $S->get_qid_to_show();\r\n$preview = 1 if ($action eq \'preview\');\r\nreturn \'\' if ($pollqid == 0);\r\n\r\n# if this is an attached poll, don\'t display if the story is hidden, unless\r\n# the current user can view all polls. also make sure the current user has\r\n# permission to view stories in this section\r\nif (my $sid = $S->get_sid_from_qid($pollqid)) {\r\n return \'\'\r\n if (($S->_check_story_mode($sid) == -1) && !$S->have_perm(\'list_polls\'))!
\r\n || (!$S->have_section_perm(\'norm_read_stories\', $S->_get_story
_section($sid)));\r\n}\r\n\r\nmy $poll_hash = $S->get_poll_hash( $pollqid, $action );\r\n\r\n# first get the poll form all set up except for the answers\r\nmy $poll_form = qq|\r\n <!-- begin poll form -->\r\n <FORM ACTION=\"%%rootdir%%/\" METHOD=\"POST\">\r\n <INPUT TYPE=\"hidden\" NAME=\"op\" VALUE=\"view_poll\">\r\n <INPUT TYPE=\"hidden\" NAME=\"qid\" VALUE=\"$poll_hash->{\'qid\'}\">\r\n <INPUT type=\"hidden\" name=\"ispoll\" value=\"1\">|;\r\n\r\n$poll_form .= \"<b>$poll_hash->{\'question\'}</b><br>\";\r\n\r\n# here is where all the answer fields get filled in\r\nmy $answer_array = $S->get_poll_answers($poll_hash->{\'qid\'}, $action);\r\n\r\n# now check if they have already voted or haven\'t logged in\r\nmy $row;\r\nif ( $S->_can_vote($poll_hash->{\'qid\'}) ) {\r\n my $polltype = ($S->_is_poll_multiple_choice($poll_hash->{\'qid\'}) || ($preview && $S->{CGI}->param(\'is_multiple_choice\'))) ? \'checkbox\' : \'radio\';\r\n foreach $row ( @{$answer_array} ) { !
\r\n $poll_form .= qq|\r\n <INPUT TYPE=\"$polltype\" NAME=\"aid\" VALUE=\"$row->{\'aid\'}\"> $row->{\'answer\'}<BR>|;\r\n }\r\n} else {\r\n my $total_votes = $poll_hash->{\'voters\'};\r\n\r\n if($total_votes == 0) {\r\n $total_votes = 1; # so we don\'t get a divide by 0 error\r\n }\r\n\r\n $poll_form .= qq|\r\n <TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0>|;\r\n\r\n foreach $row ( @{$answer_array} ) {\r\n my $percent = int($row->{\'votes\'} / $total_votes * 100);\r\n $poll_form .= qq|\r\n <TR>\r\n <TD valign=\"top\">%%norm_font%%%%dot%%%%norm_font_end%%</TD>\r\n <TD valign=\"top\">%%norm_font%%$row->{\'answer\'}%%norm_font_end%%</TD>\r\n <TD valign=\"top\">%%norm_font%% $percent% %%norm_font_end%%</TD>\r\n </TR>|;\r\n }\r\n $poll_form .= qq|\r\n </TABLE>|;\r\n \r\n}\r\n\r\n# get the # of comments\r\nmy $sid = $S->get_sid_from_qid($poll_hash->{\'qid\'});\r\nmy $comment_num;\r\n$comment_num = $S->poll_comment_num($sid)!
if ($sid);\r\n$comment_num = $S->poll_comment_num($poll_hash->{\'qid\
'}) unless ($sid);\r\n \r\n# only show the vote button if they havn\'t voted\r\nif ( $S->_can_vote($poll_hash->{\'qid\'}) && ! $preview ) {\r\n $poll_form .= qq|<BR><INPUT TYPE=\"submit\" name=\"vote\" VALUE=\"Vote\">|;\r\n}\r\n\r\n\r\n# now finish up the form\r\nmy $op = $S->{CGI}->param(\'op\');\r\nmy $comm_disp = ($op ne \'displaystory\') ? \r\n qq{\r\n <TD>%%norm_font%%Votes: <b>$poll_hash->{\'voters\'}</b>%%norm_font_end%%</TD>\r\n <TD ALIGN=\"center\" WIDTH=15>%%norm_font%%|%%norm_font_end%%</TD>\r\n <TD ALIGN=\"right\">%%norm_font%% Comments: <b>$comment_num</b>%%norm_font_end%%</TD></TR>\r\n } : \r\n qq{\r\n <TD COLSPAN=\"3\" ALIGN=\"center\">%%norm_font%%Votes: <b>$poll_hash->{\'voters\'}</b>%%norm_font_end%%</TD>\r\n };\r\n\r\n$poll_form .= qq{\r\n </FORM>\r\n <!-- end poll form -->\r\n <P>\r\n %%norm_font%%\r\n <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 ALIGN=\"center\">\r\n <TR>\r\n $comm_disp\r\n <TR> };\r\n\r\nif( $preview ) {\r\n $poll_form .= qq{\r\!
n <TD>%%norm_font%%Results%%norm_font_end%%</TD>\r\n <TD ALIGN=\"center\" WIDTH=15>%%norm_font%%|%%norm_font_end%%</TD>\r\n <TD ALIGN=\"right\">%%norm_font%% Other Polls%%norm_font_end%%</TD></TR>\r\n };\r\n\r\n} else {\r\n $poll_form .= qq{\r\n <TD>%%norm_font%%<a href=\"%%rootdir%%/poll/$poll_hash->{\'qid\'}\">Results</a>%%norm_font_end%%</TD>\r\n <TD ALIGN=\"center\" WIDTH=15>%%norm_font%%|%%norm_font_end%%</TD>\r\n <TD ALIGN=\"right\">%%norm_font%% <a href=\"%%rootdir%%/?op=search;type=polls;search=Search\">Other Polls</a>%%norm_font_end%%</TD></TR>\r\n };\r\n}\r\n\r\n$poll_form .= qq{\r\n </TABLE>\r\n %%norm_font_end%%\r\n <!-- end poll content -->};\r\n\r\n## don\'t forget to tell them its a poll preview if it is\r\nif( $preview ) {\r\n $title = \"Poll Preview\";\r\n}\r\n\r\nif ($poll_form) {\r\n return {content => qq{%%norm_font%%$poll_form%%norm_font_end%%}, title => $title};\r\n} else {\r\n return \'\';\r\n}\r\n','Box to display polls.','box',1),('comment_!
controls','Comment Controls','my $op = $S->{CGI}->param(\'op\');\r\nmy
$tool = $S->{CGI}->param(\'tool\');\r\nreturn \'\' unless ($op eq \'displaystory\' || \r\n $op eq \'comments\' ||\r\n $op eq \'view_poll\' ||\r\n $op eq \'poll_vote\' );\r\nreturn \'\' if( $op eq \'comments\' && $tool eq \'post\' );\r\n\r\nmy $sid = $S->{CGI}->param(\'sid\');\r\nmy $pid = $S->{CGI}->param(\'pid\');\r\nmy $cid = $S->{CGI}->param(\'cid\');\r\nmy $qid = $S->{CGI}->param(\'qid\');\r\n\nreturn \'\' unless ($S->{STORIES}->{$sid}->{commentstatus} == 0);\n\r\nreturn \'\' unless( $S->have_section_perm(\'norm_read_comments\',$S->_get_story_section($sid)));\r\n\r\nmy $form_extra;\r\nmy $anchor = qq{#$cid};\r\nif ($cid) {\r\n $form_extra = qq{\r\n <INPUT TYPE=\"hidden\" NAME=\"cid\" VALUE=\"$cid\">};\r\n} elsif ($pid) {\r\n $form_extra = qq{\r\n <INPUT TYPE=\"hidden\" NAME=\"pid\" VALUE=\"$pid\">};\r\n}\r\n\r\nmy $commentmode_select = $S->_comment_mode_select();\r\nmy $comment_order!
_select = $S->_comment_order_select();\r\nmy $comment_rating_select = $S->_comment_rating_select();\r\nmy $rating_choice = $S->_comment_rating_choice();\r\nmy $comment_type_select = $S->_comment_type_select();\r\n\r\nmy $form_op = \'op\';\r\nmy $form_op_value = $op;\r\nmy $id = \'sid\';\r\n\r\nif ( $qid ) {\r\n $form_op = \'op\';\r\n $form_op_value = \'view_poll\';\r\n $id = \'qid\';\r\n $sid = $qid;\r\n}\r\n \r\nmy $comment_sort = qq|\r\n <FORM NAME=\"commentmode\" ACTION=\"%%rootdir%%/$anchor\" METHOD=\"post\">\r\n <INPUT TYPE=\"hidden\" NAME=\"$form_op\" VALUE=\"$form_op_value\">\r\n <INPUT TYPE=\"hidden\" NAME=\"$id\" VALUE=\"$sid\">\r\n $form_extra\r\n <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR=\"%%box_content_bg%%\" align=\"center\">\r\n \r\n <TR>\r\n <TD VALIGN=\"middle\">\r\n %%smallfont%%|;\nif ($comment_type_select) {\n $comment_sort .= qq|\nView:\r\n <SMALL>\r\n $comment_type_select\r\n </SMALL>|;\n}\n$comment_sort .= qq|\r\n Displ!
ay:\r\n <SMALL>\r\n $commentmode_select\r\n </SMALL>\r\n S
ort:\r\n <SMALL>\r\n $comment_rating_select\r\n </SMALL>\r\n <SMALL>\r\n $comment_order_select\r\n </SMALL>\r\n|;\r\n \r\n \r\nif ($S->have_perm( \'comment_rate\' )) {\r\n $comment_sort .= qq|\r\n Rate?\r\n <SMALL>$rating_choice</SMALL>|;\r\n}\r\n\r\n$comment_sort .= qq|\r\n<INPUT TYPE=\"submit\" NAME=\"setcomments\" VALUE=\"Set\">\r\n%%smallfont_end%%\r\n</TD></TR>\r\n</TABLE>\r\n</FORM>|;\r\n\r\n$template =~ s/CELLSPACING=0>/CELLSPACING=0 ALIGN=\"center\">/;\r\n\r\nreturn { content => $comment_sort, template => $template };','Comment display prefs','blank_box',0),('mod_stats','Moderation Stats','my $sid = $ARGS[0];\r\n$sid = $S->{CGI}->param(\'sid\') unless $sid;\r\nreturn unless $sid;\r\n\r\nmy $q_sid = $S->{DBH}->quote($sid);\r\n\r\nmy ($rv, $t_sth) = $S->db_select({\r\n WHAT => \'displaystatus\',\r\n FROM => \'stories\',\r\n WHERE => qq{sid = $q_sid}});\r\n\r\nmy $disp = $t_sth->fetchrow();\r\n\r\nreturn unless ($disp == \'-2\');\r\n\r\nmy ($!
stat, $trash) = $S->_mod_or_show($sid);\r\nreturn \'\' unless ($stat eq \'show\');\r\n\r\nmy ($totalvotes, $score) = $S->_get_total_votes($sid);\r\nmy $sth = $S->_get_story_mods($sid);\r\n\r\nmy $head = $S->{UI}->{BLOCKS}->{moderate_head};\r\n\r\n$head =~ s/%%votes%%/$totalvotes/g;\r\n$head =~ s/%%score%%/$score/g;\r\n\r\nmy ($this_row, $user);\r\n\r\nmy $for = qq{<FORM NAME=\"mod_stat_show\" ACTION=\"%%rootdir%%/\" METHOD=\"get\">\r\n<INPUT TYPE=\"hidden\" NAME=\"op\" VALUE=\"user\">\r\n<INPUT TYPE=\"hidden\" NAME=\"tool\" VALUE=\"info\">};\r\nmy $against = qq{<FORM NAME=\"mod_stat_show\" ACTION=\"%%rootdir%%/\" METHOD=\"get\">\r\n<INPUT TYPE=\"hidden\" NAME=\"op\" VALUE=\"user\">\r\n<INPUT TYPE=\"hidden\" NAME=\"tool\" VALUE=\"info\">};\r\nmy $neutral = qq{<FORM NAME=\"mod_stat_show\" ACTION=\"%%rootdir%%/\" METHOD=\"get\">\r\n<INPUT TYPE=\"hidden\" NAME=\"op\" VALUE=\"user\">\r\n<INPUT TYPE=\"hidden\" NAME=\"tool\" VALUE=\"info\">};\r\n#\'\r\nmy $f = 0;\r\nmy $a = 0;\r\n!
my $n = 0;\r\n\r\n$for .= qq{<small>\r\n <SELECT NAME=\"uid\" SIZE=1>\
r\n <OPTION VALUE=\"\">Voted for: (%%for%%)};\r\n$against .= qq{<small>\r\n <SELECT NAME=\"uid\" SIZE=1>\r\n <OPTION VALUE=\"\">Voted against: (%%against%%)};\r\n$neutral .= qq{<small>\r\n <SELECT NAME=\"uid\" SIZE=1>\r\n <OPTION VALUE=\"\">Didn\'t care: (%%neutral%%)}; \r\n\r\nwhile (my $mod_rec = $sth->fetchrow_hashref) {\r\n my $nick = $S->get_nick($mod_rec->{uid});\r\n $nick =~ s/^(.{0,20})/$1/;\r\n my $link = qq{\r\n <OPTION VALUE=\"$mod_rec->{uid}\">$nick};\r\n if ($mod_rec->{vote} == 1) {\r\n $for .= qq|\r\n $link|;\r\n $f++;\r\n } elsif ($mod_rec->{vote} == 0) {\r\n $neutral .= qq|\r\n $link|;\r\n $n++;\r\n } elsif ($mod_rec->{vote} == -1) {\r\n $against .= qq|\r\n $link|;\r\n $a++;\r\n }\r\n}\r\n$sth->finish;\r\n\r\n$for .= qq{</SELECT> <INPUT TYPE=\"submit\" NAME=\"get\" VALUE=\"Get User Info\"></small></FORM>};\r\n$against .= qq{</SELECT> <INPUT TYPE=\"submit\" NAME=\"get\" VALUE=\"Get User Info\"></small></FORM>};\r\n$neutral .= qq{</SELECT> <INPUT TYPE=!
\"submit\" NAME=\"get\" VALUE=\"Get User Info\"></small></FORM>};\r\n\r\n$for =~ s/%%for%%/$f/;\r\n$against =~ s/%%against%%/$a/;\r\n$neutral =~ s/%%neutral%%/$n/;\r\n\r\nmy $content = $head.\'%%smallfont%%\'.$for.$against.$neutral.\'%%smallfont_end%%\';\r\n\r\nreturn { content => $content };','Show the stats for story mod','box',0),('section_title','null','my $content = \'Latest News\';\r\n\r\nmy $op = $S->{CGI}->param(\'op\');\r\nmy $page_num = $S->cgi->param(\'page\');\r\nmy $page = \'\';\r\nif ($page_num && $page_num != 1) {\r\n $page = \"(page $page_num)\";\r\n}\r\n\r\nif ($op eq \'section\') {\r\n my $section = $S->{CGI}->param(\'section\');\r\n unless($S->have_section_perm(\'hide_read_stories\',$section)) {\r\n $content = $S->{SECTION_DATA}->{$section}->{title} || \'All Stories\';\r\n } else {\r\n $content = \'\';\r\n }\r\n} elsif ($op eq \'tag\') {\r\n my $tag = $S->cgi->param(\'tag\');\r\n $content = ($tag) ? qq{Tag: $tag} : \'\';\r\n}\r\n\r\nreturn {\!
'content\' => \"%%title_font%%$content $page%%title_font_end%%\" };','
Display title of current section','blank_box',0),('show_comment_raters','Others have rated this comment as follows:','my $content = qq{\r\n <table width=\"100%\" border=0 cellpadding=2 cellspacing=0>};\r\n\r\nmy $cid = $S->{CGI}->param(\'cid\');\r\nmy $sid = $S->{CGI}->param(\'sid\');\nmy $archive = $S->_check_archivestatus($sid);\r\n\r\nmy $f_cid = $S->{DBH}->quote($cid);\r\nmy $f_sid = $S->{DBH}->quote($sid);\r\n\r\n#Check for hidden\r\nmy ($rv, $sth) = $S->db_select({\n ARCHIVE => $archive,\r\n WHAT => \'points\',\r\n FROM => \'comments\',\r\n WHERE => qq{sid = $f_sid AND cid = $f_cid}});\r\n\r\nmy $points = $sth->fetchrow();\r\n$sth->finish();\r\n\r\nif (($points < $S->{UI}->{VARS}->{rating_min}) && ($S->{TRUSTLEV} != 2)) {\r\n return \'\';\r\n}\r\n\r\nmy ($rv, $sth) = $S->db_select({\n ARCHIVE => $archive,\r\n WHAT => \'uid, rating\',\r\n FROM => \'commentratings\',\r\n WHERE => qq{sid = $f_sid AND cid = $f_cid}});\r\n\r\nmy $zeros = 0;\r\n\r\nwhile (my $rating = $sth->!
fetchrow_hashref()) {\r\n my $user = $S->user_data($rating->{uid});\r\n \r\n if (($rating->{\'rating\'} < $S->{UI}->{VARS}->{rating_min}) && ($S->{TRUSTLEV} != 2)) {\r\n $zeros++;\r\n } else {\r\n $content .= qq{\r\n <tr>\r\n <td>%%norm_font%%<A HREF=\"%%rootdir%%/user/uid:$rating->{uid}\">$user->{nickname}</A>%%norm_font_end%%</td>\r\n <td>%%norm_font%%$rating->{rating}%%norm_font_end%%</td>\r\n </tr>};\r\n }\r\n}\r\n\r\n$sth->finish();\r\n\r\nif ($zeros) {\r\n my $word = ($zeros == 1) ? \"Rating\" : \"Ratings\";\r\n \r\n $content .= qq{\r\n <tr>\r\n <td colspan=2>%%norm_font%%Zero $word: $zeros%%norm_font_end%%</td>\r\n </tr>};\r\n}\r\n\r\n$content .= qq{\r\n </table>};\r\n\r\nreturn {\'content\' => $content};','Display who rated a comment what','',0),('rdf_feeds','External Feeds','return unless $S->{UI}->{VARS}->{use_rdf_feeds} || $S->have_perm(\'rdf_admin\');\r\n\r\nmy $to_display = {};\r\nif (@ARGS || $S->{CGI}->param(\'rdf\')) {\r\n my $rdf_arg = $S->!
{CGI}->param(\'rdf\');\r\n if ($rdf_arg eq \'all\') {\r\n $to_display
->{\'all\'} = 1;\r\n } else {\r\n @ARGS = split(/,/, $rdf_arg) if $rdf_arg;\r\n foreach (@ARGS) {\r\n $to_display->{$_} = 1;\r\n }\r\n }\r\n}\r\n\r\nmy $content;\r\nmy $channels = $S->rdf_channels();\r\nmy $user_feeds = $S->rdf_get_prefs() unless @ARGS;\r\nmy $item_limit = defined($S->{prefs}->{rdf_max_headlines}) ?\r\n $S->{prefs}->{rdf_max_headlines} :\r\n defined($S->{UI}->{VARS}->{rdf_max_headlines}) ?\r\n $S->{UI}->{VARS}->{rdf_max_headlines} : 15;\r\n\r\nforeach my $c (@{$channels}) {\r\n unless ($to_display->{all} == 1) {\r\n if (@ARGS) {\r\n next unless $to_display->{ $c->{rid} };\r\n } else {\r\n next unless $user_feeds->{ $c->{rid} };\r\n }\r\n }\r\n next unless $c->{title};\r\n unless ($S->have_perm(\'rdf_admin\')) {\r\n next if $c->{submitted} || !$c->{enabled};\r\n }\r\n\r\n if ($S->{UI}->{VARS}->{rdf_use_images} && $c->{image_url}) {\r\n $content .= qq|<a href=\"$c->{image_link}\"><img src=\"$c->{image_url}\" alt=\"$c->{image_title}\" border=\"1\"!
></a><br>\\n|;\r\n } else {\r\n $content .= qq|<b><a class=\"light\" href=\"$c->{link}\">$c->{title}</a></b><br />\\n|;\r\n }\r\n\r\n my $items = $S->rdf_items($c->{rid}, $item_limit);\r\n foreach my $i (@{$items}) {\r\n $content .= qq|%%dot%% <a class=\"light\" href=\"$i->{link}\">$i->{title}</a><br />\\n|;\r\n }\r\n\r\n if ($S->{UI}->{VARS}->{rdf_use_forms} && $c->{form_link}) {\r\n $content .= qq|<form action=\"$c->{form_link}\" method=\"GET\">$c->{form_title}: <input type=\"text\" name=\"$c->{form_name}\"></form><br />\\n|;\r\n }\r\n\r\n $content .= \"<br />\\n\";\r\n}\r\n\r\nif ($content && $S->have_perm(\'submit_rdf\')) {\r\n $content = qq|<a class=\"light\" href=\"%%rootdir%%/submitrdf\">Submit Feed</a><br /><br />\\n| . $content;\r\n}\r\n\r\nreturn $content;\r\n','contains RDF feeds from other sites','box',1),('submit_rdf','Submit Feed','return \"Sorry, you don\'t have permission to submit a feed.\"\r\n\r\nunless $S->have_perm(\'submit_rdf\');\r\n\r\nmy $action =!
$S->{CGI}->param(\'action\') || \'showform\';\r\n\r\nif ($action eq \
'showform\') {\r\n\r\nreturn &disp_form();\r\n\r\n} elsif ($action eq \'save\') {\r\n\r\nmy $url = $S->{CGI}->param(\'url\');\r\n\r\nreturn (\'Please fill in the URL field\') unless $url;\r\n\r\n# check to see if this RDF already exists\r\n\r\nmy $is_dup = 0;\r\n\r\nmy $channels = $S->rdf_channels;\r\n\r\nforeach my $c (@{$channels}) {\r\n\r\n$is_dup = 1 if $c->{rdf_link} eq $url;\r\n\r\n}\r\n\r\nreturn &disp_form(\'That RDF already exists, or has been submitted already.\') if $is_dup;\r\n\r\n\r\n\r\nmy $do_fetch = $S->{UI}->{VARS}->{allow_rdf_fetch} ? 1 : 0;\r\n\r\nmy ($id, $res) = $S->rdf_add_channel($url, $do_fetch, $S->{NICK});\r\n\r\nunless ($res) {\r\n\r\n$S->rdf_remove_channel($id);\r\n\r\nreturn &disp_form(\'Error adding RDF file: $res\');\r\n\r\n}\r\n\r\nmy $fetched_msg = qq|\r\n\r\n%%norm_font%%Your RDF has been fetched. An admin will check it out as soon as possible%%norm_font_end%%|;\r\n\r\nreturn $fetched_msg;\r\n\r\n}\r\n\r\n\r\n\r\nsub disp_form {\r\n\r\nmy $f!
orm = qq|\r\n\r\n%%norm_font%% %%submit_rdf_message%% %%norm_font_end%%\r\n\r\n<p>\r\n\r\n<form action=\"%%rootdir%%/?\" method=\"GET\">\r\n\r\n<input type=\"hidden\" name=\"op\" value=\"submitrdf\">\r\n\r\n<input type=\"hidden\" name=\"action\" value=\"save\">\r\n\r\n<table border=0 cellspacing=0 cellpadding=0>|;\r\n\r\n$form .= qq|\r\n\r\n<tr>\r\n\r\n<td><FONT color=\"#FF0000\">%%norm_font%%$_[0]%%norm_font_end%%</font></td>\r\n\r\n</tr>| if $_[0];\r\n\r\n$form .= qq|\r\n\r\n<tr>\r\n\r\n<td>%%norm_font%%URL of RDF file:%%norm_font_end%% <input type=\"text\" name=\"url\" size=\"50\"></td>\r\n\r\n</tr>\r\n\r\n<tr>\r\n\r\n<td><input type=\"submit\" value=\"Submit\"></td>\r\n\r\n</tr>\r\n\r\n</table>\r\n\r\n</form>\r\n\r\n|;\r\n\r\nreturn $form;\r\n\r\n}\r\n\r\n','Box to do submitrdf op and such.','titled_box',0),('whos_online','Who\'s online','## New Who\'s Online Box\n## Quite a bit of stuff borrowed from the old one.\n\n# return if anonymous for now\nreturn if $S->{UID} ==!
-1;\n\n# The time stuff can be changed to taste\n\n# The query\n\nmy
($rv,$sth) = $S->db_select({\n FROM => \'whos_online\',\n WHAT => \'ip, uid\',\n WHERE => \'last_visit > DATE_SUB(NOW(), INTERVAL 30 MINUTE)\',\n ORDER_BY => \'uid\'\n});\n\nmy %uids;\nmy $total;\nmy $anontotal;\n\nwhile (my $s = $sth->fetchrow_hashref()) {\n if ($s->{\'uid\'} == -1) {\n $anontotal++;\n next;\n }\n $total++;\n $uids{ $s->{\'uid\'} }++;\n}\n\n$sth->finish;\n\nmy @sorted = sort keys %uids;\n\nmy $out;\nmy $hidden;\nforeach (@sorted) {\n if ($S->user_data($_)->{prefs}->{online_cloak} eq \'on\') {\n $hidden++;\n next;\n }\n my $nick = $S->user_data($_)->{nickname};\n $out .= qq~%%dot%% <A HREF=\"%%rootdir%%/user/uid:$_\">$nick</A>~;\n $out .= \" ($uids{$_})\" if $uids{$_} > 1;\n $out .= \"<BR>\\n\";\n}\nif($anontotal){\n my $anon_user_nick = $S->{UI}->{VARS}->{anon_user_nick};\n $out .= \"%%dot%% $anon_user_nick ($anontotal)<BR>\";\n }\nif ($hidden) {\n $out .= qq~%%dot%% Cloaked Users ($hidden)!
<p>~;\n} else {\n $out .= \'<p>\';\n}\n$total = $total + $anontotal;\n$out .= qq~<small>Note: You may cloak yourself from appearing here in your <A HREF=\"%%rootdir%%/my/prefs/Interface\">Display Preferences</A></small>.~;\nreturn {content => $out, title => \"Who\'s Online? ($total)\"};\n','','box',1),('show_ad','Show Advertisement','my $arg0 = $ARGS[0];\r\nmy $arg1 = $ARGS[1];\r\nmy $ad_id;\r\nmy $adhash = {};\r\nmy $content = \'\';\r\n\r\n# if the ad_id is in the url, use the url\r\nif( $arg0 eq \'fromurl\' || $arg0 eq \'allcgi\' ) {\r\n $ad_id = $S->{CGI}->param(\'ad_id\');\r\n\r\n# if they want to see what the fields are...\r\n} elsif( $arg0 eq \'showfields\' ){\r\n\r\n my $ex_ad = $S->get_example_ad($arg1);\r\n return \'\' unless( defined($ex_ad) && (ref($ex_ad) eq \'HASH\') );\r\n\r\n if( exists $S->{UI}->{BLOCKS}->{\"preview_\" . $ex_ad->{ad_tmpl}} ) {\r\n $content = $S->{UI}->{BLOCKS}->{ \"preview_\". $ex_ad->{ad_tmpl} };\r\n } else {\r\n $content = $S->{UI}->{B!
LOCKS}->{ $ex_ad->{ad_tmpl} };\r\n }\r\n\r\n $content =~ s/%%FILE_PATH
%%//g;\r\n $content =~ s/%%TEXT1%%/This is text1/g;\r\n $content =~ s/%%TEXT2%%/This is text2/g;\r\n $content =~ s/%%TITLE%%/This is the title/g;\r\n $content =~ s/%%LINK_URL%%/This is the link url/g;\r\n $content =~ s[%%REDIRECT_URL%%][%%rootdir%%]g;\r\n\r\n return { content => $content };\r\n\r\n# else if ad_id is specified in template, use that\r\n} elsif( $arg0 =~ /\\d/ ) {\r\n $ad_id = $arg0;\r\n}\r\n\r\nunless( defined( $ad_id ) || $arg0 eq \'allcgi\' ) {\r\n return \'\';\r\n}\r\n\r\n# if we need everything from cgi, let get_ad_hash know\r\nmy $source = \'db\';\r\n$source = \'cgi\' if( $arg0 eq \'allcgi\' );\r\n\r\n$adhash = $S->get_ad_hash($ad_id, $source);\r\n\r\nmy $image = $adhash->{ad_file};\r\nmy $subdir = $adhash->{sponsor};\r\n$subdir = \'example\' if( $adhash->{example} == 1 );\r\n\r\nmy $image_path = $subdir . \'/\' . $image;\r\n\r\nif( exists $S->{UI}->{BLOCKS}->{\"preview_\" . $adhash->{ad_tmpl}} ) {\r\n $content = $S->{UI}->{BLOCKS}->{ \"preview_\". $adhas!
h->{ad_tmpl} };\r\n} else {\r\n $content = $S->{UI}->{BLOCKS}->{ $adhash->{ad_tmpl} };\r\n}\r\n\r\n$content =~ s/%%FILE_PATH%%/$image_path/g;\r\n$content =~ s/%%TEXT1%%/$adhash->{ad_text1}/g;\r\n$content =~ s/%%TEXT2%%/$adhash->{ad_text2}/g;\r\n$content =~ s/%%TITLE%%/$adhash->{ad_title}/g;\r\n$content =~ s/%%LINK_URL%%/$adhash->{ad_url}/g;\r\n$content =~ s/%%SID%%/$adhash->{ad_sid}/g;\r\n$content =~ s[%%REDIRECT_URL%%][%%rootdir%%/redirect/$ad_id]g;\r\n\r\nreturn { content => $content };\r\n','Just a simple box that will show the ad specified','box',0),('ad_box','Advertisement','return \'\' if( $S->pref(\'showad\') eq \'off\' );\nreturn \'\' unless( $S->{UI}->{VARS}->{use_ads} );\r\n\r\nmy $adhash = $S->get_next_ad();\r\nreturn \'\' unless( $adhash->{ERROR} != 1 );\r\n\r\nmy $content = $S->{UI}->{BLOCKS}->{$adhash->{ad_tmpl}};\r\n\r\nmy $subdir = ($adhash->{example} == 1) ? \'example\' : $adhash->{sponsor};\nmy $file_path = $subdir . \'/\' . $adhash->{ad_file};\n\n$conten!
t =~ s/%%LINK_URL%%/$adhash->{ad_url}/g;\r\n$content =~ s/%%TITLE%%/$a
dhash->{ad_title}/g;\r\n$content =~ s/%%TEXT1%%/$adhash->{ad_text1}/g;\r\n$content =~ s/%%TEXT2%%/$adhash->{ad_text2}/g;\r\n$content =~ s/%%FILE_PATH%%/$file_path/g;\r\n$content =~ s/%%SID%%/$adhash->{ad_sid}/g;\r\n$content =~ s[%%REDIRECT_URL%%][%%rootdir%%/redirect/$adhash->{ad_id}];\r\n\r\nif( $S->pref(\'ad_open_new_win\') eq \'on\' ) {\r\n $content =~ s/%%TARGET%%/target=\"_blank\"/g;\r\n}\r\n\r\nreturn { content => $content };\r\n','Simple ad box for the side of the page','box',0),('ad_types','Advertisement Type Listing','my $content = $S->make_ad_type_list(\'no_choice\');\r\n\r\nreturn { content => $content };\r\n','Shows a list of all of the advertisement types','blank_box',0),('buyimpressions_box','Purchase Ad Impressions','# This box controls /ads\r\n# -> If no argument is given, assumes the user wants to purchase\r\n# more impressions.\r\n# -> If distribute=1 will bring up ad impression distribution\r\n# page.\r\n\r\nmy $content = \'\';\r\n\r\nmy $distribute = $S-!
>cgi->param(\'distribute\');\r\n\r\nif( $distribute eq \'dist\' ) {\r\n $content = $S->ad_impression_distribute();\r\n}\r\nelse {\r\n $content = $S->purchase_impressions();\r\n}\r\n\r\nreturn { content => $content };\r\n','controls /ads. Displays either a form to distribute impressions between multiple ads, or to just buy impressions directly.','blank_box',0),('ad_story_format','Ad Story formatter','my $ad_id = $ARGS[0];\r\n\r\nmy $content = qq{\r\n%%BOX,show_ad,$ad_id%%\r\n};\r\n\r\nreturn { content => $content };','Use this to format the advertisments in the introtext of their stories.','blank_box',0),('section_title_subsections','null','my $content;\r\nmy $op = $S->{CGI}->param(\'op\');\r\nmy $section = $S->cgi->param(\'section\');\r\n\r\nif( $op eq \'section\' ) {\r\n return unless $S->have_section_perm(\'norm_read_stories\', $section);\n if( $S->{UI}->{VARS}->{enable_subsections} ) {\r\n\r\n my @paths = $S->section_paths($section);\r\n while( my $path = shift(!
@paths) ){\r\n\r\n $path =~ s/\\/?$section$//; # Remove if
Current Section\r\n $path =~ s/([^\\/]+)/<\\/b>%%norm_font_end%%<a href=\"%%rootdir%%\\/section\\/$1\">%%norm_font%%<b>$S->{SECTION_DATA}->{$1}->{title}<\\/b>%%norm_font_end%%<\\/a>%%norm_font%%<b>/g;\r\n $path =~ s/^<\\/b>%%norm_font_end%%//; # Clean Up After Ourselves\r\n $path = ($path) ? \"%%norm_font%%<b>/</b>%%norm_font_end%%$path\" : \'\';\r\n $content .= qq{<a href=\"%%rootdir%%/\">%%norm_font%%<b>Home</b>%%norm_font_end%%</a>$path%%norm_font%%<b>/$S->{SECTION_DATA}->{$section}->{title}</b>%%norm_font_end%%<br>\\n};\r\n }\r\n $content=~s/<\\/br>$//;\r\n } else {\r\n $content = $S->{SECTION_DATA}->{$section}->{title} || \'All Stories\';\r\n $content = \"%%title_font%%$content%%title_font_end%%\";\r\n }\r\n}\r\nelse {\r\n $content = \'%%title_font%%Latest News%%title_font_end%%\';\r\n}\r\n\r\nreturn { content=>$content }\r\n','Display title of current section','blank_box',0),('renewad_box','Renew Advertisement','my $content = \'\';\r!
\nmy $err = \'\';\r\nmy $ad_id = $S->cgi->param(\'ad_id\') || 0;\r\nmy $confirm = $S->cgi->param(\'confirm\') || \'nope\';\r\nmy $purchase = $S->cgi->param(\'purchase\') || \'nope\';\r\nmy $cgi_amount = $S->cgi->param(\'amount\');\r\nmy $confirm_amt = $S->cgi->param(\'confirm_amt\') || \'1.11\'; # 1.11 so that it != $cgi_amount\r\n\r\n# first get the page set up\r\n$content = qq{\r\n<form name=\"buyimpressions\" action=\"%%rootdir%%/renew\" method=\"POST\" enctype=\"multipart/form-data\">\r\n<input type=\"hidden\" name=\"confirm_amt\" value=\"$cgi_amount\" />\r\n<table border=\"0\" cellpadding=\"1\" cellspacing=\"1\" width=\"99%\"> \r\n<tr><td colspan=\"2\" bgcolor=\"%%title_bgcolor%%\">%%title_font%% Renew Advertisement %%title_font_end%%</td></tr>\r\n<tr><td colspan=\"2\"> <input type=\"hidden\" name=\"ad_id\" value=\"$ad_id\"> </td></tr>\r\n};\r\n\r\n###########################################\r\n### Check to make sure they can renew the ad, then renew\r\n### els!
e show error message. SEt up links on user ad list\r\n### make sure
they all direct to the right box\r\n### get cron from rusty to set up to handle renewals right\r\n### make sure db fields are there.\r\n### maybe write some functions to handle renewals\r\n\r\nmy $ad_hash = $S->get_ad_hash($ad_id, \'db\');\r\n\r\n# first make sure they have chosen an ad\r\nunless( $ad_id ) {\r\n $content .= qq{ <tr><td colspan=\"2\">%%norm_font%% %%renew_choose_ad%% %%norm_font_end%%</td></tr>\r\n</table></form>};\r\n return { content => $content };\r\n}\r\n\r\nunless( $ad_hash->{sponsor} eq $S->{UID} ) {\r\n $content .= qq{ <tr><td colspan=\"2\">%%norm_font%% %%renew_ad_no_permission%% %%norm_font_end%%</td></tr>\r\n</table></form>};\r\n return { content => $content };\r\n}\r\n\r\n# check if confirm, and if so, change the action \r\nif( $purchase && $purchase eq \'Purchase\' && ($confirm_amt == $cgi_amount) ) {\r\n warn \"sucessful purchase\" if $DEBUG;\r\n return qq[%%BOX,submit_ad_pay_box,renew,$ad_hash->{ad_id},$confirm_amt%%];\r\n}\r\nelsif( $purchas!
e && $purchase eq \'Purchase\' && ($confirm_amt != $cgi_amount) ) {\r\n # they changed their amount, let them know why they\'re at the same page again.\r\n $err = qq|<font color=\"ff0000\"> You have changed the amount you wanted to purchase, please click Purchase again to purchase the new amount</font>|;\r\n}\r\n\r\n\r\n# if we get here, and they clicked either button, then mark it as confirmed.\r\n# its possible that they changed their amount w/out confirming again.\r\nmy $purchase_button = \'\';\r\nmy $confirmed = 0;\r\nif( ($confirm && $confirm eq \'Confirm\') or ($purchase && $purchase eq \'Purchase\') ) {\r\n $purchase_button = q{<input type=\"submit\" name=\"purchase\" value=\"Purchase\" />};\r\n $confirmed = 1;\r\n}\r\n\r\n# need to check the input a little and generate the amount to populate the form with\r\nmy $ad_type = $S->get_ad_tmpl_info( $ad_hash->{ad_tmpl} );\r\nmy $min_impressions = $ad_type->{min_purchase_size};\r\nmy $cpm = $ad_type->{cpm};\r\nmy $amount !
= \'\';\r\nif( $confirmed && $cgi_amount && $cgi_amount !~ /^\\d+$/ )
{\r\n $err = qq{<font color=\"ff0000\"> \'$cgi_amount\' is not a valid number of ads to purchase, you must purchase at least $min_impressions ad impressions</font>};\r\n $purchase_button = \'\';\r\n}\r\nelsif( $confirmed && $cgi_amount && ($cgi_amount < $min_impressions) ) {\r\n $err = qq{<font color=\"ff0000\"> $cgi_amount is not a valid purchase amount, the minimum amount you may purchase is $min_impressions ad impressions</font>};\r\n $purchase_button = \'\';\r\n}\r\nelsif( $confirmed ) {\r\n $amount = $cgi_amount;\r\n}\r\n\r\nmy $confirm_msg = $S->{UI}->{BLOCKS}->{confirm_ad_renew};\r\n$confirm_msg = \'\' unless $confirmed;\r\n\r\n$content .= qq{\r\n<tr><td colspan=\"2\"> </td></tr>\r\n<tr><td colspan=\"2\"> %%BOX,show_ad,$ad_id%% </td></tr>\r\n<tr><td colspan=\"2\"> %%norm_font%% $err %%norm_font_end%% </td></tr>\r\n<tr><td colspan=\"2\"> %%norm_font%% %%renew_ad_message%% %%norm_font_end%% </td></tr>\r\n<tr><td colspan=\"2\"> </td></tr>\r\n<tr><td align=\!
"left\" valign=\"top\"> %%norm_font%% <b>Order Size:</b> %%norm_font_end%% </td>\r\n<td align=\"left\" valign=\"top\"> %%norm_font%% <input type=\"text\" name=\"amount\" value=\"$amount\" /> %%norm_font_end%%</td>\r\n</tr>\r\n<tr><td colspan=\"2\"> %%norm_font%% <i>Minimum order size is $min_impressions impressions</i> %%norm_font_end%%</td></tr>\r\n<tr><td colspan=\"2\"> %%norm_font%% $confirm_msg %%norm_font_end%% </td></tr>\r\n<tr><td colspan=\"2\"> </td></tr>\r\n<tr><td colspan=\"2\" align=\"center\"> %%norm_font%% <input type=\"submit\" name=\"confirm\" value=\"Confirm\" /> $purchase_button </td></tr>\r\n};\r\n\r\n$content .= q{</table></form>};\r\n\r\n\r\n\r\n\r\nreturn { content => $content };\r\n','A page to let users renew the impressions on their ads.','blank_box',0),('ad_pay_type_select','','my $type = $S->cgi->param(\'type\');\r\nmy $ad_id = $S->cgi->param(\'ad_id\');\r\nmy $renew = $S->cgi->param(\'renew\');\r\nmy $count = $S->cgi->param(\'count\');\r\n\!
r\nunless ($type && $ad_id) {\r\n return \'Error: No payment type or
ad ID.\';\r\n}\r\n\r\nreturn \"%%BOX,ad_pay_cc,$ad_id,$count%%\" if ($type eq \'cc\');\r\nreturn \"%%BOX,ad_pay_paypal,$ad_id,$count%%\" if ($type eq \'paypal\');','Implant the right payment type box','blank_box',0),('ad_pay_cc','','my $ad_id = $ARGS[0];\r\nmy $count = $ARGS[1];\r\nmy $content;\r\n\r\n\r\n# If we\'re ordering, do it now.\r\nif ($S->cgi->param(\'final_pay\')) {\r\n $content .= $S->cc_place_order();\r\n}\r\n\r\n\r\nunless ($content) {\r\n my ($num, $price);\r\n if ($count) {\r\n # Get total price\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'ad_types.cpm\',\r\n FROM => \'ad_info, ad_types\',\r\n WHERE => \"ad_info.ad_id = $ad_id AND ad_info.ad_tmpl = ad_types.type_template\"\r\n });\r\n my ($cpm) = $sth->fetchrow();\r\n $price = ($count/1000) * $cpm;\r\n $num = $count;\r\n } else { \r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'purchase_size,purchase_price\',\r\n FROM => \'ad_info\',\r\n WHERE => \"ad_id=$ad_id\"});\r\n\r\n ($nu!
m, $price) = $sth->fetchrow();\r\n $sth->finish();\r\n }\r\n \r\n $content .= qq{\r\n<b>Your ad:</b><br>\r\n<center>%%BOX,show_ad,$ad_id%%</center>\r\n<p>};\r\n if ($S->cgi->param(\'pay\')) {\r\n $content .= $S->cc_preview_order($price,$num);\r\n }\r\n\r\n my $p_form = $S->cc_make_person_form();\r\n my $c_form = $S->cc_make_card_form();\r\n\r\n $content .= qq{\r\n <p>\r\n Please fill in the payment form below. Required fields are in <font color=\"#ff0000\">red</font>. When you are done, click \"Preview Order\". You will <b>not</b> be billed yet, and you will be able to change what you\'ve entered before confirming the order.\r\n <form name=\"adpay\" ACTION=\"/special/adpay\" METHOD=\"POST\">\r\n <input type=\"hidden\" name=\"ad_id\" value=\"$ad_id\">\r\n <input type=\"hidden\" name=\"type\" value=\"cc\">\r\n <input type=\"hidden\" name=\"count\" value=\"$count\">\r\n <p>\r\n <b>Billing Information:</b>\r\n <p>\r\n $p_form\r\n <p>\r\n <b>Credit/Debit Card Information:</!
b>\r\n <p>\r\n $c_form\r\n <p>\r\n <input type=\"submit\" name=\"pay\"
value=\"Preview Order\">\r\n </form>};\r\n}\r\n#\'\r\nreturn $content;','','blank_box',0),('cc_bill_orders','','my $DEBUG = 0;\r\nmy $err;\r\n\r\nmy ($rv, $sth) = $S->db_select({\r\n WHAT => \'ad_payments.order_id, ad_payments.cost, ad_payments.ad_id\',\r\n FROM => \'ad_payments, ad_info\',\r\n WHERE => \'ad_payments.ad_id = ad_info.ad_id AND \r\n ad_info.paid = 1 AND \r\n ad_info.judged = 1 AND\r\n ad_info.approved = 1 AND \r\n ad_info.active = 0 AND \r\n ad_info.example = 0 AND \r\n ad_info.views_left > 0 AND \r\n ad_payments.pay_type != \\\'paypal\\\' AND\r\n ad_payments.paid IS NULL\'\r\n});\r\n\r\nmy $orders = [];\r\nwhile (my ($order_id, $cost, $ad_id) = $sth->fetchrow()) {\r\n $err .= \"Order: $order_id, Cost: $cost<br>\" if $DEBUG;\r\n push @{$orders}, {\'ad_id\' => $ad_id,\r\n \'orderID\' => $order_id,\r\n \'amount\!
' => $cost};\r\n}\r\n$sth->finish();\r\n\r\nif ($#{$orders} >= 0) { \r\n $err = $S->cc_bill_approved_ads($orders);\r\n}\r\n\r\n\r\nreturn $err;\r\n ','Post-auth CC orders','blank_box',0),('ad_pay_paypal','Pay using paypal','my $ad_id = $ARGS[0];\r\nmy $count = $ARGS[1];\r\nmy $content;\r\nmy $site = $S->{UI}->{VARS}->{site_url}.$S->{UI}->{VARS}->{rootdir};\r\nmy $secure_site = $S->{UI}->{VARS}->{secure_site_url}.$S->{UI}->{VARS}->{rootdir};\r\nmy $business_id = $S->{UI}->{VARS}->{paypal_business_id};\r\n\r\nunless ($ad_id) {\r\n return \"No ad id passed.\";\r\n}\r\n\r\nmy ($num, $price, $item);\r\nif ($count) {\r\n # Get total price\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'ad_types.cpm\',\r\n FROM => \'ad_info, ad_types\',\r\n WHERE => \"ad_info.ad_id = $ad_id AND ad_info.ad_tmpl = ad_types.type_template\"\r\n });\r\n my ($cpm) = $sth->fetchrow();\r\n $price = ($count/1000) * $cpm;\r\n $price = sprintf(\"%1.2f\", $price);\r\n $num = $count;\r\n $item = \!
"Ad Renewal\";\r\n} else {\r\n my ($rv, $sth) = $S->db_select({\r\n
WHAT => \'purchase_size,purchase_price\',\r\n FROM => \'ad_info\',\r\n WHERE => \"ad_id=$ad_id\"});\r\n ($num, $price) = $sth->fetchrow();\r\n $sth->finish();\r\n $item = \"Advertisement\";\r\n}\r\n\r\nmy $finished = $S->cgi->param(\'finished\');\r\nmy $canceled = $S->cgi->param(\'canceled\');\r\n\r\nif ($finished) {\r\n my $content = $S->{UI}->{BLOCKS}->{paypal_finished}; \r\n return $content;\r\n} elsif ($canceled) {\r\n my $content = $S->{UI}->{BLOCKS}->{paypal_canceled};\r\n return $content;\r\n}\r\n\r\nmy $paypal_form = qq{\r\n<form action=\"https://www.paypal.com/cgi-bin/webscr\" method=\"post\">\r\n<input type=\"hidden\" name=\"cmd\" value=\"_xclick\">\r\n<input type=\"hidden\" name=\"business\" value=\"$business_id\">\r\n<input type=\"hidden\" name=\"notify_url\" value=\"$site/special/paypal_confirm\">\r\n<input type=\"hidden\" name=\"item_name\" value=\"$item\">\r\n<input type=\"hidden\" name=\"item_number\" value=\"$ad_id\">\r\n<input type=\"hidden\" name=\"no_!
shipping\" value=\"1\">\r\n<input type=\"hidden\" name=\"return\" value=\"$secure_site/special/adpay?type=paypal;ad_id=$ad_id;finished=1\">\r\n<input type=\"hidden\" name=\"cancel_return\" value=\"$secure_site/special/adpay?type=paypal;ad_id=$ad_id;canceled=1\">\r\n<input type=\"hidden\" name=\"amount\" value=\"$price\">\r\n<input type=\"hidden\" name=\"custom\" value=\"$num\">\r\n<input type=\"image\" src=\"%%imagedir%%/paypal.gif\" border=\"0\" name=\"submit\" alt=\"Make payments with PayPal - it\'s fast, free and secure!\">\r\n</form>};\r\n\r\n$content = qq{\r\n<b>Your ad:</b><br>\r\n<center></center>\r\n<p>\r\nYour purchase details are below. Click the Paypal button, and you will go to a page on Paypal where you will finish the payment process.\r\n<table border=0 cellpadding=1 cellspacing=0 bgcolor=\"#000000\" align=\"center\">\r\n <tr>\r\n <td>\r\n <table width=\"100%\" cellpadding=5 cellspacing=0 border=0 bgcolor=\"#eeeeee\">\r\n <tr>\r\n <td>\r\n <FONT!
FACE=\"verdana, arial, helvetica, sans-serif\" SIZE=\"2\"><b>Impressi
ons:</b></font>\r\n </td>\r\n <td>\r\n <FONT FACE=\"verdana, arial, helvetica, sans-serif\" SIZE=\"2\">$num</font>\r\n </td>\r\n </tr>\r\n <tr>\r\n <td>\r\n <FONT FACE=\"verdana, arial, helvetica, sans-serif\" SIZE=\"2\"><b>Total Price:</b></font>\r\n </td>\r\n <td>\r\n <FONT FACE=\"verdana, arial, helvetica, sans-serif\" SIZE=\"2\">\\$$price</font>\r\n </td>\r\n </tr>\r\n <tr>\r\n <td colspan=2 align=\"center\">\r\n <FONT FACE=\"verdana, arial, helvetica, sans-serif\" SIZE=\"2\">\r\n Click below to purchase.<br>\r\n $paypal_form\r\n </font>\r\n </td>\r\n </tr>\r\n </table>\r\n </td>\r\n </tr>\r\n</table>};\r\n\r\nreturn $content;','','blank_box',0),('paypal_bill_orders','Bill paypal orders','my $DEBUG = 0;\r\nmy $err;\r\n\r\nmy ($rv, $sth) = $S->db_select({\r\n WHAT => \'ad_payments.order_id, ad_payments.cost, ad_payments.ad_id, ad_info.approved\',\r\n FROM => \'ad_payments, ad_info\',\r\n WHERE => \'ad_pay!
ments.ad_id = ad_info.ad_id AND \r\n ad_info.paid = 1 AND \r\n ad_info.judged = 1 AND\r\n ad_info.active = 0 AND \r\n ad_info.example = 0 AND \r\n ad_info.views_left > 0 AND \r\n ad_payments.pay_type = \\\'paypal\\\' AND\r\n ad_payments.paid IS NULL\'\r\n});\r\n\r\nmy @orders;\r\nwhile (my $o = $sth->fetchrow_hashref()) {\r\n push @orders, $o;\r\n}\r\n$sth->finish();\r\n\r\nmy @disapproved_oids;\r\nforeach my $order (@orders) {\r\n my ($paid, $active);\r\n if ($order->{approved} == 0) {\r\n push @disapproved_oids, $order->{order_id};\r\n $paid = 0;\r\n $active = 0;\r\n } else {\r\n $paid = 1;\r\n $active = 1;\r\n }\r\n\r\n my ($rv, $sth) = $S->db_update({\r\n WHAT => \'ad_payments\',\r\n SET => \"paid=$paid, final_date=NOW()\",\r\n WHERE => \"ad_id=$order->{ad_id}\"});\r\n $sth->finish();\r\n \r\n ($rv, $sth) = $S->db_update({\r\n WHAT => \'ad_info\',\r\n SET => \"acti!
ve=$active\",\r\n WHERE => \"ad_id=$order->{ad_id}\"});\r\n $sth->fin
ish();\r\n\r\n if ($active) {\r\n ($rv, $sth) = $S->db_select({\r\n WHAT => \'ad_sid\',\r\n FROM => \'ad_info\',\r\n WHERE => qq{ad_id = $order->{ad_id}}});\r\n my $sid = $sth->fetchrow();\r\n \r\n if ($sid) {\r\n $S->activate_ad_story($sid);\r\n }\r\n }\r\n}\r\n\r\nif ($#disapproved_oids >= 0) {\r\n my $subject = \'Paypal Order Refund Alert\';\r\n my $message = qq{\r\nThe following paypal orders were disapproved and need a refund.\r\n};\r\n \r\n foreach my $oid (@disapproved_oids) {\r\n $message .= qq{\r\nhttps://www.paypal.com/vst/id=$oid};\r\n }\r\n \r\n foreach my $to (split /,/, $S->{UI}->{BLOCKS}->{admin_alert}) {\r\n $S->mail($to, $subject, $message);\r\n }\r\n\r\n}','','blank_box',0),('paypal_confirm','','my $DEBUG = 0;\r\n\r\n\r\nmy $answer = $S->paypal_ipn_confirm();\r\n\r\nif ($answer ne \'VERIFIED\') {\r\n $S->paypal_invalid_mail($answer);\r\n return;\r\n}\r\n\r\nmy $vars = $S->cgi->Vars();\r\n# Check payment status\r\nmy $stat = $vars->{\'paym!
ent_status\'};\r\nreturn unless ($stat =~ /completed/i);\r\n\r\n# Check that it\'s an ad or a renewal. Add in subscription notify later\r\nif ($vars->{item_name} eq \'Advertisement\') {\r\n\r\n $S->paypal_activate_ad($vars);\r\n\r\n} elsif ($vars->{item_name} eq \'Ad Renew\') {\r\n\r\n $S->paypal_do_renewal($vars);\r\n\r\n\n} elsif ($vars->{item_name} eq \'Subscription\') {\n $S->paypal_do_sub($vars);\n} elsif ($vars->{item_name} eq \'Donation\') {\n $S->paypal_do_donate($vars);\n} else {\n warn \"paypal_confirm called with unknown item_name: $vars->{item_name}\\n\";\n}\r\n\r\n\r\nreturn;','','blank_box',0),('logout_box','Logout','$S = $S->reset_user;\r\n\r\nmy $logout_url = $S->{UI}->{VARS}->{logout_url}\r\n || ($S->{UI}->{VARS}->{rootdir} . \'/\');\r\n\r\n$S->{APACHE}->headers_out->{\'Location\'} = \"$logout_url\";\r\n\r\n# the following is probably unessesary, but just in case...\r\nreturn { content => qq{Redirecting to <a href=\"$logout_url\">$logout_url</a>} }\r\n','Th!
is logs a user out. For /logout','blank_box',0),('user_files_list','U
ser Files','return unless ($S->have_perm(\'upload_user\') && $S->{UI}->{VARS}->{allow_uploads});\r\n\r\nmy $uid = $S->{UID};\r\n\r\nmy $content = qq[\r\n <form name=\"insert_file\">\r\n <select name=\"file_link\" size=\"1\">\r\n <option value=\"\">Select File:</option>\r\n];\r\n\r\nmy $file_link = $S->var(\'upload_link_user\') . $uid;\r\nmy ($file_counter, $file_total_count) = (2, 0);\r\n\r\nmy @files = $S->get_file_list($uid, \'user\');\r\n$file_total_count = (scalar @files) - 2;\r\n\r\nwhile ($file_counter < ($file_total_count + 2) ) {\r\n my $file_name = $files[$file_counter];\r\n $content .= qq{<option value=\"<img src=\"$file_link/$file_name\">\">$file_name</option>};\r\n $file_counter++;\r\n}\r\n\r\n$content .= qq[\r\n </select><br />\r\n <input type=\"button\" value=\"<< Intro Text\" onclick=\"document.editstory.introtext.value+=document.insert_file.file_link.value\"><br />\r\n <input type=\"button\" value=\"<< Body Text\" onclick=\"document.editst!
ory.bodytext.value+=document.insert_file.file_link.value\">\r\n </form>\r\n %%norm_font%%<a href=\"/user/uid:$uid/files\">View Your Files</a>%%norm_font_end%%\r\n];\r\n\r\nreturn $content;\r\n','Allows a user to insert a IMG tag pointing at an uploaded file into the introtext or bodytext of a story.','box',0),('theme_chooser','',' ################################################\n# WARNING! This box is called so early in the #\n# setup phase that screwing it up will require #\n# a trip directly to the database. If you do #\n# mess it up, follow the following procedure. #\n# #\n# First, hit the back button so you can read #\n# these instructions. That\'s the only part #\n# you have to memorize. #\n# Second, go into the database and type the #\n# following sql command (it\'s on 2 lines here) #\n# #\n# UPDATE box SET content=\"return \\\"default\\\";!
\" #\n# WHERE boxid=\"theme_chooser\"; #\n#
#\n# Don\'t forget the WHERE clause! #\n# Then, figure out what went wrong, and fix it.#\n# You can save the box and it will overwrite #\n# the simple \'return \"default\";\' box that is #\n# guaranteed to not cause errors. #\n# If you didn\'t fix the problem, return to #\n# step one and try again. #\n# #\n# Please note that you won\'t have to change #\n# this box unless you want to set a theme based#\n# on something other than section, user_agent, #\n# user group, and site_id. That\'s what the site#\n# controls in the category \"Themes\" are for. #\n################################################\n\nmy $default_theme = $S->{UI}->{VARS}->{default_theme};\n\n# first, are we using themes at all:\nunless ( $S->{UI}->{VARS}->{use_themes} ) {\n return $default_theme;\n}\n\n# returns a comma-separated list of themes to be \n# applied, in !
order. Should always start with the \n# default theme.\n \n# set the values of the criteria we\'re testing for\nmy $siteid = $S->{CONFIG}->{site_id};\nmy $agent = $S->run_box(\"detect_agent\");\nmy $group = $S->{GID};\nmy $pref;\nif ( $S->{UI}->{VARS}->{allow_user_themes} ) {\n if ( $S->{prefs}->{theme} ) {\n $pref = $S->{prefs}->{theme};\n } else {\n $pref = \"\";\n }\n}\n\n# section is a bit of a special case\nmy $section;\nif ( $S->param->{\"section\"} ) {\n $section = $S->param->{\"section\"};\n} elsif ( $S->param->{\"sid\"} ) {\n my $sid = $S->param->{\"sid\"};\n my ($rv,$sth) = $S->db_select({\n WHAT => \'section\',\n FROM => \'stories\',\n WHERE => qq at sid = \"$sid\"@,});\n if ( $rv ) {\n my $sect = $sth->fetchrow_hashref();\n $section = $sect->{\"section\"};\n } else {\n $section = \"\";\n }\n $sth->finish;\n}\n\nmy @order = split( /,s*/, $S->{UI}->{VARS}->{order} );\n\nmy $themelist = $default_theme;\n\nforeach my $!
criteria ( @order ) {\n if ( $criteria eq \"section\" ) {\n if ( $s
ection ) {\n my $th=$S->{UI}->{VARS}->{\"section_$section\"};\n $themelist .= \",$th\" if $th;\n }\n } elsif ( $criteria eq \"siteid\" ) {\n my $th = $S->{UI}->{VARS}->{\"siteid_$siteid\"};\n $themelist .= \",$th\" if $th;\n } elsif ( $criteria eq \"group\" ) {\n my $th = $S->{UI}->{VARS}->{\"group_$group\"};\n $themelist .= \",$th\" if $th;\n } elsif ( $criteria eq \"agent\" ) {\n my $th = \"\";\n #FIXME: need to write box detect_agent\n } elsif ( $criteria eq \"pref\" ) {\n my $th = $pref;\n $themelist .= \",$th\" if $th;\n }\n}\n\nreturn $themelist;\n ','chooses which themes should be applied, and in which order. \'default\' should come first, as a complete theme; subsequent themes overwrite any blocks with the same name.','blank_box',0),('detect_agent','','#FIXME: add detection\n\nreturn \"\";','detects user agent, returns a code string.','blank_box',0),('subpay_type_select','Select Payment Type','my $pay_type = $S->cgi->param(\'pay_!
type\');\r\nmy $type = $S->cgi->param(\'type\' );\r\nmy $months = $S->cgi->param(\'months\');\r\n\r\nif ($pay_type) {\r\n return \"%%BOX,subpay_cc,$type,$months%%\" if ($pay_type eq \'cc\');\r\n return \"%%BOX,subpay_paypal,$type,$months%%\" if ($pay_type eq \'paypal\');\r\n if ($pay_type eq \'none\') {\r\n my $return = $S->sub_activate_immediate($type, $months);\r\n return $return if ($return);\r\n }\r\n}\r\n#%%\r\n#warn \"Months: $months\\n\";\r\n\r\nunless ($months && $type) {\r\n return \'Error! No subscription type or duration provided.\';\r\n}\r\n\r\nmy $type_data = $S->sub_get_type($type);\r\n\r\n# Bounds check the period\r\n$months = $type_data->{max_time} if (($type_data->{max_time}) && $months > $type_data->{max_time});\r\n\r\n# If it\'s a free sub, see if they\'ve already had it\r\nif ($S->sub_check_renewable($type_data->{type})) {\r\n return \'Sorry, but you may not renew this subscription.\';\r\n}\r\n\r\nmy ($price, $purchase_display) = $S->sub_calcu!
late_purchase_cost($type, $months);\r\n\r\nmy $content = qq{\r\n<table
width=\"75%\" border=0 cellpadding=5 cellspacing=0 align=\"center\">\r\n <tr>\r\n <td colspan=2>%%norm_font%%\r\n$purchase_display%%norm_font_end%%};\r\n\r\nif ($price eq \'ERROR\') {\r\n $content .= qq{</td></tr></table>};\r\n return $content;\r\n} elsif ($price == 0) {\r\n $content .= qq{\r\n <center>\r\n <form method=\"POST\" action=\"%%rootdir%%\">\r\n <input type=\"hidden\" name=\"op\" value=\"subpay\">\r\n <input type=\"hidden\" name=\"months\" value=\"$months\">\r\n <input type=\"hidden\" name=\"type\" value=\"$type\">\r\n <input type=\"hidden\" name=\"pay_type\" value=\"none\">\r\n <input type=\"submit\" name=\"finish\" value=\"Finish\">\r\n </form></center></td></tr></table>};\r\n return $content;\r\n}\r\n\r\n$content .= qq{%%norm_font%%<p>Ok, now it\'s time for payment. Please select a payment type below.</p>\r\n%%norm_font_end%%</td></tr>\r\n};\n$content .= qq{<tr>\r\n <td align=\"center\">%%norm_font%%<a href=\"/subpay?pay_type=paypal;type=$!
type;months=$months\"><img src=\"%%imagedir%%/paypal.gif\" border=\"0\" alt=\"Pay with Paypal\"><br>Pay with Paypal</a>%%norm_font_end%%</td>} if $S->{UI}->{VARS}->{payment_use_paypal};\n$content .= qq{ <td align=\"center\">%%norm_font%%<a href=\"/subpay?pay_type=cc;type=$type;months=$months\"><img src=\"%%imagedir%%/cclogos.gif\" width=\"87\" height=\"27\" border=0 ALT=\"We accept Visa and MasterCard\"><br>Pay with Visa or Mastercard</a>%%norm_font_end%%</td>} if $S->{UI}->{VARS}->{payment_use_cc};\n$content .= qq{ </tr>\r\n</table>\r\n};\r\n\r\nreturn $content;','Choose the type of payment for a subscription, or, if passed a \"pay_type\" param, just pass through to the appropriate payment processing box.','blank_box',0),('subpay_cc','Pay for Your Subscription','my $content;\r\nmy $type = $ARGS[0];\r\nmy $months = $ARGS[1];\r\n\r\n\r\n# If we\'re ordering, do it now.\r\nif ($S->cgi->param(\'final_pay\')) {\r\n $content .= $S->cc_place_order(\'subscription\');\r\n ret!
urn $content;\r\n}\r\n\r\n\r\nmy $type_data = $S->sub_get_type($type);
\r\n\r\n# Bounds check the period\r\n$months = $type_data->{max_time} \r\n if (($type_data->{max_time}) && $months > $type_data->{max_time});\r\n\r\nmy ($price, $remaining) = $S->sub_calculate_purchase_cost($type, $months);\r\n\r\nmy $content = qq{%%norm_font%%$remaining};\r\n\r\nif ($S->cgi->param(\'pay\')) {\r\n $content .= $S->cc_preview_order($price,$months,\'subscription\');\r\n}\r\n\r\nmy $p_form = $S->cc_make_person_form();\r\nmy $c_form = $S->cc_make_card_form();\r\n\r\n\r\n$content .= qq{\r\n<p>\r\nPlease fill in the payment form below. Required fields are in \r\n<font color=\"#ff0000\">red</font>. When you are done, click \"Preview Order\". \r\nYou will <b>not</b> be billed yet, and you will be able to change what you\'ve \r\nentered before confirming the order.\r\n<form name=\"subpay\" ACTION=\"/subpay\" METHOD=\"POST\">\r\n<input type=\"hidden\" name=\"months\" value=\"$months\">\r\n<input type=\"hidden\" name=\"pay_type\" value=\"cc\">\r\n<input type=\"hid!
den\" name=\"type\" value=\"$type\">\r\n<p>\r\n<b>Billing Information:</b>\r\n<p>\r\n$p_form\r\n<p>\r\n<b>Credit/Debit Card Information:</b>\r\n<p>\r\n$c_form\r\n<p>\r\n<input type=\"submit\" name=\"pay\" value=\"Preview Order\">\r\n</form>%%norm_font_end%%};\r\n\r\n#\'\r\n\r\nreturn $content;\r\n','Purchase a subscription with a credit card','blank_box',0),('subpay_paypal','','my $content;\r\nmy $type = $ARGS[0];\r\nmy $months = $ARGS[1];\r\nmy $site = $S->{UI}->{VARS}->{site_url}.$S->{UI}->{VARS}->{rootdir};\r\nmy $secure_site = $S->{UI}->{VARS}->{secure_site_url}.$S->{UI}->{VARS}->{rootdir};\r\nmy $business_id = $S->{UI}->{VARS}->{paypal_business_id};\r\nmy $item = \'Subscription\';\r\n\r\nmy $type_data = $S->sub_get_type($type);\r\n\r\n# Bounds check the period\r\n$months = $type_data->{max_time} \r\n if (($type_data->{max_time}) && $months > $type_data->{max_time});\r\n\r\nmy ($price, $remaining) = $S->sub_calculate_purchase_cost($type, $months);\r\n\r\nmy $finish!
ed = $S->cgi->param(\'finished\');\r\nmy $canceled = $S->cgi->param(\'
canceled\');\r\n\r\nif ($finished) {\r\n $content = $S->{UI}->{BLOCKS}->{sub_paypal_finished}; \r\n return $content;\r\n} elsif ($canceled) {\r\n $content = $S->{UI}->{BLOCKS}->{sub_paypal_canceled};\r\n return $content;\r\n}\r\n\r\nmy $paypal_form = qq{\r\n<form action=\"https://www.paypal.com/cgi-bin/webscr\" method=\"post\">\r\n<input type=\"hidden\" name=\"cmd\" value=\"_xclick\">\r\n<input type=\"hidden\" name=\"business\" value=\"$business_id\">\r\n<input type=\"hidden\" name=\"notify_url\" value=\"$site/special/paypal_confirm\">\r\n<input type=\"hidden\" name=\"item_name\" value=\"Subscription\">\r\n<input type=\"hidden\" name=\"item_number\" value=\"$type\">\r\n<input type=\"hidden\" name=\"no_shipping\" value=\"1\">\r\n<input type=\"hidden\" name=\"return\" value=\"$secure_site/subpay?pay_type=paypal;type=$type;months=$months;finished=1\">\r\n<input type=\"hidden\" name=\"cancel_return\" value=\"$secure_site/subpay?pay_type=paypal;type=$type;months=$months;canceled=!
1\">\r\n<input type=\"hidden\" name=\"amount\" value=\"$price\">\r\n<input type=\"hidden\" name=\"custom\" value=\"$S->{UID}:$months\">\r\n<input type=\"image\" src=\"%%imagedir%%/paypal.gif\" border=\"0\" name=\"submit\" alt=\"Make payments with PayPal - it\'s fast, free and secure!\">\r\n</form>};\r\n\r\n$content = qq{\r\n%%norm_font%%\r\n$remaining\r\n<p>\r\nClick the Paypal button, and you will go to a page on Paypal where you will finish the payment process.\r\n%%norm_font_end%%\r\n<p>\r\n<table border=0 cellpadding=1 cellspacing=0 bgcolor=\"#000000\" align=\"center\">\r\n <tr>\r\n <td>\r\n <table width=\"100%\" cellpadding=5 cellspacing=0 border=0 bgcolor=\"#eeeeee\">\r\n <tr>\r\n <td colspan=2 align=\"center\">\r\n <FONT FACE=\"verdana, arial, helvetica, sans-serif\" SIZE=\"2\">\r\n Click below to purchase.<br>\r\n $paypal_form\r\n </font>\r\n </td>\r\n </tr>\r\n </table>\r\n </td>\r\n </tr>\r\n</table>};\r\n\r\nreturn $content;','','blan!
k_box',0),('mark_ads_inactive','','my ($rv, $sth) = $S->db_update({\r\
n WHAT => \'ad_info\',\r\n SET => \'active = 0\',\r\n WHERE => \'views_left <= 0 AND perpetual != 1 AND active = 1\'\r\n});\r\n$sth->finish();\r\n','Mark ads inactive after they\'ve run out of views.','blank_box',0),('unpaid_ad_reap','','my ($rv, $sth) = $S->db_delete({\r\n FROM => \'ad_info\',\r\n WHERE => \'paid is null and TO_DAYS(NOW()) - TO_DAYS(submitted_on) >= 14 and example != 1 and purchase_price > 0\'});\r\n$sth->finish();\r\n','Reap unpaid ads after 14 days. They are unlikely to ever be paid for then.','blank_box',0),('submit_ad_pay_box','Ad Submitted','my $action = $ARGS[0];\r\nmy $ad_id = $ARGS[1];\r\n\r\nmy $q_id = $S->dbh->quote($ad_id);\r\nmy ($num, $price);\r\nmy $args;\r\nmy $content;\r\n\r\nif ($action eq \'renew\') {\r\n $num = $ARGS[2];\r\n unless ($num) {\r\n return \'Error! No impression count was submitted.\';\r\n }\r\n # Get total price\r\n my ($rv, $sth) = $S->db_select({\r\n !
WHAT => \'ad_types.cpm\',\r\n FROM => \'ad_info, ad_types\',\r\n WHERE => \"ad_info.ad_id = $q_id AND ad_info.ad_tmpl =\r\nad_types.type_template\"\r\n });\r\n my ($cpm) = $sth->fetchrow();\r\n $price = ($num/1000) * $cpm;\r\n $args=\";ad_id=$ad_id;renew=1;count=$num\";\r\n $content = $S->{UI}->{BLOCKS}->{ad_renewed_message};\r\n} else {\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'purchase_size, purchase_price\',\r\n FROM => \'ad_info\',\r\n WHERE => \"ad_id=$q_id\"});\r\n\r\n ($num, $price) = $sth->fetchrow();\r\n $sth->finish();\r\n $args=\";ad_id=$ad_id\";\r\n $content = $S->{UI}->{BLOCKS}->{ad_submitted_message};\r\n}\r\n\r\nmy ($pay_cc_block, $pay_pal_block, $pay_free_block);\r\n\r\n$price = sprintf(\"%1.2f\", $price);\r\nif ($price ne \'0.00\') {\r\n $pay_cc_block = $S->{UI}->{BLOCKS}->{ad_pay_cc_msg} if ($S->{UI}->{VARS}->{payme!
nt_use_cc});\r\n $pay_pal_block = $S->{UI}->{BLOCKS}->{ad_pay_paypal_
msg} if ($S->{UI}->{VARS}->{payment_use_paypal});\r\n} else {\r\n $pay_free_block = $S->{UI}->{BLOCKS}->{ad_free_msg};\r\n #// update the advert here for number of impressions.\r\n if ($action eq \'renew\') {\r\n $S->cc_finish_renewal($ad_id, \'\', 0, \'free\', $num);\r\n } else {\r\n $S->cc_finish_ad_sale($ad_id, \'\', 0, \'free\');\r\n }\r\n}\r\n$content =~ s/%%AD_CC_PAY%%/$pay_cc_block/;\r\n$content =~ s/%%AD_PAYPAL_PAY%%/$pay_pal_block/;\r\n$content =~ s/%%AD_FREE_MESSAGE%%/$pay_free_block/g;\r\n$content =~ s/%%num_impressions%%/$num/g;\r\n$content =~ s/%%price%%/$price/g;\r\n$content =~ s/%%payment_args%%/$args/g;\r\n\r\nreturn { content => $content };\r\n','This generates the page the user will see when they have successfully submitted or renewed an ad. If they still need to pay for the advert it will display the various payment options, depending on the ads_use_cc and ads_use_paypal vars. If the advert is free, it will call the relevent functions to mark it!
as paid. Depends on the blocks ad_renewed_message, ad_submitted_message, ad_pay_cc_msg, ad_pay_paypal_msg & ad_free_msg','box',0),('related_links','Related Links','my $db_name = $S->{CONFIG}->{db_name};\r\nmy $sid = $S->{CGI}->param(\'sid\');\r\nmy $f_sid = $S->{DBH}->quote($sid);\r\nmy $archive = $S->_check_archivestatus($sid);\r\n\r\nmy ($rv, $sth) = $S->db_select({\r\n ARCHIVE => $archive,\r\n WHAT => \'introtext, bodytext, aid, section, tid, u.nickname AS nick\',\r\n FROM => \"stories s LEFT JOIN $db_name.users u ON s.aid = u.uid\",\r\n WHERE => qq|sid = $f_sid|});\r\n\r\nmy $data = $sth->fetchrow_hashref;\r\n$sth->finish;\r\n\r\nmy $text = $data->{introtext}.\' \'.$data->{bodytext};\r\n\r\n$data->{nick} = $S->{UI}->{VARS}->{anon_user_nick} if $data->{aid} == -1;\r\nmy @link_arr;\r\n\r\n$text =~ s/<a.*?href.*?>/1/gi; # remove links from autorelated search\r\n\r\nmy @first_related = split /\\n/, $S->{UI}->{VARS}->{autorelated};\r\nmy (%related, $word, $url, %wordcount)!
;\r\n\r\nforeach my $rel (@first_related) {\r\n ($word, $url) = split
/\\s*,\\s*/, $rel;\r\n $url =~ s/\\r//;\r\n $related{$word} = qq|<A CLASS=\"light\" HREF=\"$url\">|;\r\n $wordcount{$word} ++;\r\n}\r\n\r\nforeach $word (keys %related) {\r\n if ($text =~ /$word/gi) {\r\n push @link_arr, $word, $related{$word};\r\n }\r\n}\r\n\r\n$text = $data->{introtext}.\' \'.$data->{bodytext};\r\n\r\nwhile ( $text =~ /(<a href.*?>)(.*?)<\\/a>/gis ) {\r\n my $start = $1;\r\n my $word = $2;\r\n $start =~ s/<A( HREF.*?)/<A CLASS=\"light\"$1/i;\r\n $word =~ s/<.*?>//g; # remove tags from word\r\n $word =~ s/^(\\S{10})(.*)/$1 $2/;\r\n $word =~ s/&/&/g;\r\n $word =~ s/\"/\"/g;\r\n if ( !($related{$word} =~ /$start/i) ) {\r\n $wordcount{$word} ++;\r\n $related{$word} .= $start;\r\n if ($wordcount{$word} > 1) {\r\n $word .= \" [$wordcount{$word}]\";\r\n }\r\n push @link_arr, $word, qq|$start|;\r\n }\r\n}\r\n\r\nmy $auth_urlenc = $data->{nick};\r\n$auth_urlenc =~ s/\\s/%20/g;\r\n\r\nif ($data->{\'section\'} eq \'Diary\') {\r\n push @link_arr, \"$data!
->{nick}\'s Diary\", qq(<A CLASS=\"light\" HREF=\"%%rootdir%%/user/$auth_urlenc/diary\">); \r\n} else {\r\n my $t = $S->get_topic($data->{\'tid\'});\r\n push @link_arr, \"More on $t->{alttext}\", qq(<A CLASS=\"light\" HREF=\"%%rootdir%%/?op=search;topic=$data->{tid}\">) if $S->{UI}->{VARS}->{use_topics};\r\n push @link_arr, \"Also by $data->{nick}\", qq(<A CLASS=\"light\" HREF=\"%%rootdir%%/search/author/$auth_urlenc\">);\r\n}\r\n\r\n\r\nmy $content;\r\nmy $i = 0;\r\nwhile ($i <= $#link_arr) {\r\n $content .= qq(%%dot%% $link_arr[$i+1]$link_arr[$i]</A><BR>\\n);\r\n $i += 2;\r\n}\r\n\r\nreturn {content => $content };\r\n\r\n','The Related links box which appears with stories','box',0),('css','css','my $content;\r\n\r\nmy $file = $S->cgi->param(\'file\');\r\nmy $block = $file.\"_css\";\r\n\r\n$content = $S->{UI}->{BLOCKS}->{$block};\r\n$S->apache->content_type(\'text/css\');\r\n\r\nreturn {content => $content};','Returns a block with type text/css','empty_box',0),('admin_se!
arch','Search Admin Tools','# search terms?\r\nmy $query = $S->cgi->pa
ram(\'query\');\r\n\r\n# search where?\r\n# extract the chosen search locations\r\nmy $search_param = $S->cgi->param(\'search_in\');\r\nmy %search_in;\r\nmy $searches_selected = 0;\r\nforeach (ref($search_param) eq \'ARRAY\' ? @{$search_param} : ($search_param)) {\r\n next unless $_;\r\n $search_in{$_} = 1;\r\n $searches_selected++;\r\n}\r\n\r\n# if they didn\'t select any searches, or this is a fresh load, then select all\r\nunless ($searches_selected) {\r\n foreach (qw(blockval blockdesc boxval boxdesc specval vardesc)) {\r\n $search_in{$_} = 1;\r\n }\r\n}\r\n\r\nmy ($blockval, $blockdesc, $boxval, $boxdesc, $specval, $vardesc) = \"\";\r\nmy ($blocksearchwhere, $boxsearchwhere, $specsearchwhere, $varsearchwhere) = \"\";\r\nmy ($type_phrase, $type_any, $type_all) = \"\";\r\n\r\n# remember what was previously selected. yes, this is kind of ugly\r\n$blockval = \' selected=\"selected\"\' if $search_in{blockval};\r\n$blockdesc = \' selected=\"selected\"\' if $search_in{blockd!
esc};\r\n$boxval = \' selected=\"selected\"\' if $search_in{boxval};\r\n$boxdesc = \' selected=\"selected\"\' if $search_in{boxdesc};\r\n$specval = \' selected=\"selected\"\' if $search_in{specval};\r\n$vardesc = \' selected=\"selected\"\' if $search_in{vardesc};\r\n\r\n# same thing for search type, though set a default of all\r\nif ($S->cgi->param(\'search_type\') eq \'phrase\') {\r\n $type_phrase = \' checked=\"checked\"\';\r\n} elsif($S->cgi->param(\'search_type\') eq \'all\') {\r\n $type_all = \' checked=\"checked\"\';\r\n} elsif($S->cgi->param(\'search_type\') eq \'any\') {\r\n $type_any = \' checked=\"checked\"\';\r\n} else {\r\n $type_all = \' checked=\"checked\"\';\r\n}\r\n\r\n# set up search fields\r\nmy $search_for_field = qq{<input type=\"text\" name=\"query\" value=\"$query\" /><input type=\"submit\" value=\"Search\" />};\r\n\r\nmy $search_in_field = \'<select name=\"search_in\" multiple=\"multiple\" size=\"6\">\';\r\n$search_in_field .= qq{\r\n <option!
value=\"blockval\"$blockval>Block values</option>\r\n <option value=\
"blockdesc\"$blockdesc>Block descriptions</option>} if $S->have_perm(\'edit_blocks\');\r\n\r\n$search_in_field .= qq{\r\n <option value=\"boxval\"$boxval>Box code</option>\r\n <option value=\"boxdesc\"$boxdesc>Box descriptions</option>} if $S->have_perm(\'edit_boxes\');\r\n\r\n$search_in_field .= qq{\r\n <option value=\"specval\"$specval>Special Pages</option>} if $S->have_perm(\'edit_special\');\r\n\r\n$search_in_field .= qq{\r\n <option value=\"vardesc\"$vardesc>Site Controls descriptions</option>} if $S->have_perm(\'edit_vars\');\r\n\r\n$search_in_field .= \"\\n</select>\";\r\n\r\nmy $search_opt_field = qq{<input type=\"radio\" name=\"search_type\" value=\"all\"$type_all /> All words<br />\r\n<input type=\"radio\" name=\"search_type\" value=\"any\"$type_any /> Any words<br />\r\n<input type=\"radio\" name=\"search_type\" value=\"phrase\"$type_phrase /> Phrase};\r\n\r\nmy $content .= qq{\r\n<form method=\"get\" action=\"%%rootdir%%/admin/search\">\r\n<table border=\"0\">\r!
\n <tr>\r\n <td valign=\"top\" rowspan=\"2\">%%norm_font%%Search in:<br />$search_in_field%%norm_font_end%%</td>\r\n <td>%%norm_font%%Search for:<br />$search_for_field%%norm_font_end%%</td>\r\n </tr>\r\n <tr>\r\n <td>%%norm_font%%$search_opt_field%%norm_font_end%%</td>\r\n </tr>\r\n</table>\r\n</form>\r\n };\r\n\r\nif ($query) {\r\n my ($blockresults, $boxresults, $specresults, $varresults) = (\"\",\"\",\"\",\"\");\r\n\r\n # of the three column names which might be needed, these are used\r\n # repeatedly, so stick them in a var instead of re-building them\r\n my $content_string = &search_string($S, $query, \'content\');\r\n my $desc_string = &search_string($S, $query, \'description\');\r\n\r\n $blocksearchwhere .= &search_string($S, $query, \'block\') if ($blockval);\r\n $blocksearchwhere .= \' OR \' if ($blockdesc && $blockval);\r\n $blocksearchwhere .= $desc_string if ($blockdesc);\r\n $boxsearchwhere .= $content_string if ($boxval);\r\n $boxsearchwhere .= \'!
OR \' if ($boxdesc && $boxval);\r\n $boxsearchwhere .= $desc_string
if ($boxdesc);\r\n $specsearchwhere .= $content_string if ($specval);\r\n $varsearchwhere .= $desc_string if ($vardesc);\r\n\r\n if ($blocksearchwhere && $S->have_perm(\'edit_blocks\')) {\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'bid,description,theme\',\r\n FROM => \'blocks\',\r\n WHERE => $blocksearchwhere\r\n });\r\n while (my $rec = $sth->fetchrow_hashref) {\r\n my $desc = $rec->{description} || \"<i>(no description)</i>\";\r\n $blockresults .= qq{\r\n <dt><a href=\"%%rootdir%%/admin/blocks/edit/$rec->{theme}/$rec->{bid}\">$rec->{bid}</a></dt>\r\n <dd>$desc</dd>}\r\n }\r\n $blockresults = \"<dl> $blockresults </dl>\" if $blockresults;\r\n }\r\n\r\n if ($boxsearchwhere && $S->have_perm(\'edit_boxes\')) {\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'boxid, description\',\r\n FROM => \'box\',\r\n WHERE => $boxsearchwhere\r\n });\r\n while (my $rec = $sth->fetchrow_hashref) {\r\n my $desc = $rec->{description} || \"<i>(no desc!
ription)</i>\";\r\n $boxresults .= qq{\r\n <dt><a href=\"%%rootdir%%/admin/boxes/$rec->{boxid}\">$rec->{boxid}</a></dt>\r\n <dd>$desc</dd>}\r\n }\r\n $boxresults = \"<dl> $boxresults </dl>\" if $boxresults;\r\n }\r\n\r\n if ($specsearchwhere && $S->have_perm(\'edit_special\')) {\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'pageid,title,description\',\r\n FROM => \'special\',\r\n WHERE => $specsearchwhere\r\n });\r\n while (my $rec = $sth->fetchrow_hashref) {\r\n my $desc = $rec->{description} || \"<i>(no description)</i>\";\r\n $specresults .= qq{\r\n <dt><a href=\"%%rootdir%%/admin/special?id=$rec->{pageid}\">$rec->{title}</a></dt>\r\n <dd>$desc</dd>}\r\n }\r\n $specresults = \"<dl> $specresults </dl>\" if $specresults;\r\n }\r\n\r\n if ($varsearchwhere && $S->have_perm(\'edit_vars\')) {\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'name,description\',\r\n FROM => \'vars\',\r\n WHERE => $varsearchwhere\r\n });\r\n while (my $rec = $st!
h->fetchrow_hashref) {\r\n my $desc = $rec->{description} || \"<i>(n
o description)</i>\";\r\n $varresults .= qq{\r\n <dt><a href=\"%%rootdir%%/admin/vars/edit/$rec->{name}\">$rec->{name}</a></dt>\r\n <dd>$desc</dd>}\r\n }\r\n $varresults = \"<dl> $varresults </dl>\" if $varresults;\r\n }\r\n\r\n $content .= \"<H3>Blocks found:</H3>\\n%%norm_font%%$blockresults%%norm_font_end%%\" if $blockresults;\r\n $content .= \"<H3>Boxes found:</H3>\\n%%norm_font%%$boxresults%%norm_font_end%%\" if $boxresults;\r\n $content .= \"<H3>Special Pages found:</H3>\\n%%norm_font%%$specresults%%norm_font_end%%\" if $specresults;\r\n $content .= \"<H3>Site Controls found:</H3>\\n%%norm_font%%$varresults%%norm_font_end%%\" if $varresults;\r\n unless ($varresults || $blockresults || $boxresults || $specresults) {\r\n $content .= \"%%norm_font%%Nothing matching your search phrase was found in the selected tools.%%norm_font_end%%\";\r\n }\r\n}\r\n\r\n$content = \"<table width=\\\"100%\\\">\r\n <tr width=\\\"100%\\\" bgcolor=\\\"%%title_bgcolor%%\\\"><td>%%title_fo!
nt%%Search Admin Tools%%title_font_end%%</td></tr>\r\n <tr><td>$content</td></tr>\r\n</table>\";\r\n\r\nreturn $content;\r\n\r\nsub search_string {\r\n my ($S, $query, $field) = @_;\r\n\r\n my $search_string;\r\n if ($S->cgi->param(\'search_type\') eq \'phrase\') {\r\n # easy enough\r\n $search_string = \"$field LIKE \" . $S->dbh->quote(\"%${query}%\");\r\n } else {\r\n while ($query =~ /([\\w-]+)/g) {\r\n if ($search_string) {\r\n $search_string .= \' AND \'\r\n if $S->cgi->param(\'search_type\') eq \'all\';\r\n $search_string .= \' OR \'\r\n if $S->cgi->param(\'search_type\') eq \'any\';\r\n }\r\n $search_string .= \"$field LIKE \" . $S->dbh->quote(\"%${1}%\");\r\n }\r\n }\r\n\r\n return \"($search_string)\";\r\n}\r\n','Simple admin search tool for locating blocks by content or description. This is called from the admin tools menu.','blank_box',0),('pref_selectbox','','my $prefname = shift @ARGS;\r\nmy $choice = shift @ARGS;\r\nmy @choices = @ARGS;!
\r\n\r\nmy $select = qq{\r\n <SELECT name=\"$prefname\" size=\"1\
">};\r\n\r\nforeach my $c (@choices) {\r\n my $checked = ($c eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$c\"$checked>$c</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','Generic select box for user preferences. takes parameters name,value,option1,option2,...\r\nNot suitable for select boxes with code-generated option lists.','empty_box',0),('pref_checkbox','','my $prefname = $ARGS[0];\r\nmy $choice = $ARGS[1];\r\n\r\nmy $selected = ($choice eq \'on\') ? \' CHECKED\' : \'\';\r\n\r\nreturn qq{<INPUT type=\"checkbox\" name=\"$prefname\" value=\"on\"$selected>};','a generic checkbox. Takes two arguments, the pref name and the current pref value.','empty_box',0),('time_zone_pref','','my %zones = $S->_timezone_hash();\r\nmy $S_zone = $ARGS[0];\r\n\r\nmy $select = qq{\r\n <SELECT name=\"time_zone\" size=\"1\">};\r\n\r\nforeach my $zone (sort keys %zones) {\r\n my $z = uc($zone);\r\n my $selected = \'\!
';\r\n if ($z eq $S_zone) {\r\n $selected = \' SELECTED\';\r\n }\r\n $select .= qq{\r\n <OPTION value=\"$z\"$selected>[$z] $zones{$zone}</OPTION>};\r\n}\r\n\r\n$select .= \"\r\n </SELECT>\";\r\n\r\nreturn $select;','timezone selectbox','empty_box',0),('startpage_pref','','my $choice = $ARGS[0];\r\n\r\nmy @choices = sort keys %{ $S->{SECTION_DATA} };\r\nunshift(@choices, \'__main__\', \'__all__\');\r\n\r\nmy $select = qq{\r\n <SELECT name=\"start_page\" size=\"1\"};\r\n\r\nforeach my $c (@choices) {\r\n my $name;\r\n if ( $c eq \'__main__\' ) {\r\n $name = \'Front Page\';\r\n } elsif ( $c eq \'__all__\' ) {\r\n $name = \'Everything\';\r\n } else {\r\n $name = $S->{SECTION_DATA}->{$c}->{title};\r\n }\r\n my $checked = ($c eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$c\"$checked>$name</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\nreturn $select;','','empty_box',0),('img_server_pref','!
','my $current = $ARGS[0];\r\n\r\nreturn unless $S->var(\'image_mirror
s\');\r\nmy @mirrors = split /\\n/, $S->var(\'image_mirrors\');\r\nmy $default_imgdir = $S->{PREF_ITEMS}->{imagedir}->{default_value};\r\n\r\nmy (%servers, $name, $url);\r\n\r\nforeach my $server (@mirrors) {\r\n ($name, $url) = split /,/, $server;\r\n $url =~ s/\\r//;\r\n $servers{$name} = $url;\r\n}\r\n\r\nmy $selected = ( $current eq $default_imgdir ) ? \' SELECTED\' : \'\';\r\n\r\nmy $select = qq{\r\n <SELECT name=\"imagedir\" size=\"1\">\r\n <OPTION value=\"$default_imgdir\"$selected>Default</OPTION>};\r\n\r\nforeach my $server (sort keys %servers) {\r\n $selected = ( $current eq $servers{$server} ) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$servers{$server}\"$selected>$server</A>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('user_theme_pref','','my $choice = $ARGS[0];\r\nmy $themes = $S->{UI}->{VARS}->{user_themes};\r\nmy @themes = split ( /,\\s*/, $themes );\r\n\r\nmy $select = !
qq{\r\n <SELECT name=\"theme\">};\r\n\r\nunless ( $S->{PREF_ITEMS}->{theme}->{default_value} ) {\r\n my $checked = ($choice eq \'\') ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"\"$checked>none</OPTION>};\r\n}\r\n\r\nforeach my $t (@themes) {\r\n my $checked = ($t eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$t\"$checked>$t</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('box_pref','','my @choice = @ARGS;\r\n\r\nmy %boxes = %{$S->{BOX_DATA}};\r\nmy $current_prefs;\r\nmy $return = \'\';\r\n\r\n# convert the comma-separated list into a hash\r\nforeach my $i (@choice) {\r\n $current_prefs->{$i} = 1;\r\n}\r\n\r\nmy $col = 0;\r\n\r\nforeach my $c (keys %boxes) {\r\n next unless $boxes{$c}->{user_choose};\r\n $return .= qq{\r\n <TR>} unless $col;\r\n my $checked = $current_prefs->{$c} ? \" CHECKED\" : \"\";\r\n $return .= qq{\r\n <TD><input typ!
e=\"checkbox\" name=\"displayed_boxes\" value=\"$c\"$checked /></TD>\r
\n <TD>$boxes{$c}->{title}</TD>};\r\n $return .= qq{\r\n </TR>} if $col;\r\n $col = ($col) ? \"0\" : \"1\";\r\n}\r\n\r\n$return .= \"<TD></TD><TD></TD></TR>\" if $col;\r\n\r\n$return = qq{\r\n<TABLE border=\"0\">\r\n$return\r\n</TABLE>};\r\n\r\nreturn $return;','','empty_box',0),('rdf_pref','','my @choice = @ARGS;\r\n\r\nmy $channels = $S->rdf_channels();\r\nmy $current_prefs;\r\nmy $return = \'\';\r\n\r\n# convert the comma-separated list into a hash\r\nforeach my $i (@choice) {\r\n $current_prefs->{$i} = 1;\r\n}\r\n\r\nmy $col = 0;\r\n\r\nforeach my $c (@{$channels}) {\r\n $return .= qq{\r\n <TR>} unless $col;\r\n next unless $c->{enabled} && $c->{title} && !$c->{submitted};\r\n my $checked = $current_prefs->{$c->{rid}} ? \" CHECKED\" : \"\";\r\n $return .= qq{\r\n <TD><input type=\"checkbox\" name=\"rdf_feeds\" value=\"$c->{rid}\"$checked /></TD>\r\n <TD><a href=\"%%rootdir%%/special/rdf_preview/?rdf=$c->{rid}\">$c->{title}</a></TD>};\r\n $ret!
urn .= qq{\r\n </TR>} if $col;\r\n $col = ($col) ? \"0\" : \"1\";\r\n}\r\n\r\n$return .= \"<TD></TD><TD></TD></TR>\" if $col;\r\n\r\n$return = qq{\r\n<TABLE border=\"0\">\r\n$return\r\n</TABLE>};\r\n\r\nreturn $return;','','empty_box',0),('rating_order_pref','','my $choice = $ARGS[0];\r\n\r\nmy %choices = ( \"unrate_highest\", \"Unrated, then Highest\", \"highest\", \"Highest rated first\", \"lowest\", \"Lowest rated first\", \"dontcare\", \"Ignore ratings\" );\r\n\r\nmy $select = qq{\r\n <SELECT name=\"commentrating\" size=\"1\">};\r\n\r\nforeach my $c (keys %choices) {\r\n my $checked = ($c eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$c\"$checked>$choices{$c}</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('postmode_pref','','my $choice = $ARGS[0];\r\n\r\nmy %choices = ( \"text\", \"Plain Text\", \"html\", \"HTML Formatted\", \"auto\", \"Autoformat\" );\r\n\r\nmy $select!
= qq{\r\n <SELECT name=\"posttype\" size=\"1\">};\r\n\r\nforeach
my $c (keys %choices) {\r\n my $checked = ($c eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$c\"$checked>$choices{$c}</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('show_hidden_pref','','my $current = $ARGS[0];\r\n\r\nmy $choices = {\r\n \'yes\' => \'Yes\',\r\n \'no\' => \'No\',\r\n \'untilrating\' => \"Show until I\'ve rated\"\r\n};\r\n\r\nmy $select = qq{\r\n <SELECT name=\"hidingchoice\" size=\"1\">};\r\n\r\nforeach my $choice (keys %{$choices}) {\r\n my $selected = $choice eq $current ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$choice\"$selected>$choices->{$choice}</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('user_group_box','','my ($curr_id) = $ARGS[0];\r\n\r\nmy ($rv, $sth) = $S->db_select({\r\n WHAT => \'perm_group_id\',\r\n FROM => \'perm_groups\',\r\n DEBUG => 0});\r!
\n\r\nmy $selector = qq{\r\n<SELECT NAME=\"perm_group_id\" SIZE=1>};\r\n\r\nmy $selected = \'\';\r\n\r\nwhile (my $group = $sth->fetchrow()) {\r\n $selected = \'\';\r\n $selected = \" SELECTED\" if ($group eq $curr_id);\r\n $selector .= qq{\r\n <OPTION VALUE=\"$group\"$selected>$group};\r\n}\r\n\r\n$selector .= \"</SELECT>\";\r\n\r\nreturn $selector;\r\n','','empty_box',0),('subscriber','','return unless ($S->{UID} == $S->param->{uid});\r\nreturn unless ($S->have_perm(\'allow_subscription\'));\r\nreturn unless ($S->{UI}->{VARS}->{use_subscriptions});\r\n\r\nmy $user = $S->user_data($S->{UID});\r\n\r\nwarn \"(subscriber) active subscription? $user->{sub}->{active}\";\r\n\r\nif ( $user->{sub}->{active} ) {\r\n my $expires = $user->{sub}->{expires};\r\n my $now = time;\r\n my $remaining_days = (int((($expires - $now) / 86400)) + 1);\r\n return qq{Thank you for subscribing. Your subscription expires in $remaining_days days};\r\n} else {\r\n return qq{\r\n<P>You are not!
currently a subscriber. Why not <A href=\"%%rootdir%%/subscribe\">bec
ome one</A>?};\r\n}','','empty_box',0),('commentmode_overflow_pref','','my $choice = $ARGS[0];\r\n\r\nmy %choices = ( \"minimal\", \"Minimal\", \"threaded\", \"Threaded\", \"nested\", \"Nested\", \"flat\", \"Flat\", \"flat_unthread\", \"Flat (unthread)\" );\r\n\r\nif ( $S->var(\'allow_dynamic_comment_mode\') && $S->pref(\'dynamic_interface\') eq \'on\' ) {\r\n $choices{\'dminimal\'} = \"Dynamic Minimal\";\r\n $choices{\'dthreaded\'} = \"Dynamic Threaded\";\r\n} else {\r\n $choice =~ s/^d//;\r\n}\r\n\r\nmy $select = qq{\r\n <SELECT name=\"commentmode_overflow\" size=\"1\">};\r\n\r\nforeach my $c (sort keys %choices) {\r\n my $checked = ($c eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$c\"$checked>$choices{$c}</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('commentmode_pref','','my $choice = $ARGS[0];\r\n\r\nmy %choices = ( \"use_overflow\", \"Always use overflow mode\", \"min!
imal\", \"Minimal\", \"threaded\", \"Threaded\", \"nested\", \"Nested\", \"flat\", \"Flat\", \"flat_unthread\", \"Flat (unthreaded)\" );\r\n\r\nif ( $S->var(\'allow_dynamic_comment_mode\') && $S->pref(\'dynamic_interface\') eq \'on\' ) {\r\n $choices{\'dminimal\'} = \"Dynamic Minimal\";\r\n $choices{\'dthreaded\'} = \"Dynamic Threaded\";\r\n} else {\r\n $choice =~ s/^d//;\r\n}\r\n\r\nmy $select = qq{\r\n <SELECT name=\"commentmode\" size=\"1\">};\r\n\r\nforeach my $c (sort keys %choices) {\r\n my $checked = ($c eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$c\"$checked>$choices{$c}</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('cookie_expire_pref','','my $choice = $ARGS[0];\r\n\r\nmy %choices = ( \"3600\", \"1 hour\", \"86400\", \"1 day\", \"604800\", \"1 week\", \"1209600\", \"2 weeks\", \"2592000\", \"1 month (30 days)\", \"5184000\", \"2 months\" );\r\n\r\nmy $select = q!
q{\r\n <SELECT name=\"cookie_expire\" size=\"1\">};\r\n\r\nforeac
h my $c (sort {$a <=> $b} keys %choices) {\r\n my $checked = ($c eq $choice) ? \' SELECTED\' : \'\';\r\n $select .= qq{\r\n <OPTION value=\"$c\"$checked>$choices{$c}</OPTION>};\r\n}\r\n\r\n$select .= qq{\r\n </SELECT>};\r\n\r\nreturn $select;','','empty_box',0),('startpage_validation','','if ( $S->{SECTION_DATA}->{$ARGS[1]} || $ARGS[1] eq \'__main__\' || $ARGS[1] eq \'__all__\' ) {\r\n return \'\';\r\n} else {\r\n return \"Start Page not valid<BR>\";\r\n}','validates the start page pref','empty_box',0),('cal_day_select','','my $day = $ARGS[0];\nmy $select;\n\n$select = qq{<OPTION value=\"00\">DD</OPTION>\n};\nforeach (1..31) {\n my $selected = ( $day == $_ ) ? \' SELECTED\' : \'\';\n $select .= qq{<OPTION value=\"$_\"$selected>$_</OPTION>\n};\n}\n\nreturn $select;','The options in a selectbox for a day field. Does not include the <SELECT> tags, only the <OPTION> tags.','empty_box',0),('cal_month_select','','my $month = $ARGS[0];\nmy $select;\n\n$select = qq!
{<OPTION value=\"00\">MM</OPTION>\n};\nforeach (1..12) {\n my $selected = ( $month == $_ ) ? \' SELECTED\' : \'\';\n $select .= qq{<OPTION value=\"$_\"$selected>$_</OPTION>\n};\n}\n\nreturn $select;','The options in a selectbox for a month field. Does not include the <SELECT> tags, only the <OPTION> tags.','empty_box',0),('cal_year_select','','my $year = $ARGS[0];\nmy $select;\n\n$select = qq{<OPTION value=\"0000\">YYYY</OPTION>\n};\nforeach (2004..2014) {\n my $selected = ( $year == $_ ) ? \' SELECTED\' : \'\';\n $select .= qq{<OPTION value=\"$_\"$selected>$_</OPTION>\n};\n}\n\nreturn $select;','The options in a selectbox for a year field. Does not include the <SELECT> tags, only the <OPTION> tags.','empty_box',0),('calendar_actions','','my ($sub_link, $content, $newevent, $modevents, $edit_cal);\r\nmy $cal_id = $S->cgi->param(\'calendar\');\r\n\r\nif ( $cal_id ) {\r\n # viewing a particular calendar\r\n if ($S->have_calendar_perm(\'edit\',$cal_id)) {\r\n $edit_ca!
l = qq{<A href=\"%%rootdir%%/editcalendar/settings/$cal_id\">Edit this
calendar</A>};\r\n }\r\n if ($S->have_calendar_perm(\'submit\',$cal_id)) {\r\n $newevent = qq{<A href=\"%%rootdir%%/submitevent/submit/$cal_id\">Submit new event</A>};\r\n }\r\n if ( $S->have_calendar_perm(\'moderate\',$cal_id) ) {\r\n $modevents = qq{<A href=\"%%rootdir%%/editcalendar/moderate/$cal_id\">Moderate submitted events</A>};\r\n } \r\n} elsif ($S->have_perm(\'edit_own_calendar\')) {\r\n # personal calendar view\r\n $edit_cal = qq{<A href=\"%%rootdir%%/editcalendar\">Edit your calendar</A>} if $S->var(\'allow_user_calendars\');\r\n my $cals = $S->_cal_submit_list();\r\n my $use_submit = 0;\r\n foreach ( @$cals ) {\r\n if ( $S->pref(\"calendar_${_}_subscribe\") ) {\r\n $use_submit = 1;\r\n next;\r\n }\r\n }\r\n if ( $use_submit ) {\r\n $newevent = qq{<A href=\"%%rootdir%%/submitevent/submit\">Submit new event</A>};\r\n }\r\n}\r\n\r\nmy @list;\r\nfor ($newevent, $modevents, $edit_cal, $sub_link) {\r\n push @list, $_ if ($_);\r\!
n}\r\nmy $list = join(\' :: \', @list);\r\n$content = qq{\r\n<DIV class=\"cal_actions\">\r\n$list\r\n</DIV>};\r\n\r\nreturn $content;\r\n','Links to the various things you can do to/with a calendar','empty_box',0),('calendar_selectbox','','my $cals = $S->_cal_submit_list();\nmy $tool = $S->cgi->param(\'tool\') || \'submit\';\nmy $id = $S->cgi->param(\'id\');\nmy ($current,$selected);\n\nif ( $tool eq \'edit\' || $tool eq \'invite\' || ($tool eq \'submit\' && $S->cgi->param(\'newchild\')) ) {\n my $event = $S->get_event($id);\n $current = $S->cgi->param(\'cal_id\') || $event->{cal_id};\n} else {\n $current = $S->cgi->param(\'cal_id\') || $id;\n}\n\nmy $content = qq{\n <SELECT name=\"cal_id\" size=\"1\">\n <OPTION value=\"\">Select a calendar</OPTION>};\nforeach ( @$cals ) {\n my $cal = $S->get_calendar($_);\n $selected = ($current == $cal->{cal_id}) ? \' SELECTED\' : \'\';\n $content .= qq|\n <OPTION value=\"$cal->{cal_id}\"$selected>$cal->{title}</!
OPTION>|;\n}\n$content .= qq{\n </SELECT>};\nreturn $content;','s
elects the calendar an event is submitted to. Selectbox with all of the calendars a use has permission to submit events ','empty_box',0),('event','','return if $S->cgi->param(\'op\') eq \'event\';\n\nmy $sid = $ARGS[0];\nmy $q_sid = $S->dbh->quote($sid);\n\nmy ($rv,$sth) = $S->db_select({\n DEBUG => 1,\n WHAT => \'eid\',\n FROM => \'event_story\',\n WHERE => qq{sid = $q_sid}\n});\n\nreturn if ( $rv == 0 );\n\nmy ($eid) = $sth->fetchrow_array();\nmy $event = $S->get_event($eid);\n\nmy $link = $S->{UI}->{BLOCKS}->{story_event_link};\nreturn $S->interpolate($link,$event);','displays the link to the event, if the story is associated with an event','empty_box',0),('event_calendar_invitations','','my $hook = $ARGS[0];\nmy $uid = $ARGS[1];\nmy $pref = $ARGS[2];\nmy $value = $ARGS[3];\n\nif ( $pref =~ /event_(.*)_invite/ && $value eq \'on\' ) {\n $S->_invite_notify(\'event\',$1,$uid);\n} elsif ( $pref =~ /calendar_(.*)_invite/ && $value eq \'on\' ) {\n $S->_invite_notify(\!
'calendar\',$1,$uid);\n}\n\n# not either of those, so don\'t do anything','handles notification of invitation for calendars and events (tied to pref_change hook)','empty_box',0),('event_invitations','New Invitations','my $content;\n\nmy ($rv,$sth) = $S->db_select({\n WHAT => \'eid\',\n FROM => \'event_watch\',\n WHERE => qq at uid = $S->{UID} AND last_viewed = 0@\n});\n\nwhile ( my ($eid) = $sth->fetchrow_array() ) {\n my $event = $S->get_event($eid);\n $content .= qq@%%dot%% <A href=\"%%rootdir%%/event/$eid\">$event->{title}</A><BR>@;\n}\n\nreturn $content;','Shows a list of events to which the user is invited if they haven\'t yet followed the link','box',0),('event_notify','Event Updates','my $content;\nmy ($rv,$sth) = $S->db_select({\n WHAT => \'*\',\n FROM => \'event_watch LEFT JOIN events USING (eid)\',\n WHERE => \"uid=$S->{UID} AND subscribed=1\"\n});\n\nwhile ( my $item = $sth->fetchrow_hashref() ) {\n next unless ( $item->{last_update} > $item->{last_viewe!
d} );\n my $event = $S->get_event($item->{eid});\n $content .= qq@%%
dot%% <A href=\"%%rootdir%%/event/$item->{eid}\">$event->{title}</A><BR>@;\n}\n\nreturn $content;','a disappearing/reappearing box that notifies users if an event that they\'ve subscribed to has been changed since they last saw it.','box',0),('event_stories','','my $eid = $S->cgi->param(\'eid\');\nmy $event = $S->get_event($eid);\nmy $page;\n\nif ( $event->{is_parent} ) {\n # get the stories for all the child events too\n my @eids = ($eid);\n my ($rv,$sth) = $S->db_select({\n DEBUG => 1,\n WHAT => \'eid\',\n FROM => \'events\',\n WHERE => \"parent = $eid\"\n });\n while ( my ($e) = $sth->fetchrow_array() ) {\n push @eids, $e;\n }\n my $sql_eids = join(\',\',map {$S->dbh->quote($_)} @eids );\n $page = $S->frontpage_view(\'summaries\', \"eid IN ($sql_eids)\", \'left join event_story e on s.sid = e.sid\');\n} else {\n # get only the stories for this one event\n $page = $S->frontpage_view(\'summaries\', \"eid = $eid\", \'left join event_story!
e on s.sid = e.sid\');\n}\n\nreturn $page;','displays the formatted stories attached to this event','empty_box',0),('mini_calendar','Events','return unless $S->var(\'use_calendars\');\n\nmy @today = $S->time_localize_array(Date::Calc::Today_and_Now(),1);\nmy $keys;\nmy $cal = $S->{UI}->{BLOCKS}->{calendar_body_monthly_mini};\nmy ($cal_ids,$view_cals);\nmy ($day_link,$day_link_end);\n\nif ( $S->var(\'allow_personal_calendar_view\') ) {\n $cal_ids = $S->_personal_calendar_list($S->{UID});\n}\nif ( !$cal_ids ) {\n $cal_ids->[0] = $S->var(\'default_calendar_id\');\n}\n$view_cals = $S->_calendar_can_view($cal_ids);\nreturn unless $view_cals;\n\n$S->_get_months_events($today[0],$today[1],$view_cals);\n\n# properly blank out the structure, so unused \n# calendar squares don\'t collapse\nforeach my $a (1..7) {\n foreach my $b (1..5) {\n $keys->{\"wk${b}_d$a\"} = \'<TD> </TD>\';\n }\n}\n\n# fill in the basic keys\n$keys->{month} = Date::Calc::Month_to_Text($today[1]);\n!
$keys->{year} = $today[0];\n\n# now the keys for each day\nmy $i = 0;\
nmy @date = @today;\nmy ($dow,$wom);\nwhile ( $i++ < Date::Calc::Days_in_Month($today[0],$today[1]) ) {\n $dow = Date::Calc::Day_of_Week($today[0],$today[1],$i);\n $wom = int(($i + Date::Calc::Day_of_Week($today[0],$today[1],1) - 2) /7)+1;\n my $hilight = ($i == $today[2]) ? \' id=\"today\"\' : \'\';\n $date[2] = $i;\n\n my $eventlist = $S->_get_days_events(@date[0,1,2],$view_cals) if $view_cals;\n if ( $eventlist ) {\n $day_link_end = \'</A>\';\n if ( @$eventlist > 1 ) {\n $day_link = qq{<A href=\"%%rootdir%%/calendar/daily/0/$date[0]-$date[1]-$date[2]\">};\n } else {\n $day_link = qq{<A href=\"%%rootdir%%/event/$eventlist->[0]\">};\n }\n } else {\n $day_link = \'\';\n $day_link_end = \'\';\n }\n\n $keys->{\"wk${wom}_d$dow\"} = qq{<TD$hilight>$day_link$i$day_link_end</TD>};\n}\n\nreturn $S->interpolate($cal,$keys);','','box',0),('num_results','','my $num = $S->cgi->param(\'count\') || 30;\nmy $out;\n$out = qq{\n <SELECT name=\"count\" !
size=\"1\">};\n\nforeach ( (10,20,30,50) ) {\n my $selected = ( $_ == $num ) ? \' SELECTED\' : \'\';\n $out .= qq{\n <OPTION value=\"$_\"$selected>$_</OPTION>};\n}\n$out .= qq{\n </SELECT>};\n\nreturn $out;','number of results for search form','empty_box',0),('calendar_datenav','','my $content = \'\';\r\nmy $view = $S->cgi->param(\'view\') || $S->pref(\'calendar_view\');\r\nmy @date = $S->_get_date_array($S->cgi->param(\'date\'));\r\nmy $nav_items = $S->_calendar_date_navigation($view, at date);\r\n\r\nmy $prefix = \'<< \';\r\nmy $suffix = \'\';\r\nmy $stage = \'before\';\r\n\r\nforeach my $item (@$nav_items) {\r\n warn \"Item is $item->{link_url}\\n\";\r\n my $keys = {}; # keys for interpolation\r\n my $string = $S->{UI}->{BLOCKS}->{calendar_navigation_item};\r\n $keys->{link_url} = $item->{link_url};\r\n\r\n #link text\r\n my $text;\r\n if ( $view eq \'monthly\' ) {\r\n my $year = $date[0];\r\n $year -= 1 if ($item->{date_array}->[1] > $date[1] && $!
stage eq \'before\');\r\n $year += 1 if ($item->{date_array}->[1] < $d
ate[1] && $stage eq \'after\');\r\n $text = Date::Calc::Month_to_Text($item->{date_array}->[1]) . \" \" . $year;\r\n warn \"Date is $text\\n\";\r\n } else {\r\n $text = Date::Calc::Date_to_Text(@{$item->{date_array}});\r\n }\r\n $keys->{nav_link} = \"$prefix$text$suffix\";\r\n\r\n if ($item->{current}) {\r\n $keys->{css_id} = $S->{UI}->{BLOCKS}->{calendar_navigation_hilight};\r\n $keys->{nav_link} = $text;\r\n $prefix = \'\';\r\n $suffix = \' >>\';\r\n $stage = \'after\'\r\n }\r\n $content .= $S->interpolate($string,$keys);\r\n}\r\n\r\n\r\nreturn $content;','The navigation bar for the three calendar views.','empty_box',0),('hotlist_box_new','Your Hotlist','return unless ($S->{HOTLIST} && $#{$S->{HOTLIST}} >= 0);\n\nmy $box_content;\nmy $sids;\nmy $stories = $S->story_data($S->{HOTLIST});\nmy $show = $S->var(\'show_new_comments\');\nforeach my $story (@$stories) {\n my $num_new = $story->{comments} - $story->{lastseen} if ($show eq \"hotlist\" !
|| $show eq \"all\");\n my $end_s = ($story->{comments} == 1) ? \'\' : \'s\';\n $box_content .= qq~%%dot%% <A CLASS=\"light\" HREF=\"%%rootdir%%/story/$story->{sid}\">$story->{title}</a> ($story->{comments} comment$end_s~;\n $box_content .= \", $num_new new\" if defined($num_new);\n $box_content .= \")<BR>\";\n}\n\nreturn unless $box_content;\nmy $title = \"$S->{NICK}\'s Hotlist\";\nreturn {title => $title, content => $box_content};\n','Replacement hotlist box for new story fetching code','box',0),('olderlist_box_new','Front Page','my $section = $S->{CGI}->param(\'section\') || \'front\';\nmy $stories = [];\nmy $params;\n$params->{limit} = $S->pref(\'maxtitles\');\n$params->{offset} = $S->pref(\'maxstories\');\n\nif ($section eq \'front\') {\n $params->{displaystatus} = 0;\n} else {\n $params->{displaystatus} = [0,1];\n $params->{section} = $section;\n}\nmy $sids = $S->get_sids($params);\n$stories = $S->story_data($sids);\n\nreturn unless $stories;\n\nmy $b!
ox_content;\n\nmy $date = undef;\nforeach my $story (@{$stories}) {\n
if (($story->{wmdtime} ne $date) || !$date) {\n $date = $story->{wmdtime};\n $box_content .= qq|\n <B>$story->{wmdtime}</B>|;\n }\n $box_content .= qq|\n <BR>%%dot%% <A CLASS=\"light\" HREF=\"%%rootdir%%/story/$story->{sid}\">$story->{title}</A> ($story->{comments} comments)|;\n \nif ($S->have_perm(\'story_list\')) {\n $box_content .= qq| [<A CLASS=\"light\" HREF=\"%%rootdir%%/admin/story/$story->{sid}\">edit</A>]|;\n }\n}\n\nmy $offset = $S->{UI}->{VARS}->{maxstories} + length(@$stories) if $stories;\n\nmy $search_url = qq{%%rootdir%%/?op=search;offset=$offset};\n$search_url .= \';section=\'.$section if ($section ne \'front\');\n\n$box_content .= qq|\n <P>\n <A CLASS=\"light\" HREF=\"$search_url\">Older Stories...</A>\n </P>|;\nmy $return = {content => \"%%smallfont%%$box_content%%smallfont_end%%\"};\nif ($section ne \'front\' && $section ne \'__all__\') {\n $return->{title} = $S->{SECT!
ION_DATA}->{$section}->{title};\n} elsif ($section eq \'__all__\') {\n $return->{title} = \'All Stories\';\n}\n\nreturn $return;','Replacement older list box for new story fetching code','box',0),('signup_password','','return \'\' unless $S->{UI}->{VARS}->{\'signup_with_password\'};\r\n\r\nreturn qq{\r\n<TR><TD class=\"smalltext\">\r\n<b>Please choose a password:</b>\r\n</TD>\r\n<TD>\r\n<INPUT TYPE=\"password\" NAME=\"pass1\" VALUE=\"%%pass1%%\" SIZE=30>\r\n</TD>\r\n</TR>\r\n<TR><TD class=\"smalltext\">\r\n<b>Type password again:</b>\r\n</TD>\r\n<TD>\r\n<INPUT TYPE=\"password\" NAME=\"pass2\" VALUE=\"%%pass2%%\" SIZE=30>\r\n</TD>\r\n</TR>};\r\n\r\n\r\n','Generate the new user password form, if desired','empty_box',0),('activate','','return qq{You\'re already logged in! Your account is confirmed and active. Click <a href=\"%%rootdir%%/\">here</a> to go to the home page.} if ($S->{UID} > 0);\r\n\r\nmy $key = $S->cgi->param(\'key\');\r\nreturn \'Error: No key provided.\' un!
less $key;\r\n\r\nmy $q_key = $S->dbh->quote($key);\r\nmy ($rv, $sth)
= $S->db_select({\r\n WHAT => \'uid, nickname, creation_passwd\',\r\n FROM => \'users\',\r\n WHERE => qq{passwd = $q_key}\r\n}); \r\n\r\nmy ($uid, $nick, $pass) = $sth->fetchrow();\r\n$sth->finish();\r\n\r\nmy $help = $S->{UI}->{VARS}->{local_email};\r\n\r\nreturn qq{I\'m sorry, I can\'t find that key. Your account is probably already confirmed -- try logging in <a href=\"%%rootdir%%/login\">here</a> using the nickname and password you chose when you signed up. If that works, you\'re all set. If not, please email <a href=\"mailto:$help\">$help</a> for help.} unless ($uid && $nick && $pass);\r\n\r\nmy ($rv, $sth) = $S->db_update({\r\n WHAT => \'users\',\r\n SET => qq{passwd = newpasswd, creation_passwd = \"\", newpasswd = \"\"},\r\n WHERE => qq{uid = $uid}\r\n});\r\n$sth->finish(); \r\n \r\n$S->{PARAMS}->{\'uname\'} = $nick;\r\n$S->{PARAMS}->{\'pass\'} = $pass;\r\n\r\n$S->_check_user();\r\n\r\nmy $urlnick = $S->urlify($nick);\r\n\r\nmy $url = $S->{UI}->{VARS}->{site_url} . \"!
/\" .\r\n $S->{UI}->{VARS}->{rootdir} . \"user/$urlnick/prefs?firstlogin=1\";\r\n\r\n$S->{APACHE}->headers_out->{\'Location\'} = $url;\r\n$S->{HEADERS_ONLY}=1; \r\n\r\nreturn;','The code to activate a new user\'s account when they click the emailed link.','empty_box',0),('iplookup','','my $content;\r\nmy $ip = $S->cgi->param(\'iplook\');\r\n\r\n$content = \"<table><tr><td><b>Users created from IP address $ip:</b></td></tr>\";\r\n\r\n# Get list of users created from this IP address\r\nmy ($rv, $sth) = $S->db_select({\r\n WHAT => \'nickname, perm_group\',\r\n FROM => \'users\',\r\n WHERE => qq~creation_ip = \'$ip\'~\r\n });\r\n\r\nwhile (my $user = $sth->fetchrow_hashref()){\r\n $content .= qq~\r\n <tr><td><a href=\"/user/$user->{\'nickname\'}\">$user->{\'nickname\'}</A> </td><td>$user->{\'perm_group\'}</td></tr>~;\r\n }\r\n$sth->finish;\r\n\r\n# figure out the basic subnet\r\nmy @net = split(/\\./, $ip);\r\nmy $sub = $net[0] . \".\" . $net[1] !
. \".\" . $net[2] . \".\";\r\n\r\n$content .= qq~<tr><td><b>Users crea
ted from ${sub}*:</b></td></tr>~;\r\n\r\n($rv, $sth) = $S->db_select({\r\n WHAT => \'nickname, perm_group\',\r\n FROM => \'users\',\r\n WHERE => qq~creation_ip like \'${sub}%\'~\r\n });\r\n\r\nwhile (my $user = $sth->fetchrow_hashref()){\r\n $content .= qq~\r\n <tr><td><a href=\"/user/$user->{\'nickname\'}\">$user->{\'nickname\'}</A> </td><td>$user->{\'perm_group\'}</td></tr>~;\r\n }\r\n$sth->finish;\r\n\r\n# comments, if we\'re keeping track of that sort\r\n# of thing\r\nif($S->{UI}->{VARS}->{\'comment_ip_log\'}){\r\n $content .= \"<tr><td><b>Users who have posted from $ip:</b></td></tr>\";\r\n ($rv, $sth) = $S->db_select({\r\n WHAT => \'comments.commentip, users.nickname, users.perm_group\',\r\n FROM => \'comments left join users on comments.uid = users.uid\',\r\n WHERE => qq~commentip = \'$ip\'~,\r\n GROUP_BY => \'comments.uid\'\r\n });\r\n while (my $c = $sth->fetchrow_hashref()){\r\n $content .= qq~!
<tr><td><a href=\"/user/$c->{\'nickname\'}\">$c->{\'nickname\'}</a></td><td>$c->{\'perm_group\'}</td></tr>~;\r\n }\r\n $sth->finish;\r\n $content .= \"<tr><td><b>Users who have posted from ${sub}*:</b></td></tr>\";\r\n ($rv, $sth) = $S->db_select({\r\n WHAT => \'comments.commentip, users.nickname, users.perm_group\',\r\n FROM => \'comments left join users on comments.uid = users.uid\',\r\n WHERE => qq~commentip like \'${sub}%\'~,\r\n GROUP_BY => \'comments.uid\'\r\n });\r\n while (my $c = $sth->fetchrow_hashref()){\r\n $content .= qq~<tr><td><a href=\"/user/$c->{\'nickname\'}\">$c->{\'nickname\'}</a></td><td>$c->{\'perm_group\'}</td></tr>~;\r\n }\r\n $sth->finish;\r\n }\r\n\r\n$content .= \"</table>\";\r\n\r\n# get the whois info. NOTE: for this to work\r\n# right, you need to have the whois command \r\n# installed. Normally, this shouldn\'t be a\r\n# problem\r\n$content .= \"<P><b>WHOIS info for $ip<!
/b><P>\";\r\nmy $whois = `/usr/bin/whois $ip`;\r\n# sigh, gotta format
it right\r\n#my @z = split /\\n/, $whois;\r\n#while (my $line = @z){\r\n# $content .= \"$line<br>\";\r\n# }\r\n$content .= \"<pre>$whois</pre>\";\r\n\r\nreturn $content;','','empty_box',0),('admin_tools','Admin Tools','my $content;\r\n\r\nmy @tools = sort { $a->{pos} <=> $b->{pos} } values %{ $S->{ADMIN_TOOLS} };\r\n\r\nforeach my $t (@tools) {\r\n my $perm = $t->{perm};\r\n if ($t->{perm} =~ /,/) {\r\n $t->{perm} =~ /^(.*?),/;\r\n $perm = $1;\r\n }\r\n if ( $S->have_perm($perm) ) {\r\n $content .= qq|\r\n %%dot%% <a class=\"light\" href=\"%%rootdir%%/admin/$t->{tool}\">$t->{menuname}</a><br>|;\r\n }\r\n}\r\n\r\nif ($S->have_perm(\'edit_user\')) {\r\n $content .= qq{<br>\r\n <FORM NAME=\"uedit\" METHOD=\"GET\" ACTION=\"%%rootdir%%/\">\r\n Edit User:<BR>\r\n <INPUT TYPE=\"hidden\" NAME=\"op\" VALUE=\"user\">\r\n <SMALL><INPUT TYPE=\"text\" NAME=\"nick\" VALUE=\"\" SIZE=10>\r\n <INPUT TYPE=\"SUBMIT\" NAME=\"tool\" VALUE=\"prefs\">!
\r\n <INPUT TYPE=\"SUBMIT\" NAME=\"tool\" VALUE=\"info\">\r\n </SMALL></FORM>};\r\n}\r\n\r\nreturn \'\' unless $content;\r\n\r\nreturn $content;\r\n','Admin Tools box','box',0),('userpref_menu','','my $edit = 0;\r\nmy $return = \'\';\r\nmy $nick = $S->param->{nick};\r\nmy $tool = $S->param->{tool} || \'info\';\r\nmy $admin_edit = \'\';\r\n\r\n# first, do we have permission to edit \r\n# this user\'s prefs?\r\n\r\nif ( $S->{UID} == $S->param->{uid} || $S->have_perm(\'edit_user\') ) {\r\n $edit = 1;\r\n}\r\n\r\n$admin_edit = qq{[<A href=\"%%rootdir%%/user/$nick/prefs\">edit user</A>]} if ($S->have_perm(\'edit_user\'));\r\n\r\n# links to create\r\nmy $links = \"<P>$admin_edit ${nick}\'s \";\r\n\r\n# user info pages\r\nif ( $tool eq \'info\' ) {\r\n $links .= qq{\r\n <A href=\"%%rootdir%%/user/$nick\">Info</A>};\r\n $links .= qq{\r\n <A href=\"%%rootdir%%/user/$nick/comments\">Comments</A>};\r\n $links .= qq{\r\n <A href=\"%%rootdir%%/user/$nick/stories\">Storie!
s</A>};\r\n\r\n if ( $S->{UI}->{VARS}->{use_diaries} ) {\r\n $link
s .= qq{\r\n <A href=\"%%rootdir%%/user/$nick/diary\">Diary</A>};\r\n }\r\n\r\n if ( $S->{UI}->{VARS}->{use_ratings} ) {\r\n $links .= qq{\r\n <A href=\"%%rootdir%%/user/$nick/ratings\">Ratings</A>};\r\n }\r\nmy $udata = $S->user_data($S->param->{\'uid\'});\r\n# if ( $S->{UI}->{VARS}->{allow_uploads} ) {\r\nif($S->{UI}->{VARS}->{allow_uploads} && (($S->have_perm(\'view_user_files\') && $S->have_perm(\'upload_user\', $udata->{\'perm_group\'})) || $S->have_perm(\'upload_admin\')) ) {\r\n $links .= qq{\r\n <A href=\"%%rootdir%%/user/$nick/files\">Files</A>};\r\n }\r\n\r\n if ( $S->{UI}->{VARS}->{use_ads} ) {\r\n $links .= qq{\r\n <A href=\"%%rootdir%%/user/$nick/ads\">Ads</A>};\r\n }\r\n\r\n $return = $links . \"</P>\";\r\n} elsif ( $edit && $tool eq \'prefs\' ) {\r\n my %editlinks;\r\n my ($rv, $sth) = $S->db_select({\r\n WHAT => \'page, perm_edit\',\r\n FROM => \'pref_items\',\r\n GROUP_BY => \'page\!
'\r\n });\r\n while (my $item = $sth->fetchrow_hashref()) {\r\n $editlinks{\"$item->{page}\"} = \"%%rootdir%%/user/$nick/prefs/$item->{page} $item->{perm_edit}\";\r\n }\r\n $sth->finish;\r\n $links .= qq{\r\n <A href=\"%%rootdir%%/user/$nick/prefs/Protected\">Email and Password</A>};\r\n\r\n foreach my $item (sort {$b cmp $a} keys %editlinks) {\r\n my $c = 0;\r\n my ($rv2, $sth2) = $S->db_select({\r\n WHAT => \'perm_edit\',\r\n FROM => \'pref_items\',\r\n WHERE => \"page = \'$item\'\"\r\n });\r\n while(my $i = $sth2->fetchrow_hashref()) {\r\n $c++ if ($S->have_perm($i->{perm_edit}) || !$i->{perm_edit});\r\n }\r\n $sth2->finish;\r\n $links .= ($c) ? qq{\r\n <A href=\"$editlinks{$item}\">$item</A>} : \'\';\r\n }\r\n $return = $links . \"</P>\";\r\n}\r\n\r\nreturn $return;\r\n','navigation for user pref pages','empty_box',0),('addtag','','my $sid = $S->cgi->param(\'sid\');\r\nmy $tagsave = $S->cgi->para!
m(\'tagsave\');\r\nmy $newtags = $S->cgi->param(\'newtags\');\r\nretur
n \"Error! No sid provided!\" if !$sid;\r\nmy $content;\r\n\r\n# I would, of course, prefer not to give\r\n# TUs extra privileges, but sometimes I guess\r\n# it must be done.\r\nmy $alltags;\r\nmy $subval;\r\nif ($S->have_perm(\'edit_story_tags\')){\r\n $newtags ||= $S->get_tags_as_string($sid);\r\n $alltags = $newtags;\r\n $subval = \"Add/Edit\";\r\n }\r\nelse {\r\n $alltags = $S->get_tags_as_string($sid) . \", $newtags\";\r\n $subval = \"Add\";\r\n }\r\n#my $alltags = $S->get_tags_as_string($sid) . \", #$newtags\";\r\n$alltags =~ s/,$//;\r\n\r\n# if we\'re adding tags, add them and clear the new\r\n# tags var\r\nif($tagsave && $newtags){\r\n $S->save_tags($sid, $alltags);\r\n $content .= \"<p>Tags <b>$newtags</b> added.</p>\";\r\n $newtags = \'\';\r\n # and if we\'ve added tags, we\'re heading\r\n # back to whence we came.\r\n my $url = $S->{UI}->{VARS}->{site_url} \r\n . $S->{UI}->{VARS}->{rootdir} . \"/\"\r\n . \"sto!
ry/$sid\";\r\n $S->{APACHE}->headers_out->{\'Location\'} = $url;\r\n $S->{HEADERS_ONLY}=1;\r\n }\r\nmy $curtags = $S->tag_display($sid);\r\n$content = \"Current $curtags\" . $content;\r\n\r\nmy $tagform = qq~\r\n<p><form name=\"addtag\" action=\"%%rootdir%%/addtag\" method=\"POST\">$subval Tags: (use commas to separate tags) <input type=\"hidden\" name=\"sid\" value=\"$sid\"><input type=\"text\" name=\"newtags\" size=\"30\" value=\"$newtags\"> <input type=\"submit\" name=\"tagsave\" value=\"$subval Tags\"></p></form></p><p>\r\n\'/\' characters are not allowed in tags, and will be converted to \'-\'.</p>\r\n~;\r\nreturn $content . $tagform;','','empty_box',0),('tag_listing','','my $sid = $S->cgi->param(\'sid\');\r\nmy $tags = $S->tag_display($sid);\r\nmy $content = \"$tags\";\r\n# if we can post comments, we can tag.\r\nif($S->have_perm(\'comment_post\')){\r\n my $addlink = ($S->have_perm(\'edit_story_tags\')) ? qq~ :: <a href=\"/addtag/$sid\">Add/Edit Tags to th!
is Story</a>~ : qq~ :: <a href=\"/addtag/$sid\">Add Tags to this Story
</a>~;\r\n $content .= $addlink;\r\n }\r\nreturn $content;','','empty_box',0),('tag_page_order','','my $switch = $S->cgi->param(\'switch\');\r\n\r\nif($S->{UID} > 0){\r\n $S->pref(\'tag_sort\', $switch); # nice and easy\r\n }\r\nelse { # not so easy\r\n $S->session(\'tag_sort\', $switch);\r\n }\r\nmy $url = $S->{UI}->{VARS}->{site_url} . \r\n $S->{UI}->{VARS}->{rootdir} . \"/\" \r\n . \"tag\";\r\n\r\n $S->{APACHE}->headers_out->{\'Location\'} = $url;\r\n$S->{HEADERS_ONLY}=1;\r\n\r\nreturn;','','empty_box',0),('tag_sort_change','','# change the default ordering for the \"All Tags\"\r\n# page\r\n# don\'t display if we\'re not looking at the \"All\r\n# Tags\" page, though.\r\nreturn if $S->cgi->param(\'tag\');\r\n\r\nmy $switchto = ($S->pref(\'tag_sort\') eq \'alpha\') ?