1142 lines
39 KiB
Perl
1142 lines
39 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
|
||
|
|
require "$ENV{'LJHOME'}/cgi-bin/ljconfig.pl";
|
||
|
|
require "$ENV{'LJHOME'}/cgi-bin/ljlang.pl";
|
||
|
|
require "$ENV{'LJHOME'}/cgi-bin/ljprotocol.pl";
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
package LJ::Portal;
|
||
|
|
use vars qw(%box %colname);
|
||
|
|
|
||
|
|
%colname = ("left" => "Left Sidebar",
|
||
|
|
"main" => "Main Area",
|
||
|
|
"right" => "Right Sidebar",
|
||
|
|
"moz" => "Mozilla Sidebar",
|
||
|
|
);
|
||
|
|
|
||
|
|
# was using "use constant" here but the error logs filled up with
|
||
|
|
# warnings about redefinitions of subroutines. (constants are subs... great, perl.)
|
||
|
|
my $BOX_NAME = 0;
|
||
|
|
my $BOX_ARGS = 1;
|
||
|
|
my $BOX_POS = 2;
|
||
|
|
my $BOX_DIRTY = 3;
|
||
|
|
|
||
|
|
sub get_box_size
|
||
|
|
{
|
||
|
|
my $loc = shift;
|
||
|
|
return $loc eq "main" ? "large" : "small";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_box_types
|
||
|
|
{
|
||
|
|
my $loc = shift;
|
||
|
|
my $size = get_box_size($loc);
|
||
|
|
return map { $_, $box{$_}->{'name'} } grep { $box{$_}->{$size} } sort keys %box;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub construct_page
|
||
|
|
{
|
||
|
|
my $opts = shift;
|
||
|
|
|
||
|
|
my $body = $opts->{'body'};
|
||
|
|
my $remote = $opts->{'remote'};
|
||
|
|
my $puri = $opts->{'puri'};
|
||
|
|
$opts->{'border'} += 0;
|
||
|
|
|
||
|
|
my %tdopts = ('main' => "",
|
||
|
|
'right' => "width=180",
|
||
|
|
'left' => "width=180",
|
||
|
|
);
|
||
|
|
|
||
|
|
my $portopts = load_portopts($remote);
|
||
|
|
|
||
|
|
$$body .= "<table border=$opts->{'border'} cellpadding=3 width=100% height=500>\n";
|
||
|
|
$$body .= "<tr valign=top>\n";
|
||
|
|
foreach my $loc (@LJ::PORTAL_COLS)
|
||
|
|
{
|
||
|
|
next if ($loc eq "moz");
|
||
|
|
|
||
|
|
$$body .= "<td $tdopts{$loc}>\n";
|
||
|
|
|
||
|
|
$portopts->{$loc} ||= [];
|
||
|
|
foreach my $pbox (@{$portopts->{$loc}})
|
||
|
|
{
|
||
|
|
my $bname = $pbox->[$BOX_NAME];
|
||
|
|
my $bargs = $pbox->[$BOX_ARGS];
|
||
|
|
next unless (ref $box{$bname}->{'handler'} eq "CODE");
|
||
|
|
|
||
|
|
my $args = {};
|
||
|
|
LJ::decode_url_string(\$bargs, $args);
|
||
|
|
|
||
|
|
my $box = $box{$bname};
|
||
|
|
$box->{'key'} = $bname; # so we don't have to set it explicitly
|
||
|
|
$box->{'args'} = $args;
|
||
|
|
$box->{'loc'} = $loc;
|
||
|
|
$box->{'pos'} = "$pbox->[$BOX_POS]";
|
||
|
|
$box->{'uniq'} = "$loc$pbox->[$BOX_POS]";
|
||
|
|
|
||
|
|
$box{$bname}->{'handler'}->($remote, $opts, $box);
|
||
|
|
}
|
||
|
|
|
||
|
|
$$body .= "</td>\n";
|
||
|
|
}
|
||
|
|
$$body .= "</tr>\n";
|
||
|
|
$$body .= "</table>\n";
|
||
|
|
|
||
|
|
if ($opts->{'onload'}) {
|
||
|
|
${$opts->{'bodyopts'}} .= "onLoad=\"" . join('', keys %{$opts->{'onload'}}) . "\"";
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub load_portopts
|
||
|
|
{
|
||
|
|
my $remote = shift;
|
||
|
|
my $dbr = LJ::get_db_reader();
|
||
|
|
|
||
|
|
my $portopts;
|
||
|
|
|
||
|
|
# if user is logged in, see if they've defined their portal box settings:
|
||
|
|
if ($remote)
|
||
|
|
{
|
||
|
|
my $sth = $dbr->prepare("SELECT loc, pos, boxname, boxargs FROM portal WHERE userid=$remote->{'userid'} ORDER BY loc, pos");
|
||
|
|
$sth->execute;
|
||
|
|
while (my $row = $sth->fetchrow_hashref)
|
||
|
|
{
|
||
|
|
push @{$portopts->{$row->{'loc'}}}, [ $row->{'boxname'}, $row->{'boxargs'}, $row->{'pos'} ];
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# if the user isn't logged in, or they haven't defined their portal boxes,
|
||
|
|
# then give them the defaults:
|
||
|
|
unless ($portopts)
|
||
|
|
{
|
||
|
|
if ($remote) {
|
||
|
|
$portopts = $LJ::PORTAL_LOGGED_IN;
|
||
|
|
} else {
|
||
|
|
$portopts = $LJ::PORTAL_LOGGED_OUT;
|
||
|
|
}
|
||
|
|
|
||
|
|
## set the 'pos' argument on each box arrayref
|
||
|
|
## so it doesn't have to be set explicitly in ljconfig.pl, which would be tedious.
|
||
|
|
## also, set the dirty flag to true, so a subsequent save will change it
|
||
|
|
foreach my $loc (keys %$portopts) {
|
||
|
|
for (my $i=0; $i < scalar(@{$portopts->{$loc}}); $i++) {
|
||
|
|
$portopts->{$loc}->[$i]->[$BOX_POS] = $i+1;
|
||
|
|
$portopts->{$loc}->[$i]->[$BOX_DIRTY] = 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
return $portopts;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub count_boxes
|
||
|
|
{
|
||
|
|
my $portopts = shift;
|
||
|
|
my $count = 0;
|
||
|
|
foreach my $loc (keys %$portopts) {
|
||
|
|
for (my $i=0; $i < scalar(@{$portopts->{$loc}}); $i++) {
|
||
|
|
my $box = $portopts->{$loc}->[$i];
|
||
|
|
if ($box->[$BOX_NAME]) { $count++; }
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return $count;
|
||
|
|
}
|
||
|
|
|
||
|
|
# FIXME: portal info should be clustered!
|
||
|
|
sub save_portopts
|
||
|
|
{
|
||
|
|
my $remote = shift;
|
||
|
|
my $portopts = shift;
|
||
|
|
|
||
|
|
my $dbh = LJ::get_db_writer();
|
||
|
|
my $userid = $remote->{'userid'}+0;
|
||
|
|
return unless $userid;
|
||
|
|
|
||
|
|
my @delsql;
|
||
|
|
|
||
|
|
my $sql;
|
||
|
|
foreach my $loc (keys %$portopts) {
|
||
|
|
for (my $i=0; $i < scalar(@{$portopts->{$loc}}); $i++) {
|
||
|
|
my $box = $portopts->{$loc}->[$i];
|
||
|
|
next unless ($box->[$BOX_DIRTY]);
|
||
|
|
|
||
|
|
my $qloc = $dbh->quote($loc);
|
||
|
|
my $qpos = $box->[2] + 0;
|
||
|
|
if ($box->[$BOX_NAME]) {
|
||
|
|
# modifying
|
||
|
|
my $qboxname = $dbh->quote($box->[$BOX_NAME]);
|
||
|
|
my $qboxargs = $dbh->quote($box->[$BOX_ARGS]);
|
||
|
|
$sql ||= "REPLACE INTO portal (userid, loc, pos, boxname, boxargs) VALUES ";
|
||
|
|
$sql .= "($userid, $qloc, $qpos, $qboxname, $qboxargs),";
|
||
|
|
} else {
|
||
|
|
# deleting
|
||
|
|
push @delsql, "DELETE FROM portal WHERE userid=$userid AND loc=$qloc AND pos=$qpos";
|
||
|
|
}
|
||
|
|
$box->[$BOX_DIRTY] = 0;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($sql) {
|
||
|
|
chop $sql;
|
||
|
|
$dbh->do($sql);
|
||
|
|
}
|
||
|
|
foreach (@delsql) {
|
||
|
|
$dbh->do($_);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub delete_box
|
||
|
|
{
|
||
|
|
my $portopts = shift;
|
||
|
|
my $loc = shift;
|
||
|
|
my $pos = shift;
|
||
|
|
my $bname = shift;
|
||
|
|
|
||
|
|
return unless (defined $portopts->{$loc}->[$pos-1]);
|
||
|
|
my $box = $portopts->{$loc}->[$pos-1];
|
||
|
|
return unless ($box->[$BOX_NAME] eq $bname);
|
||
|
|
|
||
|
|
# time to delete it... move everything else up.
|
||
|
|
my $locsize = scalar(@{$portopts->{$loc}});
|
||
|
|
|
||
|
|
# else, move everything else up, and mark the file one dirty;
|
||
|
|
for (my $i=$pos; $i < $locsize; $i++) {
|
||
|
|
$portopts->{$loc}->[$i-1] = $portopts->{$loc}->[$i];
|
||
|
|
$portopts->{$loc}->[$i-1]->[$BOX_POS] = $i;
|
||
|
|
$portopts->{$loc}->[$i-1]->[$BOX_DIRTY] = 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
# final one is dirty and marked for deletion
|
||
|
|
$portopts->{$loc}->[$locsize-1] = [ "", "", $locsize, 1];
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub move_box
|
||
|
|
{
|
||
|
|
my $portopts = shift;
|
||
|
|
my $loc = shift;
|
||
|
|
my $pos = shift;
|
||
|
|
my $bname = shift;
|
||
|
|
my $op = shift;
|
||
|
|
|
||
|
|
return unless (defined $portopts->{$loc}->[$pos-1]);
|
||
|
|
my $box = $portopts->{$loc}->[$pos-1];
|
||
|
|
return unless ($box->[$BOX_NAME] eq $bname);
|
||
|
|
|
||
|
|
# how many are in that column?
|
||
|
|
my $locsize = scalar(@{$portopts->{$loc}});
|
||
|
|
|
||
|
|
# can't move top up or bottom down.
|
||
|
|
return if ($op eq "u" && $pos == 1);
|
||
|
|
return if ($op eq "d" && $pos == $locsize);
|
||
|
|
|
||
|
|
# destination position
|
||
|
|
my $dpos = $pos + ($op eq "u" ? -1 : 1);
|
||
|
|
|
||
|
|
# does that location exist to swap with?
|
||
|
|
return unless (defined $portopts->{$loc}->[$dpos-1]);
|
||
|
|
|
||
|
|
# swap locations!
|
||
|
|
($portopts->{$loc}->[$dpos-1], $portopts->{$loc}->[$pos-1]) =
|
||
|
|
($portopts->{$loc}->[$pos-1], $portopts->{$loc}->[$dpos-1]);
|
||
|
|
|
||
|
|
# set their locations and dirty flags
|
||
|
|
foreach my $p ($pos, $dpos)
|
||
|
|
{
|
||
|
|
$portopts->{$loc}->[$p-1]->[$BOX_POS] = $p;
|
||
|
|
$portopts->{$loc}->[$p-1]->[$BOX_DIRTY] = 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub make_box_modify_form
|
||
|
|
{
|
||
|
|
my $portopts = shift;
|
||
|
|
my $loc = shift;
|
||
|
|
my $pos = shift;
|
||
|
|
|
||
|
|
return "" unless (defined $portopts->{$loc}->[$pos-1]);
|
||
|
|
my $box = $portopts->{$loc}->[$pos-1];
|
||
|
|
|
||
|
|
my $curargs = {};
|
||
|
|
LJ::decode_url_string(\$box->[$BOX_ARGS], $curargs);
|
||
|
|
|
||
|
|
my $ret = "";
|
||
|
|
|
||
|
|
foreach my $opt (@{$box{$box->[$BOX_NAME]}->{'opts'}})
|
||
|
|
{
|
||
|
|
unless ($ret) {
|
||
|
|
$ret .= "<form method=post action=\"/portal/alter.bml\"><input type=hidden name=op value=modbox><input type=hidden name=loc value=$loc><input type=hidden name=pos value=$pos>";
|
||
|
|
}
|
||
|
|
|
||
|
|
$ret .= "<p><b>$opt->{'name'}:</b> ";
|
||
|
|
my $key = $opt->{'key'};
|
||
|
|
if ($opt->{'type'} eq "select") {
|
||
|
|
$ret .= LJ::html_select({ 'name' => "arg_$key",
|
||
|
|
'selected' => $curargs->{$key},
|
||
|
|
'noescape' => 1,
|
||
|
|
},
|
||
|
|
@{$opt->{'values'}});
|
||
|
|
}
|
||
|
|
if ($opt->{'type'} eq "check") {
|
||
|
|
$ret .= LJ::html_check({ 'name' => "arg_$key",
|
||
|
|
'selected' => $curargs->{$key},
|
||
|
|
'value' => 1,
|
||
|
|
});
|
||
|
|
}
|
||
|
|
if ($opt->{'type'} eq "text") {
|
||
|
|
$ret .= LJ::html_text({ 'name' => "arg_$key",
|
||
|
|
'maxlength' => $opt->{'maxlength'},
|
||
|
|
'size' => $opt->{'size'},
|
||
|
|
'value' => $curargs->{$key},
|
||
|
|
});
|
||
|
|
}
|
||
|
|
if ($opt->{'des'}) {
|
||
|
|
$ret .= "<br />$opt->{'des'}";
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
if ($ret) {
|
||
|
|
$ret .= "<p><input type=submit value=\"Save box settings\">";
|
||
|
|
$ret .= "</form>";
|
||
|
|
}
|
||
|
|
|
||
|
|
return $ret;
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub modify_box
|
||
|
|
{
|
||
|
|
my $remote = shift;
|
||
|
|
my $portopts = shift;
|
||
|
|
my $loc = shift;
|
||
|
|
my $pos = shift;
|
||
|
|
my $form = shift;
|
||
|
|
|
||
|
|
return "" unless (defined $portopts->{$loc}->[$pos-1]);
|
||
|
|
my $box = $portopts->{$loc}->[$pos-1];
|
||
|
|
|
||
|
|
my $newargs;
|
||
|
|
|
||
|
|
foreach my $opt (@{$box{$box->[$BOX_NAME]}->{'opts'}})
|
||
|
|
{
|
||
|
|
if ($newargs) { $newargs .= "&"; }
|
||
|
|
$newargs .= LJ::eurl($opt->{'key'}) . "=" . LJ::eurl($form->{"arg_$opt->{'key'}"});
|
||
|
|
$box->[$BOX_ARGS] = $newargs;
|
||
|
|
$box->[$BOX_DIRTY] = 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
save_portopts($remote, $portopts);
|
||
|
|
return $newargs;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub create_new_box
|
||
|
|
{
|
||
|
|
my ($portopts, $bname, $loc) = @_;
|
||
|
|
my $defargs;
|
||
|
|
foreach my $opt (@{$box{$bname}->{'opts'}})
|
||
|
|
{
|
||
|
|
# if non-zero or non-blank default, remember it
|
||
|
|
if ($opt->{'default'}) {
|
||
|
|
$defargs .= "&" if ($defargs);
|
||
|
|
$defargs .= LJ::eurl($opt->{'key'}) . "=" . LJ::eurl($opt->{'default'});
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$portopts->{$loc} ||= [];
|
||
|
|
my $size = scalar(@{$portopts->{$loc}});
|
||
|
|
|
||
|
|
push @{$portopts->{$loc}}, [ $bname, $defargs, $size+1, 1 ];
|
||
|
|
}
|
||
|
|
|
||
|
|
sub make_box_link
|
||
|
|
{
|
||
|
|
my $form = shift;
|
||
|
|
my $bname = $form->{'bname'};
|
||
|
|
|
||
|
|
my $args = "";
|
||
|
|
foreach my $arg (@{$box{$bname}->{'args'}})
|
||
|
|
{
|
||
|
|
my $key = $arg->{'key'};
|
||
|
|
my $val = $form->{"arg_$key"};
|
||
|
|
if ($val) {
|
||
|
|
$args .= "&$key=$val";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
my $title = $box{$bname}->{'name'} . " ($LJ::SITENAME)";
|
||
|
|
|
||
|
|
return "$LJ::SITEROOT/portal/box.bml?bname=$bname$args";
|
||
|
|
}
|
||
|
|
|
||
|
|
# XXXXXXXX DEAD / OLD
|
||
|
|
sub make_mozilla_box
|
||
|
|
{
|
||
|
|
my $remote = shift;
|
||
|
|
my $form = shift;
|
||
|
|
my $opts = shift;
|
||
|
|
|
||
|
|
my $bname = $form->{'bname'};
|
||
|
|
return "" unless (ref $box{$bname}->{'handler'} eq "CODE");
|
||
|
|
|
||
|
|
my $box = $box{$bname};
|
||
|
|
$box->{'key'} = $bname;
|
||
|
|
$box->{'args'} = $form;
|
||
|
|
$box->{'pos'} = "moz";
|
||
|
|
$box->{'loc'} = 1;
|
||
|
|
$box->{'uniq'} = "moz1";
|
||
|
|
$box{$bname}->{'handler'}->($remote, $opts, $box);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub make_mozilla_bar
|
||
|
|
{
|
||
|
|
my $remote = shift;
|
||
|
|
my $form = shift;
|
||
|
|
my $opts = shift;
|
||
|
|
|
||
|
|
my $portopts = load_portopts($remote);
|
||
|
|
my $loc = "moz";
|
||
|
|
|
||
|
|
foreach my $pbox (@{$portopts->{$loc}})
|
||
|
|
{
|
||
|
|
my $bname = $pbox->[$BOX_NAME];
|
||
|
|
my $bargs = $pbox->[$BOX_ARGS];
|
||
|
|
next unless (ref $box{$bname}->{'handler'} eq "CODE");
|
||
|
|
|
||
|
|
my $args = {};
|
||
|
|
LJ::decode_url_string(\$bargs, $args);
|
||
|
|
|
||
|
|
my $box = $box{$bname};
|
||
|
|
$box->{'key'} = $bname; # so we don't have to set it explicitly
|
||
|
|
$box->{'args'} = $args;
|
||
|
|
$box->{'loc'} = $loc;
|
||
|
|
$box->{'pos'} = "$pbox->[$BOX_POS]";
|
||
|
|
$box->{'uniq'} = "$loc$pbox->[$BOX_POS]";
|
||
|
|
|
||
|
|
$box{$bname}->{'handler'}->($remote, $opts, $box);
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
if ($opts->{'onload'}) {
|
||
|
|
${$opts->{'bodyopts'}} .= "onLoad=\"" . join('', keys %{$opts->{'onload'}}) . "\"";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub box_start
|
||
|
|
{
|
||
|
|
my ($b, $box, $opts) = @_;
|
||
|
|
my $title = $opts->{'title'} || $box->{'name'};
|
||
|
|
my $mapname = $box->{'uniq'};
|
||
|
|
my $align = $opts->{'align'} || "left";
|
||
|
|
my $t = join("-", $box->{'key'}, $box->{'loc'}, $box->{'pos'});
|
||
|
|
|
||
|
|
$$b .= "<map name='$mapname'>\n";
|
||
|
|
$$b .= "<area shape='rect' target='_self' coords='0,0,16,16' href='/portal/alter.bml?op=d&t=$t' alt='Down' />\n";
|
||
|
|
$$b .= "<area shape='rect' target='_self' coords='16,0,32,16' href='/portal/alter.bml?op=u&t=$t' alt='Up' />\n";
|
||
|
|
$$b .= "<area shape='rect' coords='32,0,48,16' href='/portal/alter.bml?op=a&t=$t' alt=\"Add/Modify\" />\n";
|
||
|
|
$$b .= "<area shape='rect' target='_self' coords='48,0,64,16' href='/portal/alter.bml?op=x&t=$t' alt='Kill' />\n";
|
||
|
|
$$b .= "</map>\n";
|
||
|
|
|
||
|
|
if ($box->{'pos'} > 1) { $$b .= "<p>"; }
|
||
|
|
$$b .= "<table width='100%' bgcolor='<?emcolor?>' border='0' cellpadding='1' cellspacing='0'>";
|
||
|
|
$$b .= "<tr bgcolor='<?emcolor?>'><td bgcolor='<?emcolor?>'>";
|
||
|
|
$$b .= "<img align='right' width='64' height='16' border='0' src=\"$LJ::IMGPREFIX/knobs.gif\" usemap=\"\#$mapname\" /><b>";
|
||
|
|
|
||
|
|
$$b .= " ";
|
||
|
|
if ($opts->{'url'}) { $$b .= "<a href=\"$opts->{'url'}\">"; }
|
||
|
|
$$b .= $title;
|
||
|
|
if ($opts->{'url'}) { $$b .= "</a>"; }
|
||
|
|
$$b .= "</b></td></tr>\n";
|
||
|
|
|
||
|
|
if ($box->{'loc'} eq "main") {
|
||
|
|
$$b .="</table>\n";
|
||
|
|
} else {
|
||
|
|
$$b .= "<tr><td><table bgcolor='#ffffff' width='100%'><tr><td valign='top' align='$align'>";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub box_end
|
||
|
|
{
|
||
|
|
my ($b, $box) = @_;
|
||
|
|
unless ($box->{'loc'} eq "main")
|
||
|
|
{
|
||
|
|
$$b .= "</td></tr></table>\n";
|
||
|
|
$$b .= "</td></tr></table>\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Load site-specific boxes
|
||
|
|
if (-e "$LJ::HOME/cgi-bin/portal-local.pl") {
|
||
|
|
require "$LJ::HOME/cgi-bin/portal-local.pl";
|
||
|
|
}
|
||
|
|
|
||
|
|
############################################################################
|
||
|
|
|
||
|
|
$box{'login'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.login.portalname _ml?>',
|
||
|
|
'small' => 1,
|
||
|
|
'large' => 0,
|
||
|
|
'handler' => sub {
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $b = $opts->{'body'};
|
||
|
|
|
||
|
|
box_start($b, $box, { 'title' => "Login",
|
||
|
|
'align' => "center",
|
||
|
|
'url' => '/login.bml', });
|
||
|
|
|
||
|
|
my $chal = LJ::challenge_generate(300); # 5 minute auth token
|
||
|
|
|
||
|
|
$$b .= "<form method='post' action='/login.bml' id='portallogin'>";
|
||
|
|
$$b .= "<input type='hidden' name='mode' value='login' />";
|
||
|
|
$$b .= "<table><tr><td align='left'>";
|
||
|
|
$$b .= "<b>Username:</b><br /><input name='user' size='14' maxlength='15' /><br /> ";
|
||
|
|
$$b .= "<b>Password:</b><br /><input name='password' type='password' size='14' /><br />";
|
||
|
|
$$b .= "<input type='checkbox' name='expire' value='never' /> Remember me";
|
||
|
|
$$b .= "<input type='hidden' name='ref' value=\"$LJ::SITEROOT$LJ::PORTAL_URI\" />";
|
||
|
|
$$b .= "<input type='hidden' name='chal' id='login_chal' value='$chal' />";
|
||
|
|
$$b .= "<input type='hidden' name='response' id='login_response' value='' />";
|
||
|
|
$$b .= "</td></tr><tr><td align='right'>";
|
||
|
|
|
||
|
|
$$b .= <<LOGIN;
|
||
|
|
<script language="JavaScript" type='text/javascript'>
|
||
|
|
<!--
|
||
|
|
if (document.getElementById && document.getElementById('portallogin')) {
|
||
|
|
document.write("<img src='$LJ::IMGPREFIX/icon_protected.gif' width='14' height='15' alt='secure login' align='middle' />");
|
||
|
|
document.write(" ");
|
||
|
|
document.write("<input name='action:login' onclick='return sendForm(\\"portallogin\\")' type='submit' value='Login' />");
|
||
|
|
} else {
|
||
|
|
document.write("<input name='action:login' type='submit' value='Login' />");
|
||
|
|
}
|
||
|
|
// -->
|
||
|
|
</script>
|
||
|
|
<noscript>
|
||
|
|
<input name='action:login' type='submit' value='Login' />
|
||
|
|
</noscript>
|
||
|
|
LOGIN
|
||
|
|
$$b .= "</td></tr></table>";
|
||
|
|
|
||
|
|
box_end($b, $box);
|
||
|
|
$$b .= "</form>\n";
|
||
|
|
},
|
||
|
|
};
|
||
|
|
|
||
|
|
############################################################################
|
||
|
|
|
||
|
|
############################################################################
|
||
|
|
|
||
|
|
$box{'stats'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.stats.portalname _ml?>',
|
||
|
|
'small' => 1,
|
||
|
|
'large' => 0,
|
||
|
|
'handler' => sub {
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $dbr = LJ::get_db_reader();
|
||
|
|
my $b = $opts->{'body'};
|
||
|
|
my $sth;
|
||
|
|
my @stats;
|
||
|
|
my ($k, $v);
|
||
|
|
|
||
|
|
box_start($b, $box, { 'title' => BML::ml('portal.stats.portaltitle'),
|
||
|
|
'url' => '/stats.bml' });
|
||
|
|
|
||
|
|
my %stat;
|
||
|
|
$sth = $dbr->prepare("SELECT statkey, statval FROM stats WHERE statcat='statbox'");
|
||
|
|
$sth->execute;
|
||
|
|
while (my ($k, $v) = $sth->fetchrow_array) {
|
||
|
|
$stat{$k} = $v;
|
||
|
|
}
|
||
|
|
|
||
|
|
push @stats, BML::ml('portal.stats.totalusers'), $stat{'totusers'};
|
||
|
|
push @stats, BML::ml('portal.stats.journalentyest'), $stat{'postyester'};
|
||
|
|
|
||
|
|
$$b .= "<table>";
|
||
|
|
while (@stats) {
|
||
|
|
$k = shift @stats;
|
||
|
|
$v = shift @stats;
|
||
|
|
$$b .= "<tr><td><b>$k</b></td></tr>";
|
||
|
|
$$b .= "<tr><td align='right'>$v</td></tr>";
|
||
|
|
}
|
||
|
|
$$b .= "</table>";
|
||
|
|
|
||
|
|
box_end($b, $box);
|
||
|
|
},
|
||
|
|
};
|
||
|
|
|
||
|
|
############################################################################
|
||
|
|
|
||
|
|
$box{'bdays'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.bdays.portalname _ml?>',
|
||
|
|
'small' => 1,
|
||
|
|
'large' => 0,
|
||
|
|
'opts' => [ { 'key' => 'count',
|
||
|
|
'name' => '<?_ml portal.bdays.count.name _ml?>',
|
||
|
|
'des' => '<?_ml portal.bdays.count.des _ml?>',
|
||
|
|
'type' => 'text',
|
||
|
|
'maxlength' => 3,
|
||
|
|
'size' => 3,
|
||
|
|
'default' => 5 },
|
||
|
|
],
|
||
|
|
'handler' => sub {
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $dbr = LJ::get_db_reader();
|
||
|
|
my $bd = $opts->{'body'};
|
||
|
|
my $sth;
|
||
|
|
|
||
|
|
box_start($bd, $box, { 'title' => BML::ml('portal.bdays.portaltitle'),
|
||
|
|
'url' => '/birthdays.bml' });
|
||
|
|
|
||
|
|
# TAG:FR:portal:get_bdays
|
||
|
|
$sth = $dbr->prepare("SELECT u.user, MONTH(bdate) AS 'month', DAYOFMONTH(bdate) AS 'day' FROM friends f, user u WHERE f.userid=$remote->{'userid'} AND f.friendid=u.userid AND u.journaltype='P' AND u.statusvis='V' AND u.allow_infoshow='Y' AND MONTH(bdate) != 0 AND DAYOFMONTH(bdate) != 0");
|
||
|
|
$sth->execute;
|
||
|
|
|
||
|
|
# what day is it now? server time... suck, yeah.
|
||
|
|
my @time = localtime();
|
||
|
|
my ($mnow, $dnow) = ($time[4]+1, $time[3]);
|
||
|
|
|
||
|
|
my @bdays;
|
||
|
|
while (my ($user, $m, $d) = $sth->fetchrow_array) {
|
||
|
|
my $ref = [ $user, $m, $d ];
|
||
|
|
if ($m < $mnow || ($m == $mnow && $d < ($dnow))) {
|
||
|
|
# birthday passed this year already
|
||
|
|
$ref->[3] = 1;
|
||
|
|
}
|
||
|
|
push @bdays, $ref;
|
||
|
|
}
|
||
|
|
|
||
|
|
# sort birthdays that have passed this year after ones that haven't,
|
||
|
|
# otherwise sort by month, otherwise by day.
|
||
|
|
@bdays = sort {
|
||
|
|
|
||
|
|
# passed sort
|
||
|
|
($a->[3] <=> $b->[3]) ||
|
||
|
|
|
||
|
|
# month sort
|
||
|
|
($a->[1] <=> $b->[1]) ||
|
||
|
|
|
||
|
|
|
||
|
|
# day sort
|
||
|
|
($a->[2] <=> $b->[2])
|
||
|
|
|
||
|
|
} @bdays;
|
||
|
|
|
||
|
|
# cut the list down
|
||
|
|
my $show = ($box->{'args'}->{'count'} + 0) || 10;
|
||
|
|
if ($show > 100) { $show = 100; }
|
||
|
|
if (@bdays > $show) { @bdays = @bdays[0..$show-1]; }
|
||
|
|
|
||
|
|
$$bd .= "<table width='100%'>";
|
||
|
|
my $add_ord = BML::get_language() =~ /^en/i;
|
||
|
|
foreach my $bi (@bdays)
|
||
|
|
{
|
||
|
|
my $mon = BML::ml( LJ::Lang::month_short_langcode($bi->[1]) );
|
||
|
|
my $day = $bi->[2];
|
||
|
|
$day .= LJ::Lang::day_ord($bi->[2]) if $add_ord;
|
||
|
|
|
||
|
|
$$bd .= "<tr><td nowrap='nowrap'><b>" . LJ::ljuser($bi->[0]) . "</b></td>";
|
||
|
|
$$bd .= "<td align='right' nowrap='nowrap'>$mon $day</td></tr>";
|
||
|
|
}
|
||
|
|
$$bd .= "</table>";
|
||
|
|
|
||
|
|
box_end($bd, $box);
|
||
|
|
},
|
||
|
|
};
|
||
|
|
############################################################################
|
||
|
|
|
||
|
|
$box{'lastnview'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.recent.portalname _ml?>',
|
||
|
|
'small' => 1,
|
||
|
|
'large' => 1,
|
||
|
|
'opts' => [ { 'key' => 'journal',
|
||
|
|
'name' => '<?_ml portal.recent.journal.name _ml?>',
|
||
|
|
'des' => '<?_ml portal.recent.journal.description _ml?>',
|
||
|
|
'type' => 'text',
|
||
|
|
'maxlength' => 15,
|
||
|
|
'size' => 15,
|
||
|
|
'default' => '' },
|
||
|
|
{ 'key' => 'items',
|
||
|
|
'name' => '<?_ml portal.recent.items.name _ml?>',
|
||
|
|
'des' => '<?_ml portal.recent.items.description _ml?>',
|
||
|
|
'type' => 'text',
|
||
|
|
'maxlength' => 2,
|
||
|
|
'size' => 2,
|
||
|
|
'default' => 1 },
|
||
|
|
{ 'key' => 'showtext',
|
||
|
|
'name' => '<?_ml portal.recent.showtext.name _ml?>',
|
||
|
|
'des' => '<?_ml portal.recent.showtext.description _ml?>',
|
||
|
|
'type' => 'check',
|
||
|
|
'value' => 1,
|
||
|
|
'default' => 0 },
|
||
|
|
],
|
||
|
|
'handler' => sub {
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $bd = $opts->{'body'};
|
||
|
|
my $sth;
|
||
|
|
|
||
|
|
my $user = LJ::canonical_username($box->{'args'}->{'journal'});
|
||
|
|
my $items = $box->{'args'}->{'items'}+0 || 1;
|
||
|
|
if ($items > 50) { $items = 50; }
|
||
|
|
|
||
|
|
unless ($user)
|
||
|
|
{
|
||
|
|
box_start($bd, $box,{'title' => BML::ml('portal.recent.portaltitle') ,});
|
||
|
|
$$bd .= BML::ml('portal.recent.error.notsetup');
|
||
|
|
box_end($bd, $box);
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $u = LJ::load_user($user);
|
||
|
|
my $dbcr = LJ::get_cluster_reader($u);
|
||
|
|
|
||
|
|
box_start($bd, $box, { 'title' => "$u->{'name'}",
|
||
|
|
'url' => "$LJ::SITEROOT/users/$user" });
|
||
|
|
|
||
|
|
unless ($u->{'statusvis'} eq "V") {
|
||
|
|
$$bd .= BML::ml('portal.recent.error.userstatus');
|
||
|
|
box_end($bd, $box);
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
my @itemids;
|
||
|
|
my @items = LJ::get_recent_items({
|
||
|
|
'clustersource' => 'slave',
|
||
|
|
'clusterid' => $u->{'clusterid'},
|
||
|
|
'remote' => $remote,
|
||
|
|
'userid' => $u->{'userid'},
|
||
|
|
'skip' => 0,
|
||
|
|
'itemshow' => $items,
|
||
|
|
'itemids' => \@itemids,
|
||
|
|
'order' => ($u->{'journaltype'} eq "C") ? "logtime" : "",
|
||
|
|
});
|
||
|
|
|
||
|
|
unless(@itemids) {
|
||
|
|
$$bd .= BML::ml('portal.recent.error.noentries');
|
||
|
|
box_end($bd, $box);
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
my %logprops = ();
|
||
|
|
my $text = LJ::get_logtext2($u, @itemids);
|
||
|
|
|
||
|
|
my %posteru = (); # map posterids to u objects
|
||
|
|
LJ::load_userids_multiple([map { $_->{'posterid'}, \$posteru{$_->{'posterid'}} } @items], [$u]);
|
||
|
|
# Loads the log table into cache, in the unlikely event that it is not already in cache
|
||
|
|
LJ::load_log_props2($dbcr, $u->{'userid'}, \@itemids, \%logprops);
|
||
|
|
|
||
|
|
foreach my $i (@items) {
|
||
|
|
next if $posteru{$i->{'posterid'}}->{'statusvis'} eq 'S';
|
||
|
|
|
||
|
|
my $itemid = $i->{'itemid'};
|
||
|
|
my $event = $text->{$itemid}->[1];
|
||
|
|
my $subject = $text->{$itemid}->[0];
|
||
|
|
LJ::CleanHTML::clean_subject(\$subject) if ($subject);
|
||
|
|
$subject ||= "(no subject)";
|
||
|
|
|
||
|
|
LJ::CleanHTML::clean_event(\$event,
|
||
|
|
{ 'preformatted' => $logprops{$itemid}->{'opt_preformatted'} }) if ($event);
|
||
|
|
|
||
|
|
my $linkurl = "<a href='" . LJ::item_link($u, $itemid, $i->{'anum'}) . "'><b>(Link)</b></a>";
|
||
|
|
if ($box->{'args'}->{'showtext'}) {
|
||
|
|
$$bd .= "<b>$subject</b> $linkurl<br />";
|
||
|
|
$$bd .= "$event<br />";
|
||
|
|
} else {
|
||
|
|
$$bd .= "$subject $linkurl<br />";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
box_end($bd, $box);
|
||
|
|
},
|
||
|
|
};
|
||
|
|
|
||
|
|
############################################################################
|
||
|
|
|
||
|
|
|
||
|
|
$box{'update'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.update.portalname _ml?>',
|
||
|
|
'small' => 0,
|
||
|
|
'large' => 1,
|
||
|
|
'opts' => [ { 'key' => 'mode',
|
||
|
|
'name' => '<?_ml portal.update.mode.name _ml?>',
|
||
|
|
'type' => 'select',
|
||
|
|
'des' => '<?_ml portal.update.mode.des _ml?>',
|
||
|
|
'values' => [ "", '<?_ml portal.update.mode.simple _ml?>',
|
||
|
|
"full", '<?_ml portal.update.mode.full _ml?>' ],
|
||
|
|
'default' => "" },
|
||
|
|
],
|
||
|
|
'handler' => sub
|
||
|
|
{
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $bd = $opts->{'body'};
|
||
|
|
my $h = $opts->{'head'};
|
||
|
|
|
||
|
|
$opts->{'onload'}->{"settime(document.updateForm$box->{'uniq'});"} = 1;
|
||
|
|
|
||
|
|
box_start($bd, $box, {'title' => BML::ml('portal.update.portalname'),
|
||
|
|
'url' => "$LJ::SITEROOT/update.bml",
|
||
|
|
});
|
||
|
|
|
||
|
|
my $mode = $opts->{'form'}->{'mode'} || $box->{'args'}->{'mode'};
|
||
|
|
|
||
|
|
my $chal = LJ::challenge_generate(300); # 5 minute auth token
|
||
|
|
$$bd .= "<form method='post' action='$LJ::SITEROOT/update.bml' id='updatebox' name='updateForm$box->{'uniq'}'>";
|
||
|
|
$$bd .= "<input type='hidden' name='chal' id='login_chal' value='$chal' />";
|
||
|
|
$$bd .= "<input type='hidden' name='response' id='login_response' value='' />";
|
||
|
|
|
||
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
|
||
|
|
$year+=1900;
|
||
|
|
$mon=sprintf("%02d", $mon+1);
|
||
|
|
$mday=sprintf("%02d", $mday);
|
||
|
|
$min=sprintf("%02d", $min);
|
||
|
|
|
||
|
|
$$bd .= "<table>";
|
||
|
|
if ($remote) {
|
||
|
|
$$bd .= "<tr><td><b>Logged in user:</b> $remote->{'user'} (<a href=\"$LJ::SITEROOT/update.bml?altlogin=1\">other user?</a>)</td></tr>\n";
|
||
|
|
} else {
|
||
|
|
$$bd .= "<tr><td><b>User:</b> <input name=user size=10 maxlength=15> ";
|
||
|
|
$$bd .= "<b>Password:</b> <input type=password name=password size=10> ";
|
||
|
|
$$bd .= "</td></tr>";
|
||
|
|
}
|
||
|
|
$$bd .= "</table>";
|
||
|
|
|
||
|
|
$$bd .= "<table><tr><td><b>Date:</b> <tt>yyyy-mm-dd</tt></td><td><b>Local time:</b> <tt>hh:mm</tt> (24 hour time)</td></tr>\n";
|
||
|
|
$$bd .= "<tr><td><INPUT NAME=year SIZE=4 MAXLENGTH=4 VALUE=$year>-";
|
||
|
|
$$bd .= "<INPUT NAME=mon SIZE=2 MAXLENGTH=2 VALUE=$mon>-";
|
||
|
|
$$bd .= "<INPUT NAME=day SIZE=2 MAXLENGTH=2 VALUE=$mday> </td>";
|
||
|
|
|
||
|
|
$$bd .= "<td><INPUT NAME=hour SIZE=3 MAXLENGTH=2 VALUE=$hour>:";
|
||
|
|
$$bd .= "<INPUT NAME=min SIZE=3 MAXLENGTH=2 VALUE=$min></td></tr></table>\n";
|
||
|
|
|
||
|
|
|
||
|
|
$$bd .= "<noscript><p style=\"font-size: 0.85em;\"><b>Note:</b> The time/date above is from our server. Correct them for your timezone before posting.</p></noscript>";
|
||
|
|
|
||
|
|
$$bd .= "<TABLE><TR><TD><B>Subject:</B> <I>(optional)</I><BR>";
|
||
|
|
$$bd .= "<INPUT NAME=\"subject\" SIZE=50 MAXLENGTH=100 VALUE=\"" . LJ::ehtml($opts->{'form'}->{'subject'}) . "\"><br>";
|
||
|
|
|
||
|
|
$$bd .= "<B>Event:</B><BR>";
|
||
|
|
$$bd .= "<TEXTAREA NAME=\"event\" COLS=50 ROWS=10 WRAP=VIRTUAL>";
|
||
|
|
$$bd .= LJ::ehtml($opts->{'form'}->{'event'});
|
||
|
|
$$bd .= "</TEXTAREA>";
|
||
|
|
$$bd .= "<BR><?de (HTML okay; by default, newlines will be auto-formatted to <TT><BR></TT>) de?><BR>";
|
||
|
|
$$bd .= "<input type=checkbox name=do_spellcheck value=1 id=\"spellcheck\"> <label for=\"spellcheck\">Spell check entry before posting</label>";
|
||
|
|
$$bd .= "</TD></TR><TR><TD ALIGN=CENTER>";
|
||
|
|
|
||
|
|
$$bd .= <<UPDATE;
|
||
|
|
<script language="JavaScript" type='text/javascript'>
|
||
|
|
<!--
|
||
|
|
if (document.getElementById && document.getElementById('updatebox')) {
|
||
|
|
document.write("<input onclick='return sendForm(\\"updatebox\\")' type='submit' value='Update Journal' />");
|
||
|
|
} else {
|
||
|
|
document.write("<input type='submit' value='Update Journal' />");
|
||
|
|
}
|
||
|
|
document.write(" <input type='submit' name='action:preview' value='Preview' />");
|
||
|
|
// -->
|
||
|
|
</script>
|
||
|
|
<noscript>
|
||
|
|
<input type='submit' value='Update Journal' />
|
||
|
|
|
||
|
|
<input type='submit' name='action:preview' value='Preview' />
|
||
|
|
</noscript>
|
||
|
|
UPDATE
|
||
|
|
$$bd .= "</TD></TR>";
|
||
|
|
|
||
|
|
if ($mode eq "full")
|
||
|
|
{
|
||
|
|
my %res;
|
||
|
|
|
||
|
|
if (! $opts->{'form'}->{'altlogin'} && $remote)
|
||
|
|
{
|
||
|
|
LJ::do_request({ "mode" => "login",
|
||
|
|
"ver" => $LJ::PROTOCOL_VER,
|
||
|
|
"user" => $remote->{'user'},
|
||
|
|
"getpickws" => 1,
|
||
|
|
}, \%res, { "noauth" => 1, "userid" => $remote->{'userid'} });
|
||
|
|
}
|
||
|
|
|
||
|
|
$$bd .= "<tr><td nowrap='nowrap'><input type='hidden' name='webversion' value='full' /><?h2 Optional Settings h2?>";
|
||
|
|
|
||
|
|
if ($res{'access_count'}) {
|
||
|
|
$$bd .= "<p><b>Journal to post in: </b> ";
|
||
|
|
my @access;
|
||
|
|
for (my $i=1; $i<=$res{'access_count'}; $i++) {
|
||
|
|
push @access, $res{"access_$i"};
|
||
|
|
}
|
||
|
|
$$bd .= LJ::html_select({ 'name' => 'usejournal', 'selected' => $opts->{'form'}->{'usejournal'}, },
|
||
|
|
"", "($remote->{'user'}) -- default", map { $_, $_ } @access);
|
||
|
|
}
|
||
|
|
|
||
|
|
$$bd .= "<P><B>Security Level:</B> ";
|
||
|
|
$$bd .= LJ::html_select({ 'name' => 'security', 'selected' => $opts->{'form'}->{'security'}, },
|
||
|
|
"public", "Public",
|
||
|
|
"private", "Private",
|
||
|
|
"friends", "Friends");
|
||
|
|
$$bd .= LJ::help_icon("security", " ");
|
||
|
|
my $checked;
|
||
|
|
$checked = $opts->{'form'}->{'prop_opt_preformatted'} ? "CHECKED" : "";
|
||
|
|
$$bd .= "<P> <B>Don't auto-format:</B><INPUT TYPE=CHECKBOX NAME=\"prop_opt_preformatted\" VALUE=1 $checked>";
|
||
|
|
$$bd .= LJ::help_icon("noautoformat", " ");
|
||
|
|
$$bd .= " ";
|
||
|
|
$checked = $opts->{'form'}->{'prop_opt_nocomments'} ? "CHECKED" : "";
|
||
|
|
$$bd .= "<B>Disallow Comments:</B><INPUT TYPE=CHECKBOX NAME=\"prop_opt_nocomments\" VALUE=1 $checked>";
|
||
|
|
|
||
|
|
$checked = $opts->{'form'}->{'prop_opt_backdated'} ? "CHECKED" : "";
|
||
|
|
$$bd .= "<P><b>Backdate Entry:</b><INPUT TYPE=CHECKBOX NAME=\"prop_opt_backdated\" VALUE=1 $checked> (will only show on calendar)";
|
||
|
|
|
||
|
|
if ($res{'pickw_count'}) {
|
||
|
|
$$bd .= "<P><B>Picture to use:</B> ";
|
||
|
|
my @pics;
|
||
|
|
for (my $i=1; $i<=$res{'pickw_count'}; $i++) {
|
||
|
|
push @pics, $res{"pickw_$i"};
|
||
|
|
}
|
||
|
|
@pics = sort { lc($a) cmp lc($b) } @pics;
|
||
|
|
$$bd .= LJ::html_select({'name' => 'prop_picture_keyword',
|
||
|
|
'selected' => $opts->{'form'}->{'prop_picture_keyword'}, },
|
||
|
|
("", "(default)", map { ($_, $_) } @pics));
|
||
|
|
$$bd .= LJ::help_icon("userpics", " ");
|
||
|
|
} else {
|
||
|
|
$$bd .= "<P><B>$res{'errmsg'}</B>";
|
||
|
|
}
|
||
|
|
|
||
|
|
$$bd .= "<P><B>Current <A HREF=\"/moodlist.bml\">Mood</A>:</B>";
|
||
|
|
|
||
|
|
my @sel;
|
||
|
|
my $moods = LJ::get_moods();
|
||
|
|
foreach my $moodid (sort { $moods->{$a}->{'name'} cmp $moods->{$b}->{'name'} } keys %$moods)
|
||
|
|
{
|
||
|
|
push @sel, $moodid, $moods->{$moodid}->{'name'};
|
||
|
|
}
|
||
|
|
|
||
|
|
$$bd .= LJ::html_select({'name' => 'prop_current_moodid',
|
||
|
|
'selected' => $opts->{'form'}->{'prop_current_moodid'}, },
|
||
|
|
("", "None, or other:", @sel));
|
||
|
|
|
||
|
|
$$bd .= "Other: <INPUT NAME=\"prop_current_mood\" SIZE=15 MAXLENGTH=30 VALUE=\"" . LJ::ehtml($opts->{'form'}->{'prop_current_mood'}) . "\">";
|
||
|
|
$$bd .= "<P><B>Current Music:</B> <INPUT NAME=\"prop_current_music\" SIZE=40 MAXLENGTH=60 VALUE=\"" . LJ::ehtml($opts->{'form'}->{'prop_current_music'}) . "\">";
|
||
|
|
$$bd .= '<p><b>Tags:</b> ';
|
||
|
|
$$bd .= LJ::html_text(
|
||
|
|
{
|
||
|
|
'name' => 'prop_taglist',
|
||
|
|
'size' => '35',
|
||
|
|
'maxlength' => '255',
|
||
|
|
}
|
||
|
|
);
|
||
|
|
$$bd .= "</p></TD></TR><TR><TD ALIGN=CENTER><INPUT TYPE=SUBMIT VALUE=\"Update Journal\"></td></tr>";
|
||
|
|
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$$bd .= "<tr><td><?de For more options, modify this portal box or <a href=\"$LJ::SITEROOT/update.bml?mode=full\">go here</a>. de?></td></tr>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
$$bd .= "</TABLE></FORM>";
|
||
|
|
|
||
|
|
$$h .= <<'JAVASCRIPT_STUFF';
|
||
|
|
<SCRIPT LANGUAGE="JavaScript"><!--
|
||
|
|
// for those of you reading the source.... the server will
|
||
|
|
// automatically fill in the form with the time values for
|
||
|
|
// the west coast, but what this does is if the client can
|
||
|
|
// use JavaScript (nearly 99% of the time nowadays), we'll
|
||
|
|
// prefill the time in from their computer's clock
|
||
|
|
function settime(f) {
|
||
|
|
function twodigit (n) {
|
||
|
|
if (n < 10) { return "0" + n; }
|
||
|
|
else { return n; }
|
||
|
|
}
|
||
|
|
|
||
|
|
now = new Date();
|
||
|
|
// javascript getYear method is really brain-dead:
|
||
|
|
f.year.value = now.getYear() < 1900 ? now.getYear() + 1900 : now.getYear();
|
||
|
|
f.mon.value = twodigit(now.getMonth()+1);
|
||
|
|
f.day.value = twodigit(now.getDate());
|
||
|
|
f.hour.value = twodigit(now.getHours());
|
||
|
|
f.min.value = twodigit(now.getMinutes());
|
||
|
|
}
|
||
|
|
|
||
|
|
// --></SCRIPT>
|
||
|
|
JAVASCRIPT_STUFF
|
||
|
|
|
||
|
|
box_end($bd, $box);
|
||
|
|
|
||
|
|
|
||
|
|
},
|
||
|
|
};
|
||
|
|
|
||
|
|
####################################
|
||
|
|
|
||
|
|
## TODO: let user specify number of random people, and have them
|
||
|
|
## go horizontally or vertically.
|
||
|
|
$box{'randuser'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.randuser.portalname _ml?>',
|
||
|
|
'small' => 1,
|
||
|
|
'large' => 1,
|
||
|
|
'opts' => [ { 'key' => 'hidepic',
|
||
|
|
'name' => '<?_ml portal.randuser.hidepic.name _ml?>',
|
||
|
|
'type' => 'check',
|
||
|
|
'des' => '<?_ml portal.randuser.hidepic.des _ml?>',
|
||
|
|
'default' => 0 },
|
||
|
|
{ 'key' => 'hidename',
|
||
|
|
'name' => '<?_ml portal.randuser.hidename.name _ml?>',
|
||
|
|
'type' => 'check',
|
||
|
|
'des' => '<?_ml portal.randuser.hidename.des _ml?>',
|
||
|
|
'default' => 0 },
|
||
|
|
{ 'key' => 'count',
|
||
|
|
'name' => '<?_ml portal.randuser.count.name _ml?>',
|
||
|
|
'des' => "<?_ml portal.randuser.count.des _ml?>",
|
||
|
|
'type' => 'text',
|
||
|
|
'maxlength' => 2,
|
||
|
|
'size' => 2,
|
||
|
|
'default' => 1 },
|
||
|
|
],
|
||
|
|
'handler' => sub
|
||
|
|
{
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $dbr = LJ::get_db_reader();
|
||
|
|
my $b = $opts->{'body'};
|
||
|
|
my $h = $opts->{'head'};
|
||
|
|
|
||
|
|
my $size = get_box_size($box->{'loc'});
|
||
|
|
my $count = int($box->{'args'}->{'count'});
|
||
|
|
if ($count < 1) { $count = 1; }
|
||
|
|
if ($size eq "small" && $count > 5) { $count = 5; }
|
||
|
|
if ($size eq "large" && $count > 10) { $count = 10; }
|
||
|
|
|
||
|
|
my $max = $dbr->selectrow_array("SELECT statval FROM stats WHERE statcat='userinfo' AND statkey='randomcount'");
|
||
|
|
$count = $max if ($count > $max);
|
||
|
|
my %ruserid;
|
||
|
|
while (keys %ruserid < $count) {
|
||
|
|
$ruserid{int(rand($max))+1} = 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
unless ($count) {
|
||
|
|
box_start($b, $box, {'title' => BML::ml('portal.randuser.portaltitle'),
|
||
|
|
'align' => "center",
|
||
|
|
});
|
||
|
|
$$b .= BML::ml('portal.randuser.error.tableempty');
|
||
|
|
box_end($b, $box);
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
box_start($b, $box, {
|
||
|
|
'title' => (keys %ruserid > 1 ? BML::ml('portal.randuser.portaltitleplural') : BML::ml('portal.randuser.portaltitle')),
|
||
|
|
'align' => "center",
|
||
|
|
});
|
||
|
|
|
||
|
|
my @ruser;
|
||
|
|
my $sth = $dbr->prepare(qq{
|
||
|
|
SELECT userid, user, name, defaultpicid FROM user WHERE userid IN
|
||
|
|
} . "(" . join(",", keys %ruserid) . ")");
|
||
|
|
$sth->execute;
|
||
|
|
push @ruser, $_ while $_ = $sth->fetchrow_hashref;
|
||
|
|
|
||
|
|
my %pic;
|
||
|
|
unless ($box->{'args'}->{'hidepic'}) {
|
||
|
|
LJ::load_userpics(\%pic, [ map { [ $_, $_->{'defaultpicid'} ] } @ruser ]);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($size eq "large") { $$b .= "<table width=100%><tr valign=bottom>"; }
|
||
|
|
|
||
|
|
my $rct = 1;
|
||
|
|
foreach my $r (@ruser)
|
||
|
|
{
|
||
|
|
if ($size eq "large") { $$b .= "<td align=center>"; }
|
||
|
|
elsif ($size eq "small" && $rct > 1) { $$b .= "<p>"; }
|
||
|
|
|
||
|
|
my $picid = $r->{'defaultpicid'};
|
||
|
|
if ($picid && ! $box->{'args'}->{'hidepic'}) {
|
||
|
|
$$b .= "<img src=\"$LJ::USERPIC_ROOT/$picid/$r->{'userid'}\" width=$pic{$picid}->{'width'} height=$pic{$picid}->{'height'}><br>";
|
||
|
|
}
|
||
|
|
$$b .= "<?ljuser $r->{'user'} ljuser?>";
|
||
|
|
unless ($box->{'args'}->{'hidename'}) {
|
||
|
|
$$b .= "<br>" . LJ::ehtml($r->{'name'});
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($size eq "large") { $$b .= "</td>"; }
|
||
|
|
$rct++;
|
||
|
|
}
|
||
|
|
if ($size eq "large") { $$b .= "</tr></table>"; }
|
||
|
|
|
||
|
|
box_end($b, $box);
|
||
|
|
}
|
||
|
|
};
|
||
|
|
|
||
|
|
$box{'popfaq'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.popfaq.portalname _ml?>',
|
||
|
|
'small' => 1,
|
||
|
|
'large' => 0,
|
||
|
|
'handler' => sub {
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $b = $opts->{'body'};
|
||
|
|
|
||
|
|
box_start($b, $box, { 'title' => BML::ml('portal.popfaq.portaltitle'),
|
||
|
|
'align' => "left",
|
||
|
|
'url' => '/support/faqpop.bml', });
|
||
|
|
my $dbr = LJ::get_db_reader();
|
||
|
|
|
||
|
|
my $sth = $dbr->prepare("SELECT f.faqid, f.question, s.statval AS 'uses' ".
|
||
|
|
"FROM faq f, stats s WHERE f.faqcat<>'int-abuse' AND s.statcat='popfaq' ".
|
||
|
|
"AND s.statkey=f.faqid ORDER BY s.statval DESC LIMIT 10");
|
||
|
|
$sth->execute;
|
||
|
|
|
||
|
|
$$b .= "<ul>";
|
||
|
|
while (my $f = $sth->fetchrow_hashref)
|
||
|
|
{
|
||
|
|
my $q = LJ::ehtml($f->{'question'});
|
||
|
|
$q =~ s/^\s+//; $q =~ s/\s+$//;
|
||
|
|
$q =~ s/\n/<BR>/g;
|
||
|
|
$$b .= "<li><a href=\"/support/faqbrowse.bml?faqid=$f->{'faqid'}\">$q</a> <i>($f->{'uses'})</i></li>\n";
|
||
|
|
}
|
||
|
|
$$b .= "</ul>\n";
|
||
|
|
box_end($b, $box);
|
||
|
|
},
|
||
|
|
};
|
||
|
|
|
||
|
|
############################################################################
|
||
|
|
|
||
|
|
$box{'memories'} =
|
||
|
|
{
|
||
|
|
'name' => '<?_ml portal.memories.portalname _ml?>',
|
||
|
|
'small' => 1,
|
||
|
|
'large' => 0,
|
||
|
|
'handler' => sub {
|
||
|
|
my ($remote, $opts, $box) = @_;
|
||
|
|
my $dbr = LJ::get_db_reader();
|
||
|
|
my $b = $opts->{'body'};
|
||
|
|
|
||
|
|
box_start($b, $box, { 'title' => BML::ml('portal.memories.portaltitle'),
|
||
|
|
'url' => '/tools/memories.bml', });
|
||
|
|
|
||
|
|
my $userid = $remote->{'userid'};
|
||
|
|
my $kws = LJ::Memories::get_keywords($remote);
|
||
|
|
my $kwcs = LJ::Memories::get_keyword_counts($remote);
|
||
|
|
my $rows = 0;
|
||
|
|
foreach my $id (sort { $kwcs->{$a} <=> $kwcs->{$b} } keys %{$kwcs || {}})
|
||
|
|
{
|
||
|
|
$$b .= "<ul>" if ++$rows == 1;
|
||
|
|
my $noun = $kwcs->{$id} == 1 ? BML::ml('portal.memories.entrynoun') : BML::ml('portal.memories.entriesnoun');
|
||
|
|
my $ue_keyword = LJ::eurl($kws->{$id});
|
||
|
|
my $keyword = $kws->{$id};
|
||
|
|
LJ::text_out(\$keyword);
|
||
|
|
if ($keyword eq "*") { $keyword = BML::ml('/tools/memories.bml.uncategorized'); }
|
||
|
|
$$b .= "<li><b><a href=\"/tools/memories.bml?user=$remote->{'user'}&keyword=$ue_keyword&filter=all\">";
|
||
|
|
$$b .= "$keyword</a></b>: $kwcs->{$id} $noun</li>\n";
|
||
|
|
}
|
||
|
|
unless ($rows) {
|
||
|
|
$$b .= "<?h1 <?_ml /tools/memories.bml.error.noentries.title _ml?> h1?>";
|
||
|
|
$$b .= "<?p <?_ml /tools/memories.bml.error.noentries.body _ml?> p?>";
|
||
|
|
} else {
|
||
|
|
$$b .= "</ul>";
|
||
|
|
}
|
||
|
|
box_end($b, $box);
|
||
|
|
}
|
||
|
|
};
|
||
|
|
|
||
|
|
1;
|