Authors: ";
my $c=sqlSelectMany("distinct aid,lasttitle","sessions",
"aid!=".$dbh->quote($$USER{aid}));
while(my ($aid,$lasttitle)=$c->fetchrow()) {
print " "
if $$USER{aseclev} > 10000;
print "$aid";
print " " if $$USER{aseclev} > 10000;
print " ($lasttitle) " if $lasttitle;
}
$c->finish();
}
sub setupUser
{
my($section,$mode)=@_;
$userMode=$mode eq "flat" ? "_F" : "" ;
$currentSection=$section || "";
}
sub linkStory
{
my($text,$mode,$sid,$sect)=@_;
$sid=($mode eq "dynamic"
or !$sect)?"article.pl?sid=$sid":"$sect/$sid$userMode".".shtml";
return "$text";
}
sub getSection
{
my($section)=@_;
return { title=>$slogan,artcount=>30,issue=>3 } unless $section;
return sqlSelectHashref("*","sections",
"section=".$dbh->quote($section));
}
sub ssiHead
{
#print "$ssidir\n";
print "\n";
}
sub ssiFoot
{
print "\n";
print "\n";
}
sub adminMenu
{
my($USER)=@_;
my $seclev=$$USER{aseclev};
return unless $seclev;
print "\n";
print " [ Logout $$USER{aid}
| Home
| Stories
| Topics
" if $seclev > 0;
print " | New
" if $seclev > 10;
my ($cnt)=sqlSelect("count(*)","submissions");
print " | $cnt Submissions
| Blocks
| Users
| Polls
" if $seclev > 499;
print " | Sections
" if ($seclev > 999 or ($$USER{asection} and $seclev > 499));
print " | Authors
| Variables
" if $seclev > 10000;
print "]
\n\n" if $seclev > 0;
}
# What follows are a bunch of pseudo random functions for advanced HTML widget
# creation. Good if you happen to be lazy :)
sub selectForm
{
my ($table,$label,$default,$where)=@_;
my ($thiscode, $thisname)=sqlSelect("code,name",$table,
"code=".$dbh->quote($default) );
print "\n\n";
}
sub selectGeneric
{
my ($table,$label,$code,$name,$default,$where,$order,$limit)=@_;
my ($thiscode,$thisname)=sqlSelect("$code,$name",$table,"$code=".$dbh->quote($default)) if $default;
$thisname=$default unless $thisname;
print "\n\n";
}
sub selectTopic
{
my($name,$tid)=@_;
selectGeneric("topics",$name,"tid","alttext",$tid);
}
sub selectSection
{
my($name,$section,$SECT,$USER)=@_;
if($SECT && $$SECT{isolate}) {
print "";
} else {
my $where="isolate=0" unless $$USER{aseclev} > 499;
selectGeneric("sections",$name,"section","title",$section,$where);
}
}
sub getvars
{
my @invars=@_;
my @vars;
for(my $x=0;$x<@invars;$x++) {
($vars[$x])=sqlSelect("value","vars","name='$invars[$x]'");
}
return @vars;
}
sub getvar
{
my ($value, $desc)=sqlSelect("value,description","vars","name='$_[0]'");
}
# A few handy functions for getting dates for use with cookies- thanx nate.
sub cookietime
{
my ($time) = @_;
my @nums = gmtime($time);
foreach my $num (@nums) {
if (length($num)==1) { $num = 0 . $num; }
}
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)=@nums;
$year += 1900;
$wday = ("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
"Friday", "Saturday")[$wday];
$mon = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
"Sep", "Nov", "Dec")[$mon-1];
"$wday, $mday-$mon-$year $hour:$min:$sec GMT";
}
# thanks Michael Mittelstadt
sub expiretime {
my @a=gmtime(time+$_[0]);
my @w=qw|Sun Mon Tue Wed Thu Fri Sat|;
my @m=qw|Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec|;
sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT",
$w[$a[6]], $a[3], $m[$a[4]], $a[5]+1900, $a[2], $a[1], $a[0];
}
sub expireTime
{
cookietime(time+60*30);
}
sub setvar
{
my ($name, $value)=@_;
sqlUpdate("vars","name=".$dbh->quote($name),(value=>$value));
}
sub newvar
{
my ($name, $value, $desc)=@_;
sqlInsert("vars",(name=>$name, value=>$value, description=>$desc));
}
sub getapptags
{
return @approvedtags;
}
sub generatesession
{
my $user = $_[0];
my $newsid = crypt(rand, $user);
$newsid =~ tr/A-Za-z0-9//dcs;
return $newsid;
}
sub getadmininfo
{
my ($session)=@_;
return ("",-1,"","") unless $session;
my ($aid,$seclev,$section,$url)=("",-1,"","");
# Need to kill older sessions
$dbh->do("DELETE from sessions WHERE now() - lasttime > 10000");
my $c=sqlSelectMany("sessions.aid, authors.seclev, section, url","sessions, authors",
"sessions.aid=authors.aid AND session=".$dbh->quote($session));
if($c and not ($aid, $seclev,$section,$url)=$c->fetchrow_array) {
($aid,$seclev,$section,$url)=("",0,"","");
} else {
sqlUpdate("sessions","session=".$dbh->quote($session),(-lasttime=>'now()'));
}
$c->finish() if $c;
return ($aid, $seclev,$section,$url);
}
sub setadmininfo
{
my ($aid, $pwd)=@_;
my $seclev=0;
my $c=$dbh->prepare("SELECT aid,seclev FROM authors
WHERE aid=".$dbh->quote($aid)."
AND pwd=".$dbh->quote($pwd));
$c->execute();
if(($aid,$seclev)=$c->fetchrow) {
my $sid=generatesession($aid);
$dbh->do("INSERT into sessions
VALUES('$sid','$aid', now(), now(),'')");
print "Set-Cookie: ".$query->cookie(-name=>'session',
-value=>$sid,
-expires=>'+10y')."\n";
} else {
($aid,$seclev)=("",0);
}
$c->finish();
return ($aid,$seclev);
}
sub getfile
{
my $f=$_[0];
open FH,$f;
my $r="";
while() { $r.=$_; }
close FH;
return $r;
}
sub geturl {
use LWP::UserAgent;
use HTTP::Request;
use URI::Escape;
my $ua = new LWP::UserAgent;
my $request = new HTTP::Request('GET', $_[0]);
my $result = $ua->request($request);
if ($result->is_success) { return $result->content;
} else { return 0; }
}
sub prog2file
{
my ($c, $f)=@_;
my $d=`$c`;
$d=~s/[\t\n\r\s ]+/ /g;
if(length($d) > 0) {
open F, ">$f";
print F $d;
close F;
return "1";
} else {
return "0";
}
}
sub url2file
{
my ($u, $f)=@_;
my $d=geturl($u);
if($d ne "0") {
open FH,">$f";
print FH $d;
close FH;
}
}
sub userLogin
{
my($name,$passwd,$expires)=@_;
my $c=$dbh->prepare("SELECT uid FROM users
WHERE passwd=".$dbh->quote(substr($passwd,0,12))."
and nickname=".$dbh->quote($name));
$c->execute();
my $uid;
if(($uid)=$c->fetchrow) {
my $cookie=$uid."::".$passwd;
$cookie=~s/(.)/sprintf("%%%02x",ord($1))/ge;
my $expires='+3h' unless $expires eq "session";
print "Set-Cookie: ".$query->cookie(-name=>'user',
-value=>$cookie,
-expires=>'+10y')."\n";
} else {
$uid=-1;
}
$c->finish();
return ($uid,$passwd);
}
sub userCheckCookie
{
my($cookie)=@_;
$cookie=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
my($uid,$passwd)=split("::",$cookie);
my $c=sqlSelectMany("uid","users",
"uid=".$dbh->quote($uid)." and passwd=".$dbh->quote($passwd));
if ($c) { $uid=-1 unless $c->fetchrow(); }
$c->finish() if $c;
return ($uid, $passwd);
}
sub getUser
{
my($uid,$passwd)=@_;
return sqlSelectHash("*","users","uid=".$dbh->quote($uid));
}
sub getblock
{
my ($bid)=@_;
my ($block)=sqlSelect("block","blocks","bid='$bid'");
return $block;
}
sub getsid
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
$year += 1900;
my $sid=sprintf("%02d/%02d/%02d",$year,$mon+1,$mday)."/".
sprintf("%02d%0d2%02d",$hour,$min,$sec);
return $sid;
}
sub getsiddir
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
$year += 1900;
my $sid=sprintf("%02d/%02d/%02d",$year,$mon+1,$mday)."/";
return $sid;
}
sub writelog
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime;
my $l=sprintf("log%02d%02d%04d.txt",$mon+1,$mday,$year+1900);
if (open(FHandle, ">>$datadir/logs/".$l)){
print (FHandle $ENV{REMOTE_ADDR}."\t".localtime(time)."\t".
$ENV{HTTP_USER_AGENT}."\t".join("\t",@_)."\n");
}
}
sub latestpoll
{
my ($qid)=sqlSelect("qid","pollquestions","","ORDER BY date DESC LIMIT 1");
return $qid;
}
sub pollbooth
{
my $qid=@_[0];
if(not defined $qid) { ($qid)=getvar("currentqid"); }
my $cursor = $dbh->prepare( "
SELECT question,answer,aid from pollquestions, pollanswers
WHERE pollquestions.qid=pollanswers.qid AND
pollquestions.qid='$qid'
ORDER BY pollanswers.aid
");
$cursor->execute;
my $tablestuff;
my $x=0;
while (my ($question, $answer, $aid) = $cursor->fetchrow) {
if($x==0) {
$tablestuff="";
fancybox(200,"Poll",$tablestuff,"c");
$cursor->finish;
}
# A Batch of Useful SQL/Perl Functions by Rob
sub sqlSelectMany
{
my($select,$from,$where,$other)=@_;
my $sql="SELECT $select ";
$sql.="FROM $from " if $from;
$sql.="WHERE $where " if $where;
$sql.="$other" if $other;
# Just make sure...
$dbh||=sqlconnect();
my $c=$dbh->prepare($sql);
if($c->execute()) {
return $c;
} else {
$c->finish();
print "\n
sqlSelectMany Error \n";
return undef;
kill 9,$$
}
}
sub sqlSelect
{
my ($select, $from, $where, $other)=@_;
my $sql="SELECT $select ";
$sql.="FROM $from " if $from;
$sql.="WHERE $where " if $where;
$sql.="$other" if $other;
$dbh||=sqlconnect();
my $c=$dbh->prepare($sql) or die "Sql has gone away\n";
if(not $c->execute()) {
print "\n
SQL Error \n";
return undef;
}
my @r=$c->fetchrow();
$c->finish();
return @r;
}
sub sqlSelectHash
{
my $H=sqlSelectHashref(@_);
return map { $_ => $$H{$_} } keys %$H;
}
sub sqlSelectHashref
{
my ($select, $from, $where, $other)=@_;
my $sql="SELECT $select ";
$sql.="FROM $from " if $from;
$sql.="WHERE $where " if $where;
$sql.="$other" if $other;
$dbh||=sqlconnect();
my $c=$dbh->prepare($sql);
my $H = {};
return $H unless $c->execute();
$H=$c->fetchrow_hashref();
$c->finish();
return $H;
}
sub sqlUpdate
{
my($table,$where,%data)=@_;
my $sql="UPDATE $table SET";
foreach (keys %data) {
if (/^-/) {
s/^-//;
$sql.="\n $_ = $data{-$_} ";
} else {
$sql.="\n $_ = ".$dbh->quote($data{$_}).",";
}
}
chop($sql);
$sql.="\nWHERE $where\n";
$dbh||=sqlconnect();
if(!$dbh->do($sql)) {
open FOO,">>$datadir/logs/updatelog";
print FOO $sql;
close FOO;
}
}
sub sqlInsert
{
my($table,%data)=@_;
my($names,$values);
foreach (keys %data) {
if (/^-/) {$values.="\n ".$data{$_}.","; s/^-//;}
else { $values.="\n ".$dbh->quote($data{$_}).","; }
$names.="$_,";
}
chop($names);
chop($values);
my $sql="INSERT INTO $table ($names) VALUES($values)\n";
$dbh||=sqlconnect();
if(!$dbh->do($sql)) {
open FOO,">>$datadir/logs/insertlog";
print FOO $sql." ".$dbh->errstr;
close FOO;
}
}
sub sqlconnect
{
$dbh ||= DBI->connect("DBI:mysql:slash", "slash", "wegotitallonUHF");
# die "Unable to connect to SQL Server" unless $dbh;
kill 9, $$ unless $dbh;
return \$dbh;
}
# Some Random Dave Code:
sub stripByMode
{
my($str,$fmode,$seclev,@apptag)=@_;
$str=stripBadHtml($str,$seclev,@apptag);
if($fmode eq "plaintext" || $fmode eq "exttrans") {
$str=~s/[\n]/ /gi; # pp breaks
$str=~s/\\/
/gi;
} elsif($fmode eq "exttrans") {
$str=~s/\&/&/g;
$str=~s/\/>/g;
} elsif($fmode eq "nohtml") {
$str=~s/\<(.*?)\>//g;
}
return $str;
}
sub stripBadHtml
{
my ($str,$seclev,@apptag)=@_;
$str =~ s/(\S{90})/$1 /g;
$str =~ s/<(?!.*?>)//;
$str =~ s/<(.*?)>/approvetag($1,@apptag)/sge; #replace tags with approved ones
return $str;
}
sub approvetag
{
my ($tag,@apptag) = @_;
$tag =~ s/^\s*?(.*)\s*?$/$1/e; #trim leading and trailing spaces
if (uc(substr ($tag, 0, 2)) eq 'A ')
{
$tag =~ s/^.*?href="?(.*?)"?$/A HREF="$1"/i; #enforce "s
return "<" . $tag . ">";
}
foreach my $goodtag (@apptag)
{
$tag = uc $tag;
if ($tag eq $goodtag || $tag eq '/' . $goodtag)
{return "<" . $tag . ">";}
#check against my list of tags
}
return "";
}
# Look and Feel Functions Follow this Point
sub header
{
my ($title,$section,$mode,$ssi) =@_;
setupUser($section,$mode);
$title=~s/\<(.*?)\>//g;
print "$title\n" if $title;
if($ssi eq "yes") {
# Meta Expires Tag
print "\n";
ssiHead($section,$mode);
return;
}
my $adhtml=blockCache("advertisement");
my $header=blockCache($section."_header") || blockCache("header");
my $menu=blockCache("mainmenu");
my $menu=prepBlock($menu);
my $vertmenu = $menu = eval $menu;
my $horizmenu=$menu;
$horizmenu=~s/\/|/gi;
my $execme=prepBlock($header);
print eval $execme;
print "\nError:$@\n" if $@;
}
sub footer
{
my ($ssi)=@_;
if($ssi eq "yes") {
ssiFoot();
return;
}
my ($section)=$currentSection;
my $motd=blockCache("motd");
my $closelayer="";
my $block=blockCache($section."_footer") || blockCache("footer");
my $menu=blockCache("mainmenu");
my $menu=prepBlock($menu);
my $vertmenu = $menu = eval $menu;
my $horizmenu=$menu;
$horizmenu=~s/\/|/gi;
my $execme=prepBlock($block);
print eval $execme;
if($@) { print "Error:$@\n" }
}
sub prepEvalBlock
{
my ($b)=@_;
$b=~s/\r//g;
return $b;
}
sub prepBlock
{
my ($b)=@_;
$b=~s/\r//g;
$b=~s/"/\\"/g;
$b="\"$b\";";
return $b;
}
sub nukeBlockCache
{
%blockBank=();
}
sub blockCache
{
my ($bid)=@_;
($blockBank{$bid}) = sqlSelect("block","blocks","bid='$bid'")
unless ($blockBank{$bid});
if(!$blockBank{$bid} or $blockBank{$bid}==-1) {
$blockBank{$bid}=-1;
return "";
} else {
return $blockBank{$bid};
}
}
sub titlebar
{
my ($width, $title) = @_;
my $block=blockCache($currentSection."_titlebar") || blockCache("titlebar");
my $execme=prepBlock($block);
print eval $execme;
if($@) { print "\nError:$@\n" }
}
sub fancybox
{
my ($width, $title, $contents) = @_;
return unless ($title and $contents);
my $mainwidth=$width-4;
my $insidewidth=$mainwidth-8;
my $block=blockCache($currentSection."_fancybox") || blockCache("fancybox");
my $execme=prepBlock($block);
print eval $execme;
if($@) { print "Error:$@\n" }
}
sub printComments2
{
my ($USER,$sid,$pid,$cid)=@_;
$$USER{threshold}||="0";
$pid||="0";
my $message=blockCache("commentswarning")."
\n";
if($$USER{mode} ne "archive") {
$message.=". ( Switch to Flat" : "thread>Threaded";
$message.=" mode ";
$message.=" | Reply" unless getvar("nocomment");
$message.= " ) \<
Down One |
This Page's Threshold: $$USER{threshold} |
Up One > ";
$message.="You are logged in as $$USER{nickname}" if $$USER{uid} > 0;
$message.=" and have $$USER{points} moderator points
left" if $$USER{points};
$message.=" " if $$USER{uid} > 0;
$message.="(Warning:this stuff
might be beta right now) ";
}
my ($commentstatus)=sqlSelect("commentstatus","stories","sid=".$dbh->quote($sid));
my $strsql="SELECT cid,date_format(date,\"\%W \%M \%d, \%Y \@\%h:\%i \%p\") as time,
name,email,url,subject,comment,
nickname,homepage,fakeemail,realname,
users.uid as uid,sig,
comments.points as points,pid,sid,pid
FROM comments,users
WHERE sid=".$dbh->quote($sid);
$strsql.=" AND comments.points >= ".$dbh->quote($$USER{threshold})."
AND comments.uid=users.uid
ORDER BY cid";
my $thisComment=$dbh->prepare($strsql);
$thisComment->execute();
my $comments;
while(my $C=$thisComment->fetchrow_hashref()) {
$$C{commentstatus}=$commentstatus;
$$C{comment}.=" ".$$C{sig};
$$comments[$$C{cid}]=$C;
push @{$$comments[$$C{pid}]->{kids}}, $$C{cid};
}
$thisComment->finish();
# Mess with sort order, eg, @$comments[0]->{kids}
# if($$USER{commentorder} == 1) { Reverse
# } else { randomize }
my $lvl=0 if $$USER{mode} eq "flat" or $$USER{mode} eq "archive";
$lvl=1 if $$USER{mode} eq "index";
print "
\n" if $$USER{seclev};
}
sub displayComments
{
my($USER,$sid,$pid,$lvl,$comments,$cid)=@_;
if($cid) {
my $C=$$comments[$cid];
dispComment($USER,$C) if $cid;
# Next and previous.
my ($n,$p);
my $sibs=$$comments[$$C{pid}]->{kids};
for(my $x=0; $x< @$sibs; $x++) {
($n,$p)=($$sibs[$x+1],$$sibs[$x-1]) if $$sibs[$x] == $cid;
}
print "
";
if($p) {
my $P=$$comments[$p];
print "\<\< $$P{subject}
by $$P{nickname} \n|";
}
if($$C{pid}) {
my $P=$$comments[$$C{pid}];
print " $$P{subject} by $$P{nickname} \n";
}
if($n) {
my $N=$$comments[$n];
print "| $$N{subject}
by $$N{nickname} \>\> \n";
}
print " ";
print "
\n";
}
print "
" if $lvl;
foreach my $cid (@{$$comments[$pid]->{kids}}) {
my $C=$$comments[$cid];
if($lvl<1) {
$$C{ppid}=0;
dispComment($USER,$C);
if($$C{kids}) {
print "
";
my $l=$lvl;
$l++ unless $$USER{mode} eq "archive" or $$USER{mode} eq "flat";
displayComments($USER,$sid,$$C{cid},$l,$comments);
print "
\n";
}
} else {
my $pcnt=@{$$comments[$$C{pid}]->{kids} }+0;
print "
$$C{subject}
by $$C{nickname} on $$C{time} \n" if $pcnt > 49;
print "
$$C{subject}
by $$C{nickname} on $$C{time} \n" if $pcnt < 50;
if($$C{kids}) {
displayComments($USER,$sid,$$C{cid},$lvl+1,$comments);
}
}
}
print "
" if $lvl;
}
sub dispComment
{
my($USER, $C)=@_;
my $subj=$$C{subject};
my $score=$$C{score};
my $time=$$C{time};
my $comment=$$C{comment};
my $username="";
$username="$$C{nickname}($$C{fakeemail})" if $$C{fakeemail};
$username||=$$C{nickname};
$$C{nickname}=~s/ /+/g;
my $userinfo;
$userinfo="(User
Info)" unless $$C{nickname} eq "Anonymous+Coward";
my $userurl="$$C{homepage} " if $$C{homepage};
my $score=" (Score:$$C{points})" if $$C{points};
my $template=blockCache($currentSection."_comment") || blockCache("comment");
my $execme=prepBlock($template);
print eval $execme;
if($@) { print "\nError:$@\n" }
if($$USER{mode} ne "archive") {
my($cid,$sid)=($$C{cid},$$C{sid});
print "
[ ";
print "Reply to
this " if $$USER{commentstatus}==0;
# Go to parent
if($$C{pid} > 0) {
print " | Parent";
}
if($$USER{seclev}>0) {
print " | Moderate -
+
| Reparent 0
1
top ";
}
if($$USER{aseclev}>100) {
print " | cid = $$C{cid} $$C{pid} $$C{ppid} ";
print " | Delete";
print " ";
}
print " ]
\n";
print "
";
}
}
sub dispStory
{
my($USER,$S,$A,$T,$full)=@_;
titlebar("99%",$$S{title});
my $template=blockCache($currentSection."_story") || blockCache("story");
my $bt=$full?"
$$S{bodytext}
":" ";
my $author="$$S{aid}";
# Compatibility layer? :)
my ($tid,$topicimage,$width,$height,$alttext,$date,$dept,$introtext,$bodytext)=
($$T{tid},$$T{image},$$T{width},$$T{height},$$T{alttext},$$S{time},
$$S{dept},$$S{introtext},$bt);
my $execme=prepBlock($template);
print eval $execme;
print "\nError:$@\n" if $@;
}
sub displayStory
{
my ($USER,$sid, $full)=@_;
my $S=sqlSelectHashref("title,dept,time as sqltime,
date_format(time,\"\%W \%M \%d, \%Y \@\%h:\%i \%p\") as time,
introtext,sid,commentstatus,
bodytext,aid,tid,section,commentcount,displaystatus,writestatus",
"stories",
"stories.sid=".$dbh->quote($sid));
my $T=sqlSelectHashref("*","topics","tid=".$dbh->quote($$S{tid}));
my $A=sqlSelectHashref("*","authors","aid=".$dbh->quote($$S{aid}));
dispStory($USER,$S,$A,$T,$full);
return ($S,$A,$T);
}
sub pollItem
{
my ($answer, $imagewidth, $votes, $percent) =@_;
my $pi=blockCache("pollitem");
my $execme=prepBlock($pi);
print eval $execme;
if($@) { print "\nError:$@\n" }
}
# Blame Nate for this one :)
sub sendEmail
{
use Socket;
my ($addr, $subject, $content) = @_;
socket (SMTP, 'PF_INET', 'SOCK_STREAM', getprotobyname('tcp'))
or die "socket $!";
connect (SMTP, sockaddr_in(25, inet_aton("127.0.0.1")))
or die "connect $!";
my $line = ;
send SMTP, "helo localhost\n", 0;
$line = ;
send SMTP, "MAIL FROM:slashdot\@slashdot.org\n", 0;
$line = ;
send SMTP, "RCPT TO:$addr NOTIFY=NEVER\n", 0;
$line = ;
send SMTP, "DATA\n", 0;
$line = ;
send SMTP, "Subject: $subject\n$content\n.\n", 0;
$line = ;
send SMTP, "quit\n", 0;
close(SMTP);
}
sub selectStories
{
my ($SECT,$FORM,$USER,$limit,$tid)=@_;
my $s="SELECT sid, section, title, date_format(time,\"W M d h i p\"),
commentcount, to_days(time)
FROM stories
WHERE ";
$s.=" displaystatus=0 " unless $$FORM{section};
$s.=" (displaystatus>=0 AND '$$SECT{section}'=section)" if $$FORM{section};
$s.=" AND writestatus >= 0 " unless $$USER{seclev} > 100;
$s.=" AND $$FORM{issue} >= to_days(time) " if $$FORM{issue};
$s.=" AND tid='$tid'" if $tid;
$s.=" AND time < now() " unless $$USER{aseclev};
$s.=" ORDER BY time DESC ";
$s.=" LIMIT $limit" if $limit;
$s.=" LIMIT $$SECT{artcount}" unless $limit;
my $cursor=$dbh->prepare($s);
$cursor->execute();
return $cursor;
}
# pass it how many, and what.
sub displayStories
{
my($USER,$cnt,$FORM,$cursor)=@_;
my ($today,$x)=("",0);
TODAY:while(my ($sid,$thissection,$title,$time,$cc)=$cursor->fetchrow()) {
my ($S)=displayStory($USER,$sid);
print linkStory("Read More...",$$FORM{mode},$sid,$thissection);
if($$S{bodytext} or $cc) {
print " (";
print "$cc comment",
$cc>1?"s":"" if $cc;
print ", " if $$S{bodytext} and $cc;
print length($$S{bodytext})." bytes in body"
if($$S{bodytext});
if($$USER{seclev}) {
my ($mods)=sqlSelect("count(lastmod)",
"comments",
"sid='$sid' and lastmod>0");
print ", ",
$mods?$mods:"no",
" moderated comment",
$mods>1?"s":"",
"";
}
print ")";
}
print "
";
my ($w, $m, $d, $h, $min, $ampm)=split(" ",$time);
$today||=$w;
last TODAY if (++$x >= $cnt and $today ne $w );
}
}
sub getOlderStories
{
my ($SECT,$FORM,$USER,$cursor)=@_;
my ($today,$stuff);
$cursor||=selectStories($SECT,$FORM,$USER);
$cursor->execute();
while(my ($sid, $section, $title, $time, $commentcount, $day)=$cursor->fetchrow) {
my ($w, $m, $d, $h, $min, $ampm)=split(" ",$time);
if($today ne $w) {
$today=$w;
$stuff.= "
".linkStory($title,$$FORM{mode},$sid,$section)."
($commentcount)\n";
}
if($$SECT{issue}) {
# KLUDGE:Should really get previous issue with stories;
my ($yesterday)=sqlSelect("to_days(now())-1")
unless $$FORM{issue} > 1 or $$FORM{issue};
$yesterday||=int($$FORM{issue})-1;
my $min=$$SECT{artcount}+$$FORM{min};
$stuff.="
" if $$SECT{issue};
$stuff.=" Older
Articles" if $$SECT{issue}==1 or $$SECT{issue}==3;
$stuff.=" Yesterday's
Edition\n" if $$SECT{issue}==2 or $$SECT{issue}==3;
}
$cursor->finish();
return $stuff;
}
sub CLOSE { $dbh->disconnect() if $dbh; }
![](\"$imagedir/greendot.gif\"){kind=small}
";
print "