init
This commit is contained in:
2
local/htdocs/.htaccess
Executable file
2
local/htdocs/.htaccess
Executable file
@@ -0,0 +1,2 @@
|
||||
Options FollowSymLinks Indexes
|
||||
AddType "text/html; charset=koi8-r" .html
|
||||
9
local/htdocs/404-error.html
Executable file
9
local/htdocs/404-error.html
Executable file
@@ -0,0 +1,9 @@
|
||||
<title> 404 </title>
|
||||
<body>
|
||||
Page was not found. Sorry.
|
||||
<p>
|
||||
<b><small><a href="http://lj.rossia.org/">
|
||||
Livejournal Rossia.org </a>
|
||||
</small> </b>
|
||||
|
||||
</body>
|
||||
1
local/htdocs/_config-local.bml
Executable file
1
local/htdocs/_config-local.bml
Executable file
@@ -0,0 +1 @@
|
||||
DefaultLanguage ru
|
||||
104
local/htdocs/admin/console/index.bml
Executable file
104
local/htdocs/admin/console/index.bml
Executable file
@@ -0,0 +1,104 @@
|
||||
<html>
|
||||
<head><title>Admin Console</title></head>
|
||||
<body>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%POST %cmd);
|
||||
|
||||
my ($ret, $sth);
|
||||
|
||||
my $commands = $POST{'commands'};
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
if ($commands)
|
||||
{
|
||||
unless (LJ::did_post()) {
|
||||
return "<b>Error:</b> requires post.";
|
||||
}
|
||||
|
||||
if ($remote && $remote->{'user'} ne $POST{'remoteuser'}) {
|
||||
return "<b>Error:</b> invalid user.";
|
||||
}
|
||||
|
||||
$ret .= "[ <A HREF=\"./\">console</A> | <A HREF=\"reference.bml\">reference</A> ]<P>";
|
||||
|
||||
foreach my $cmd (split(/\n/, $commands))
|
||||
{
|
||||
my @args = LJ::Con::parse_line($cmd);
|
||||
next unless @args;
|
||||
|
||||
my $first = 1;
|
||||
$ret .= "<P><TABLE BORDER=1 CELLPADDING=5><TR>";
|
||||
foreach (@args) {
|
||||
my $arg = BML::eall($_);
|
||||
if ($first) {
|
||||
$ret .= "<TD><B>$arg</B></TD>";
|
||||
$first = 0;
|
||||
} else {
|
||||
$ret .= "<TD>$arg</TD>";
|
||||
}
|
||||
}
|
||||
$ret .= "</TR></TABLE>";
|
||||
|
||||
my @output;
|
||||
my $rv;
|
||||
|
||||
# TODO: make the entire console library not take $db args.
|
||||
my $dbh = LJ::get_db_writer();
|
||||
$rv = LJ::Con::execute($dbh, $remote, \@args, \@output);
|
||||
|
||||
unless ($rv) { $ret .= "<P><B><FONT COLOR=#FF0000>Failed!</FONT></B>"; }
|
||||
if (@output) {
|
||||
$ret .= "<PRE><B>";
|
||||
foreach my $line (@output) {
|
||||
my $color = "#000000";
|
||||
if ($line->[0] eq "error") {
|
||||
$color = "#FF0000";
|
||||
}
|
||||
if ($line->[0] eq "info") {
|
||||
$color = "#008800";
|
||||
}
|
||||
|
||||
$ret .= "<FONT COLOR=$color>".LJ::eall($line->[1])."</FONT>\n";
|
||||
|
||||
}
|
||||
$ret .= "</B></PRE>";
|
||||
}
|
||||
}
|
||||
|
||||
$ret .= "<form method=post><p>";
|
||||
$ret .= "<tt>enter commands:</tt><br>";
|
||||
$ret .= LJ::html_hidden('remoteuser', $remote->{'user'}) if $remote;
|
||||
$ret .= "<textarea name=commands rows=3 cols=60 wrap=off></textarea> ";
|
||||
$ret .= "<input type=submit value=\"execute\"></form>\n";
|
||||
|
||||
return $ret;
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
$ret .= "[ console | <A HREF=\"reference.bml\">reference</A> ]<P>";
|
||||
|
||||
$ret .= "<FORM METHOD=POST>";
|
||||
$ret .= LJ::html_hidden('remoteuser', $remote->{'user'}) if $remote;
|
||||
$ret .= "<TABLE WIDTH=400><TR VALIGN=BOTTOM>";
|
||||
$ret .= "<TD><IMG SRC=\"$LJ::IMGPREFIX/nerd_small.jpg\" WIDTH=167 HEIGHT=169 HSPACE=2 VSPACE=2></TD>";
|
||||
$ret .= "<TD><B><TT>command console.</TT></B>";
|
||||
$ret .= "<P>welcome to the console. from here administrators can do administrative type things. you will forget the commands, so there is a <A HREF=\"reference.bml\">reference</A>.</TD>";
|
||||
$ret .= "</TR>";
|
||||
$ret .= "<TR><TD COLSPAN=2>";
|
||||
$ret .= "<P><tt>enter commands:</tt><BR>";
|
||||
$ret .= "<TEXTAREA NAME=commands ROWS=10 COLS=60 WRAP=OFF></TEXTAREA></TD></TR>\n";
|
||||
$ret .= "<TR><TD COLSPAN=2 ALIGN=RIGHT><INPUT TYPE=SUBMIT VALUE=\"execute\"></P></TD></TR></TABLE></FORM>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
<?_c <LJDEP>
|
||||
lib: cgi-bin/console.pl, cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/console/reference.bml
|
||||
post: htdocs/admin/console/index.bml
|
||||
</LJDEP> _c?>
|
||||
60
local/htdocs/admin/console/reference.bml
Executable file
60
local/htdocs/admin/console/reference.bml
Executable file
@@ -0,0 +1,60 @@
|
||||
<html><head><title>Console Reference</title></head>
|
||||
<body>
|
||||
|
||||
[ <a href="./">console</a> | reference ]
|
||||
|
||||
<P><B>Grammar</B>
|
||||
<BR>Think of this like a DOS or <tt>bash</tt> prompt. The first word is a command. Every word after that is an argument to that command. Every command has a different number of required and optional parameters. White space delimits arguments. If you need a space in an argument, put double quotes around the whole thing. If you need double quotes and spaces in an argument, escape the quote with a backslash (\) first. If you need to do a backslash, escape that with a backslash.
|
||||
<P>It's pretty straight-forward. If you're confused, ask.
|
||||
|
||||
<P><B>Command Reference</B>
|
||||
<BR>Arguments in <angle brackets> are required. Arguments in [brackets] are optional. If there is more than one optional argument, you can't skip one and provide one after it. Once you skip one, you have to skip the rest.
|
||||
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%cmd);
|
||||
|
||||
my ($ret, $sth);
|
||||
|
||||
$ret .= "<dl> \n";
|
||||
|
||||
foreach my $cmdname (sort keys %LJ::Con::cmd)
|
||||
{
|
||||
my $cmd = $LJ::Con::cmd{$cmdname};
|
||||
next if ($cmd->{'hidden'});
|
||||
|
||||
my $anchor = "$cmdname";
|
||||
$ret .= "<a href='\#$anchor'>$cmdname</a> \n";
|
||||
}
|
||||
$ret .= "</dl><dl> \n";
|
||||
|
||||
foreach my $cmdname (sort keys %LJ::Con::cmd)
|
||||
{
|
||||
my $cmd = $LJ::Con::cmd{$cmdname};
|
||||
next if ($cmd->{'hidden'});
|
||||
|
||||
my $args = LJ::ehtml($cmd->{'argsummary'});
|
||||
my $anchor = "$cmdname";
|
||||
$ret .= "<a name='$anchor'><dt><p><table width=100% cellpadding=2><tr><td bgcolor=#d0d0d0>";
|
||||
$ret .= "<tt><a style='text-decoration: none' href='\#$anchor'><b>$cmdname</b></a> $args</tt></td></tr></table>";
|
||||
$ret .= "</dt><dd><p>$cmd->{'des'}";
|
||||
if ($cmd->{'args'}) {
|
||||
my @des = @{$cmd->{'args'}};
|
||||
$ret .= "<p><dl>";
|
||||
while (my ($arg, $des) = splice(@des, 0, 2)) {
|
||||
$ret .= "<dt><b><i>$arg</i></b></dt><dd>$des</dd>";
|
||||
}
|
||||
$ret .= "</dl>";
|
||||
}
|
||||
$ret .= "</dd></a> \n";
|
||||
}
|
||||
$ret .= "</dl>";
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
</body></html><?_c <LJDEP>
|
||||
lib: cgi-bin/console.pl, cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/console/index.bml
|
||||
</LJDEP> _c?>
|
||||
2
local/htdocs/admin/ljr/.htaccess
Normal file
2
local/htdocs/admin/ljr/.htaccess
Normal file
@@ -0,0 +1,2 @@
|
||||
ExpiresActive on
|
||||
ExpiresByType image/png A0000000
|
||||
147
local/htdocs/admin/ljr/import-queue.bml
Normal file
147
local/htdocs/admin/ljr/import-queue.bml
Normal file
@@ -0,0 +1,147 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
body<=
|
||||
<?_code
|
||||
LJ::set_active_crumb('import');
|
||||
return;
|
||||
_code?>
|
||||
|
||||
<?_code
|
||||
{
|
||||
my $err = sub {
|
||||
my $txt = shift;
|
||||
return "<?inerr " . $txt . " inerr?><br/>";
|
||||
};
|
||||
|
||||
use strict;
|
||||
use vars qw(%POST %GET);
|
||||
use POSIX;
|
||||
|
||||
my $records_per_page = 10;
|
||||
|
||||
return LJ::server_down_html() if $LJ::SERVER_DOWN;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return LJ::bad_input("You must be logged in to access import page.")
|
||||
unless $remote;
|
||||
|
||||
return"<b>Error:</b> You don't have access to view import results."
|
||||
unless (LJ::check_priv($remote, "siteadmin", "importresults"));
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $u = LJ::get_authas_user($authas);
|
||||
return LJ::bad_input("You could not be authenticated as the specified user.")
|
||||
unless $u;
|
||||
|
||||
my $ret;
|
||||
my $dbr;
|
||||
|
||||
$dbr = LJ::get_db_reader();
|
||||
return $err->("Can't get database reader!") unless $dbr;
|
||||
|
||||
$ret = "<?h1 Очередь импорта всех пользователей h1?>\n<br/>";
|
||||
|
||||
my $sth1;
|
||||
my $max_importid;
|
||||
|
||||
$sth1 = $dbr->prepare("SELECT max(importid) as mi FROM ljr_iqueue");
|
||||
$sth1->execute();
|
||||
if (my $r = $sth1->fetchrow_hashref) {
|
||||
$max_importid = $r->{"mi"};
|
||||
}
|
||||
$sth1->finish;
|
||||
|
||||
if (!$max_importid) {
|
||||
return $err->("Import queue is empty right now. Check out <a href=import-results.bml>import results</a> instead.")
|
||||
}
|
||||
|
||||
$ret .= "<br/>Check out <a href=import-results.bml>import results</a> also.<br/>";
|
||||
|
||||
my $tot_pages = POSIX::floor($max_importid / $records_per_page) + 1;
|
||||
my $offset = $max_importid - POSIX::floor($max_importid / $records_per_page) * $records_per_page;
|
||||
my $i;
|
||||
|
||||
|
||||
if (!defined($GET{"page"}) || int($GET{"page"}) == 0 ) {
|
||||
$GET{"page"} = $tot_pages;
|
||||
}
|
||||
else {
|
||||
$GET{"page"} = abs(int($GET{"page"}));
|
||||
}
|
||||
|
||||
|
||||
$ret .= "<br/><font size=+1>Страницы: </font><font size=+2>";
|
||||
|
||||
my $lindex;
|
||||
my $rindex;
|
||||
|
||||
$lindex = $GET{"page"} + 5;
|
||||
if ($lindex > $tot_pages) {
|
||||
$rindex = $rindex - ($lindex - $tot_pages);
|
||||
$lindex = $tot_pages;
|
||||
}
|
||||
$rindex = $rindex + $GET{"page"} - 5;
|
||||
if ($rindex < 1) {
|
||||
$lindex = $lindex + abs($rindex) - 1;
|
||||
$rindex = 1;
|
||||
}
|
||||
|
||||
for ($i = $lindex; $i >= $rindex; $i--) {
|
||||
if ($i == $GET{"page"}) {
|
||||
$ret .= $i . " ";
|
||||
}
|
||||
else {
|
||||
$ret .= "<a href=import-queue.bml?page=$i>$i</a> ";
|
||||
}
|
||||
}
|
||||
$ret .= "</font>";
|
||||
|
||||
$ret .= "<form action='import-queue.bml' method='get'>";
|
||||
$ret .= "<input type=submit value=' Обновить '>";
|
||||
$ret .= "<input type=hidden name=page id=page value='" . $GET{"page"} . "'";
|
||||
$ret .= "</form><br/><br/>";
|
||||
|
||||
$sth1 = $dbr->prepare(
|
||||
"SELECT * FROM ljr_iqueue where importid <= " .
|
||||
(($GET{"page"} - 1) * $records_per_page + $offset) .
|
||||
" and importid > " .
|
||||
((($GET{"page"} - 1) * $records_per_page) + $offset - $records_per_page) .
|
||||
" order by priority, importid desc "
|
||||
);
|
||||
$sth1->execute();
|
||||
|
||||
$ret .= "<table border=0 cellpadding=5 cellspacing=0>";
|
||||
$ret .= "<tr bgcolor=#DDDDDD>";
|
||||
$ret .= "<td>Приоритет</td>";
|
||||
$ret .= "<td>Номер</td>";
|
||||
$ret .= "<td>Исходный<br/>сервер</td>";
|
||||
$ret .= "<td>Пользователь<br/>на исходном сервере</td>";
|
||||
$ret .= "<td>Протокол</td>";
|
||||
$ret .= "<td>Пользователь<br/>LJ.Rossia.org</td>";
|
||||
$ret .= "<td>Дата и время<br/>создания заявки</td>";
|
||||
$ret .= "</tr>";
|
||||
|
||||
while (my $r = $sth1->fetchrow_hashref) {
|
||||
$ret .= "<tr>";
|
||||
$ret .= "<td>" . $r->{priority} . "</td>";
|
||||
$ret .= "<td>" . $r->{importid} . "</td>";
|
||||
$ret .= "<td>" . $r->{remote_site} . "</td>";
|
||||
$ret .= "<td><a href=http://" . $r->{remote_site} ."/users/" . $r->{remote_user} . ">" .
|
||||
$r->{remote_user} . "</a></td>";
|
||||
$ret .= "<td>" . $r->{remote_protocol} . "</td>";
|
||||
$ret .= "<td><a href=" . $LJ::SITEROOT . "/users/" . $r->{local_user} . ">" .
|
||||
$r->{local_user} . "</a></td>";
|
||||
$ret .= "<td>" . $r->{qdate} . "</td>";
|
||||
$ret .= "</tr>";
|
||||
$ret .= "<tr bgcolor=#DDDDDD><td colspan=10></td></tr>";
|
||||
}
|
||||
$ret .= "</table>";
|
||||
$sth1->finish;
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
|
||||
|
||||
<=body
|
||||
page?>
|
||||
203
local/htdocs/admin/ljr/import-results.bml
Executable file
203
local/htdocs/admin/ljr/import-results.bml
Executable file
@@ -0,0 +1,203 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
body<=
|
||||
<?_code
|
||||
LJ::set_active_crumb('import');
|
||||
return;
|
||||
_code?>
|
||||
|
||||
<?_code
|
||||
{
|
||||
my $err = sub {
|
||||
my $txt = shift;
|
||||
return "<?inerr " . $txt . " inerr?><br/>";
|
||||
};
|
||||
|
||||
use strict;
|
||||
use vars qw(%POST %GET);
|
||||
use POSIX;
|
||||
|
||||
my $records_per_page = 10;
|
||||
|
||||
return LJ::server_down_html() if $LJ::SERVER_DOWN;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return LJ::bad_input("You must be logged in to access import page.")
|
||||
unless $remote;
|
||||
|
||||
return"<b>Error:</b> You don't have access to view import results."
|
||||
unless (LJ::check_priv($remote, "siteadmin", "importresults"));
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $u = LJ::get_authas_user($authas);
|
||||
return LJ::bad_input("You could not be authenticated as the specified user.")
|
||||
unless $u;
|
||||
|
||||
my $ret;
|
||||
my $dbr;
|
||||
|
||||
$dbr = LJ::get_db_reader();
|
||||
return $err->("Can't get database reader!") unless $dbr;
|
||||
|
||||
if (defined($GET{"retry"}) && int($GET{"retry"}) > 0 ) {
|
||||
$ret = "<?h1 Do you really want to retry import [" . $GET{"retry"} . "]? h1?>\n<br/><br/>";
|
||||
$ret .= "<a href=import-results.bml?retrydo=" . $GET{"retry"} .">Yes please</a> ";
|
||||
$ret .= "<a href=import-results.bml>No thanks</a>";
|
||||
return $ret;
|
||||
}
|
||||
if (defined($GET{"retrydo"}) && int($GET{"retrydo"}) > 0 ) {
|
||||
my $sth1;
|
||||
|
||||
$sth1 = $dbr->prepare("SELECT * FROM ljr_ihistory WHERE importid=?");
|
||||
$sth1->execute($GET{"retrydo"});
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
return $err->("Can't get database writer!") unless $dbh;
|
||||
|
||||
my $r;
|
||||
if ($r = $sth1->fetchrow_hashref) {
|
||||
$sth1->finish;
|
||||
|
||||
return $err->("Sorry we do not have remote password for import [" . $GET{"retrydo"} . "]!")
|
||||
if $r->{remote_pass} eq "";
|
||||
|
||||
$sth1 = $dbr->prepare("SELECT * FROM ljr_iqueue WHERE local_user=?");
|
||||
$sth1->execute($r->{local_user});
|
||||
if ($sth1->fetchrow_hashref) {
|
||||
$dbh->do(
|
||||
"update ljr_iqueue set remote_site=?, remote_user=?, remote_pass=?, remote_protocol=? " .
|
||||
"where local_user=?;", undef,
|
||||
$r->{remote_site}, $r->{remote_user}, $r->{remote_pass},
|
||||
$r->{remote_protocol}, $r->{local_user});
|
||||
return $err->($dbh->errstr) if $dbh->err;
|
||||
}
|
||||
else {
|
||||
$dbh->do(
|
||||
"insert into ljr_iqueue " .
|
||||
"(remote_site, remote_user, remote_pass, remote_protocol, local_user, " .
|
||||
"opt_overwrite, opt_comments, qdate, priority) VALUES " .
|
||||
"(?, ?, ?, ?, ?, '0', '1', now(), 4);",
|
||||
undef, $r->{remote_site}, $r->{remote_user}, $r->{remote_pass},
|
||||
$r->{remote_protocol}, $r->{local_user});
|
||||
return $err->($dbh->errstr) if $dbh->err;
|
||||
}
|
||||
$sth1->finish;
|
||||
|
||||
$ret = "OK. You have it.";
|
||||
}
|
||||
else {
|
||||
return $err->("Sorry, we can't find import [" . $GET{"retrydo"} . "]!");
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret = "<?h1 Импорт всех пользователей h1?>\n<br/>";
|
||||
|
||||
my $sth1;
|
||||
my $max_importid;
|
||||
|
||||
$sth1 = $dbr->prepare("SELECT max(importid) as mi FROM ljr_ihistory");
|
||||
$sth1->execute();
|
||||
if (my $r = $sth1->fetchrow_hashref) {
|
||||
$max_importid = $r->{"mi"};
|
||||
}
|
||||
else {
|
||||
return $err->("No import ever happened.")
|
||||
}
|
||||
$sth1->finish;
|
||||
|
||||
$ret .= "<br/>Check out <a href=import-queue.bml>import queue</a> also.<br/>";
|
||||
|
||||
my $tot_pages = POSIX::floor($max_importid / $records_per_page) + 1;
|
||||
my $offset = $max_importid - POSIX::floor($max_importid / $records_per_page) * $records_per_page;
|
||||
my $i;
|
||||
|
||||
|
||||
if (!defined($GET{"page"}) || int($GET{"page"}) == 0 ) {
|
||||
$GET{"page"} = $tot_pages;
|
||||
}
|
||||
else {
|
||||
$GET{"page"} = abs(int($GET{"page"}));
|
||||
}
|
||||
|
||||
|
||||
$ret .= "<br/><font size=+1>Страницы: </font><font size=+2>";
|
||||
|
||||
my $lindex;
|
||||
my $rindex;
|
||||
|
||||
$lindex = $GET{"page"} + 5;
|
||||
if ($lindex > $tot_pages) {
|
||||
$rindex = $rindex - ($lindex - $tot_pages);
|
||||
$lindex = $tot_pages;
|
||||
}
|
||||
$rindex = $rindex + $GET{"page"} - 5;
|
||||
if ($rindex < 1) {
|
||||
$lindex = $lindex + abs($rindex) - 1;
|
||||
$rindex = 1;
|
||||
}
|
||||
|
||||
for ($i = $lindex; $i >= $rindex; $i--) {
|
||||
if ($i == $GET{"page"}) {
|
||||
$ret .= $i . " ";
|
||||
}
|
||||
else {
|
||||
$ret .= "<a href=import-results.bml?page=$i>$i</a> ";
|
||||
}
|
||||
}
|
||||
$ret .= "</font>";
|
||||
|
||||
$ret .= "<form action='import-results.bml' method='get'>";
|
||||
$ret .= "<input type=submit value=' Обновить '>";
|
||||
$ret .= "<input type=hidden name=page id=page value='" . $GET{"page"} . "'";
|
||||
$ret .= "</form><br/><br/>";
|
||||
|
||||
$sth1 = $dbr->prepare(
|
||||
"SELECT * FROM ljr_ihistory where importid <= " .
|
||||
(($GET{"page"} - 1) * $records_per_page + $offset) .
|
||||
" and importid > " .
|
||||
((($GET{"page"} - 1) * $records_per_page) + $offset - $records_per_page) .
|
||||
" order by importid desc "
|
||||
);
|
||||
$sth1->execute();
|
||||
|
||||
$ret .= "<table border=0 cellpadding=5 cellspacing=0>";
|
||||
$ret .= "<tr bgcolor=#DDDDDD>";
|
||||
$ret .= "<td>Номер</td>";
|
||||
$ret .= "<td>Исходный<br/>сервер</td>";
|
||||
$ret .= "<td>Пользователь<br/>на исходном сервере</td>";
|
||||
$ret .= "<td>Протокол</td>";
|
||||
$ret .= "<td>Пользователь<br/>LJ.Rossia.org</td>";
|
||||
$ret .= "<td>Дата и время<br/>изменения<br/>статуса заявки</td>";
|
||||
$ret .= "<td>Статус заявки</td>";
|
||||
$ret .= "</tr>";
|
||||
|
||||
while (my $r = $sth1->fetchrow_hashref) {
|
||||
$ret .= "<tr>";
|
||||
$ret .= "<td>" . $r->{importid} . "</td>";
|
||||
$ret .= "<td>" . $r->{remote_site} . "</td>";
|
||||
$ret .= "<td><a href=http://" . $r->{remote_site} ."/users/" . $r->{remote_user} . ">" .
|
||||
$r->{remote_user} . "</a></td>";
|
||||
$ret .= "<td>" . $r->{remote_protocol} . "</td>";
|
||||
$ret .= "<td><a href=" . $LJ::SITEROOT . "/users/" . $r->{local_user} . ">" .
|
||||
$r->{local_user} . "</a></td>";
|
||||
$ret .= "<td>" . $r->{idate} . "</td>";
|
||||
$ret .= "<td>" .
|
||||
($r->{istatus} ne "SUCCESSFUL" && $r->{remote_pass} ne "" ?
|
||||
"<font size=-2><a href=import-results.bml?retry=$r->{importid}>retry</a> </font>"
|
||||
: "") .
|
||||
$r->{istatus} . "</td>";
|
||||
$ret .= "</tr>";
|
||||
$ret .= "<tr bgcolor=#DDDDDD><td colspan=10></td></tr>";
|
||||
}
|
||||
$ret .= "</table>";
|
||||
$sth1->finish;
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
|
||||
|
||||
<=body
|
||||
page?>
|
||||
81
local/htdocs/admin/memcache-keys.txt
Executable file
81
local/htdocs/admin/memcache-keys.txt
Executable file
@@ -0,0 +1,81 @@
|
||||
<uid> userid:<uid> == $u, (in arrayref packed form)
|
||||
uidof:<user> == userid
|
||||
<uid> uprop:<uid>:<propid> == scalar
|
||||
<uid> tags:<uid> == { tagid => { **tag info hashref, see LJ::Tags::get_usertags** } }
|
||||
<uid> sess:<uid>:<sessid> == sessions row hashref
|
||||
<uid> bio:<uid> == user bio text
|
||||
|
||||
<uid> talktext:<cid>:<uid>:<jtalkid> == [ subject, text ] 60 min
|
||||
<uid> talkprop:<uid>:<jtalkid> == { propname => $value, ... } 60 min
|
||||
<uid> talk2:<uid>:<nodetype>:<nodeid> == packed data 120 min
|
||||
<uid> talk2ct:<uid> == # rows for user
|
||||
<uid> talkleftct:<uid> == # rows for user
|
||||
|
||||
<uid> logtext:<cid>:<uid>:<jitemid> == [ subject, text ] 120 min
|
||||
<uid> logprop:<uid>:<jitemid> == { propname => $value, ... } 120 min
|
||||
<uid> logtag:<uid>:<jitemid> == [ kwid, kwid, kwid, ... ]
|
||||
<uid> log2:<uid>:<jitemid> == packed data
|
||||
<uid> log2ct:<uid> == # of rows for user
|
||||
<uid> log2lt:<uid> == packed data: array of recent log2 entries in rlogtime
|
||||
order, for friends page, last few weeks by default
|
||||
<uid> rp:<uid>:<jitemid> == scalar, the replycount value
|
||||
|
||||
<uid> memkwid:<uid> == hashref of 'memories' keyword ids to keywords.
|
||||
|
||||
<uid> dayct:<uid> == arrayref of arrayrefs (see LJ::get_daycounts)
|
||||
|
||||
<uid> auc:<uid>:<dom> == last ID from LJ::alloc_user_counter() for $uid/$domain
|
||||
|
||||
<themeid> moodthemedata:<themeid> = { $moodid => { 'pic' => $pic, 'w' => $w, 'h' => $h } }
|
||||
|
||||
<uid> s1overr:<uid> == overrides for a given user
|
||||
<uid> s1uc:<uid> == s1usercache row hashref
|
||||
s1pubstyc == hashref keyed on styleid with values being rows from s1style table
|
||||
<styleid> s1styc:<styleid> == s1stylecache row hashref, 30 minutes
|
||||
<styleid> s1style:<styleid> == hashref of s1style row, without formatdata
|
||||
<styleid> s1style_all:<styleid> == hashref of s1style row, including formatdata
|
||||
<styleid> s1stylemap: <styleid> == userid who owns the given styleid
|
||||
|
||||
<styleid> s2sl:<styleid> == hashref of s2stylelayers { type => s2lid }
|
||||
<styleid> s2s:<styleid> == hashref of s2styles row
|
||||
s2publayers == memoize LJ::S2::get_public_layers for 10 mins
|
||||
<layerid> s2lo:<layerid> == userid of the owner of this layer
|
||||
<layerid> s2c:<layerid> == arrayref; [ compile time, compiled data (or 0 meaning no data) ]
|
||||
|
||||
<uid> checkfriends:<uid>:<mask> == scalar maxupdate, expires after refresh interval
|
||||
<uid> frgmask:<uid>:<uid_friend> -- scalar numeric mask, 15 minutes
|
||||
<uid> fgrp:<uid> == packed data, friendgroup rows for a given user
|
||||
<uid> friends:<uid> == packed data, friends rows for a user
|
||||
<uid> friendofs:<uid> == packed data, friendofs for a user
|
||||
<uid> tu:<uid> == packed number: unixtime when user last updated
|
||||
<uid> te:<uid> == packed number: unixtime when user last updated or edited
|
||||
rss:<uid> == anonymous RSS page (text/html + last-modified)
|
||||
blob:timeupdate == array of recently updated userids, few weeks. 1 min expire
|
||||
popsyn == 100 most read syndicated accounts [user, userid, synurl, numreaders], 1 hour
|
||||
|
||||
sysban:ip == hashref of ip => unix expiration time
|
||||
sysban:uniq == hashref of uniq => unix expiration time
|
||||
|
||||
<picid> userpic.<picid> == hashref-as-arrayref (ARRAYFMT: 'userpic' in LJ::MemCache)
|
||||
<uid> upicinf:<uid> == packed data, userpic keywords
|
||||
<uid> upiccom:<uid> == packed data, userpic comments
|
||||
<uid> upicurl:<uid> == packed data, userpic urls
|
||||
<picid> mogp.up.<picid> == arrayref of paths (URLs)
|
||||
|
||||
rate_eperr:<email_address> == rate limiting errors sent via email for email gateway
|
||||
rate:tracked:<userid> == cluster tracking on login, posts, and comments
|
||||
|
||||
ml.<lang>.<dmid>.<code>
|
||||
|
||||
includefile:<name> == text of BML include file
|
||||
|
||||
<intid> introw:<intid> -- arrayref of [ $intid, $interest, $intcount ]
|
||||
<uid> intids:<uid> -- arrayref of intids for this userid
|
||||
|
||||
<uid> rel:<uid>:<targetid>:<rel> == [{0|1}, as_of_time]
|
||||
<uid> relmodu:<uid>:<rel> == as_of_time, updated when rel edges of uid change
|
||||
<targetid> relmodt:<targetid>:<rel> == as_of_time, updated when rel edges of targetid change
|
||||
|
||||
<uid> memct:<uid> -- number of memories user has
|
||||
|
||||
<uid> lastcomm:<uid> -- id of the last comment the user posted via quickreply
|
||||
171
local/htdocs/admin/memcache.bml
Executable file
171
local/htdocs/admin/memcache.bml
Executable file
@@ -0,0 +1,171 @@
|
||||
<?_code
|
||||
{
|
||||
#line 3
|
||||
use strict;
|
||||
no strict 'refs';
|
||||
use vars qw(%GET);
|
||||
use Data::Dumper;
|
||||
use Time::HiRes ();
|
||||
|
||||
my $u = LJ::get_remote();
|
||||
return "You must be logged in to view this tool." unless $u;
|
||||
return "You don't have 'finduser' priv." unless LJ::check_priv($u, "finduser");
|
||||
# return "You don't have 'siteadmin' priv." unless LJ::check_priv($u, "siteadmin");
|
||||
|
||||
my $prev_hits = $u ? LJ::MemCache::get([$u->{'userid'},"mcrate:$u->{'userid'}"]) : undef;
|
||||
|
||||
my $ret;
|
||||
|
||||
my $mode = $GET{'mode'};
|
||||
if ($GET{'host'}) {
|
||||
$mode ||= "host";
|
||||
}
|
||||
$mode ||= "overview";
|
||||
|
||||
$ret .= "<div class='topbar'>[<a href='memcache.bml'>Overview</a>]\n";
|
||||
|
||||
if ($mode eq "overview") {
|
||||
$ret .= <<"END_TOP";
|
||||
</div>
|
||||
<h1>Memory Cache Overview</h1>
|
||||
<table border='1' cellpadding='5'>
|
||||
<tr><th>Host</th><th>Hit Rate</th><th>Curr/Max Size</th><th><span title='Utilization'>Utlz %</span></th><th>Uptime</th><th>Version</th></tr>
|
||||
END_TOP
|
||||
}
|
||||
|
||||
my %now_hits;
|
||||
if ($prev_hits) { %now_hits = %$prev_hits; }
|
||||
|
||||
my ($tot_hits, $tot_misses) = ();
|
||||
|
||||
foreach my $entry (@LJ::MEMCACHE_SERVERS) {
|
||||
my $host = ref $entry ? $entry->[0] : $entry;
|
||||
next if $mode eq "host" && $host ne $GET{'host'};
|
||||
|
||||
LJ::MemCache::forget_dead_hosts();
|
||||
my $sock = Cache::Memcached::sock_to_host($host);
|
||||
|
||||
my $t1 = Time::HiRes::time();
|
||||
|
||||
my $log;
|
||||
my %stat;
|
||||
my @cmds = ("", "malloc", "items", "slabs");
|
||||
my $cmd;
|
||||
if ($sock) {
|
||||
while (defined($cmd = shift @cmds)) {
|
||||
my $realcmd = "stats" . ($cmd ? " $cmd" : "");
|
||||
$log .= "<b>$realcmd</b>\n";
|
||||
foreach (LJ::MemCache::run_command($sock, "$realcmd\r\n")) {
|
||||
last if $_ eq "END\r\n";
|
||||
$log .= $_;
|
||||
next if $cmd eq "maps";
|
||||
if (/^STAT (\S+) (\S+)/) {
|
||||
$stat{$cmd}{$1} = $2;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $t2 = Time::HiRes::time();
|
||||
|
||||
my $cpu = 0;
|
||||
foreach my $key (qw(rusage_user rusage_system)) {
|
||||
my $sec = $stat{''}{$key};
|
||||
$sec =~ s/:/\./;
|
||||
$cpu += $sec;
|
||||
#$ret .= "Host $host was $stat{''}{$key} = $sec, cpu = $cpu<br />\n";
|
||||
}
|
||||
|
||||
$now_hits{$host} = [ $stat{''}{'get_hits'}, $stat{''}{'get_misses'}, $cpu ];
|
||||
|
||||
my $hit_rate = sprintf("%0.02f%%", $stat{''}{'get_hits'}/($stat{''}{'get_hits'}+$stat{''}{'get_misses'}||1)*100);
|
||||
|
||||
if ($mode eq "overview") {
|
||||
$ret .= "<tr><td><a href='memcache.bml?host=$host'>$host</a></td>\n";
|
||||
$ret .= "<td>$hit_rate";
|
||||
if ($prev_hits && $prev_hits->{$host}) {
|
||||
my $nh = $now_hits{$host};
|
||||
my $ph = $prev_hits->{$host};
|
||||
|
||||
my $new_hits = $now_hits{$host}[0] - $prev_hits->{$host}[0];
|
||||
my $new_misses = $now_hits{$host}[1] - $prev_hits->{$host}[1];
|
||||
$tot_hits += $new_hits;
|
||||
$tot_misses += $new_misses;
|
||||
my $new_whatev = $new_hits + $new_misses;
|
||||
my $new_rate = $new_hits / ($new_whatev || 1);
|
||||
|
||||
my $cpu = sprintf("%0.6f", $nh->[2] - $ph->[2]);
|
||||
$ret .= sprintf(" [%0.02f%% {$new_whatev} $cpu]", $new_rate * 100);
|
||||
}
|
||||
$ret .= sprintf(" %0.02f", $t2-$t1);
|
||||
$ret .= "</td>";
|
||||
my $gb_used = ($stat{'malloc'}{'mmapped_space'} + $stat{'malloc'}{'arena_size'}) / (1024*1024*1024);
|
||||
my $gb_max = $stat{''}{'limit_maxbytes'} / (1024*1024*1024);
|
||||
if ($gb_used >= $gb_max) {
|
||||
$ret .= sprintf("<td align='center'>%0.01fG</td>", $gb_max);
|
||||
} else {
|
||||
$ret .= sprintf("<td>%0.02f/%0.01fG (%0.02f%%)</td>", $gb_used, $gb_max, $gb_used*100/($gb_max||1));
|
||||
}
|
||||
|
||||
my $utiliz = $stat{''}{'bytes'} /
|
||||
(($stat{'malloc'}{'mmapped_space'} + $stat{'malloc'}{'arena_size'}) || 1);
|
||||
$ret .= sprintf("<td>%0.02f%%</td>", $utiliz*100);
|
||||
|
||||
my $up = $stat{''}{'uptime'};
|
||||
my $upstring;
|
||||
foreach my $u ([86400,"d"],[3600,"h"],[60,"m"],[1,"s"]) {
|
||||
if ($up / $u->[0] > 1) {
|
||||
my $v = int($up / $u->[0]);
|
||||
$upstring .= "${v}$u->[1] ";
|
||||
$up -= $v * $u->[0];
|
||||
}
|
||||
}
|
||||
$ret .= "<td>$upstring</td>";
|
||||
$ret .= "<td>$stat{''}{'version'}</td>";
|
||||
$ret .= "</tr>";
|
||||
}
|
||||
|
||||
if ($mode eq "host" && $host eq $GET{'host'}) {
|
||||
$ret .= "[<a href='memcache.bml?host=$host&mode=raw'>Raw Data</a>]</div>";
|
||||
$ret .= "<h1>Details for $host</h1>";
|
||||
|
||||
$ret .= "<h2>Slab classes</h2>";
|
||||
$ret .= "<table border='1' cellpadding='2'>";
|
||||
$ret .= "<tr><th>class</th><th>size</th><th>used</th><th>total</th><th colspan='2'>free</th><th>pages</th><th>max age</th></tr>\n";
|
||||
foreach my $cls (0..60) {
|
||||
my $size = $stat{'slabs'}{"$cls:chunk_size"};
|
||||
next unless $size;
|
||||
$ret .= "<tr><td>$cls</td>"
|
||||
. join('', map { "<td>" . $stat{'slabs'}{"$cls:$_"} . "</td>" }
|
||||
qw(chunk_size used_chunks total_chunks free_chunks free_chunks_end total_pages));
|
||||
my $age = $stat{'items'}{"items:$cls:age"};
|
||||
$ret .= "<td>$age</td>";
|
||||
$ret .= "</tr>";
|
||||
}
|
||||
$ret .= "</table>\n";
|
||||
|
||||
}
|
||||
|
||||
if ($mode eq "raw" && $host eq $GET{'host'}) {
|
||||
$ret .= "[<a href='memcache.bml?host=$host'>Host Stats</a>]</div>";
|
||||
$ret .= "<h1>Raw data for $host</h1>";
|
||||
$ret .= "<pre>$log</pre>";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
LJ::MemCache::set([$u->{'userid'},"mcrate:$u->{'userid'}"], \%now_hits)
|
||||
if $u;
|
||||
|
||||
if ($mode eq "overview") {
|
||||
$ret .= "</table>\n";
|
||||
|
||||
my $new_whatev = $tot_hits + $tot_misses;
|
||||
my $new_rate = $tot_hits / ($new_whatev || 1);
|
||||
$ret .= sprintf("Global [%0.02f%% {$new_whatev}]", $new_rate * 100);
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
|
||||
282
local/htdocs/admin/memcache_view.bml
Executable file
282
local/htdocs/admin/memcache_view.bml
Executable file
@@ -0,0 +1,282 @@
|
||||
<html>
|
||||
<head><title>Memcache view</title>
|
||||
<body>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
use Data::Dumper;
|
||||
my $ret;
|
||||
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
return "<b>Error:</b> You don't have access to viewing memcache info."
|
||||
unless (LJ::check_priv($remote, "finduser"));
|
||||
# unless (LJ::check_priv($remote, "siteadmin", "memcacheview"));
|
||||
|
||||
return "<b>Error:</b> No memcache servers defined."
|
||||
unless @LJ::MEMCACHE_SERVERS;
|
||||
|
||||
my $uid = sub {
|
||||
my $u = LJ::load_user(shift);
|
||||
return $u ? $u->{'userid'} : "";
|
||||
};
|
||||
my $cuid = sub {
|
||||
my $u = LJ::load_user(shift);
|
||||
return $u ? "$u->{'clusterid'}:$u->{'userid'}" : "";
|
||||
};
|
||||
|
||||
# key: unique prefix of a memcache key
|
||||
# value: number n, means the n-th component of the key when
|
||||
# split by ':' is the hash key. 0 means no hash key.
|
||||
# the default, when absent from this hash, is "n=2 if the 2nd component
|
||||
# is a number".
|
||||
|
||||
my %MEMC_HASHKEYS = (
|
||||
'uidof:' => 0,
|
||||
'talktext:' => 3,
|
||||
'logtext:' => 3,
|
||||
's1pubstyc:' => 0,
|
||||
'popsyn:' => 0,
|
||||
'rate_eperr:' => 0,
|
||||
'rate:' => 0,
|
||||
'ml.' => 0,
|
||||
);
|
||||
|
||||
my $get_hashkey = sub {
|
||||
my $key = shift;
|
||||
return undef unless $key;
|
||||
|
||||
my $hk;
|
||||
my $component;
|
||||
|
||||
foreach (keys %MEMC_HASHKEYS) {
|
||||
if ($key =~ /^$_/) {
|
||||
$component = $MEMC_HASHKEYS{$_};
|
||||
}
|
||||
}
|
||||
return undef if defined ($component) and $component == 0;
|
||||
my $sep = ':';
|
||||
$sep = '.' if $key =~ /userpic\./; #special case
|
||||
my @els = split (/\Q$sep\E/, $key);
|
||||
$hk = $els[defined($component) ? $component-1 : 2-1];
|
||||
$hk = undef
|
||||
unless defined($component) || int($hk)==$hk;
|
||||
return $hk;
|
||||
};
|
||||
|
||||
my $display = sub {
|
||||
my ($key, $val) = @_;
|
||||
|
||||
# first, transform array->hash if necessary
|
||||
$val = LJ::MemCache::array_to_hash("user", $val)
|
||||
if $key =~ /^user:/
|
||||
or $key =~ /^userid:/;
|
||||
|
||||
# blot out passwords
|
||||
if (ref $val eq 'HASH' && defined($val->{'password'})) {
|
||||
$val->{'password'} = '*' x 8;
|
||||
}
|
||||
|
||||
# unpack packed data
|
||||
if ($key =~ /^talk2:/) {
|
||||
my $newval;
|
||||
my $n = (length($val) - 1) / 16;
|
||||
for (my $i=0; $i<$n; $i++) {
|
||||
my ($f1, $par, $poster, $time) = unpack("NNNN",substr($val,$i*16+1,16));
|
||||
my $state = chr($f1 & 255);
|
||||
my $talkid = $f1 >> 8;
|
||||
$newval->{$talkid} = {
|
||||
talkid => $talkid,
|
||||
state => $state,
|
||||
posterid => $poster,
|
||||
datepost => LJ::mysql_time($time),
|
||||
parenttalkid => $par,
|
||||
};
|
||||
}
|
||||
$val = [substr($val,0,1), $newval];
|
||||
}
|
||||
|
||||
if ($key =~ /^log2:/) {
|
||||
my $item = {};
|
||||
@$item{'posterid', 'eventtime', 'logtime', 'allowmask', 'ditemid'} = unpack("NNNNN", $val);
|
||||
$item->{'security'} = ($item->{'allowmask'} == 0 ? 'private' :
|
||||
($item->{'allowmask'} == 2**31 ? 'public' : 'usemask'));
|
||||
@$item{'jitemid', 'anum'} = ($item->{'ditemid'} >> 8, $item->{'ditemid'} % 256);
|
||||
$item->{'eventtime'} = LJ::mysql_time($item->{'eventtime'}, 1);
|
||||
$item->{'logtime'} = LJ::mysql_time($item->{'logtime'}, 1);
|
||||
$val = $item;
|
||||
}
|
||||
|
||||
if ($key =~ /^log2lt:/) {
|
||||
my $items = [];
|
||||
my $ver = substr($val, 0, 1);
|
||||
my $offset = {1=>1, 2=>5, 3=>5}->{$ver};
|
||||
my $newval;
|
||||
|
||||
push @$newval, $ver;
|
||||
push @$newval, unpack("N", substr($val, 1, 4))
|
||||
if $ver>=2;
|
||||
|
||||
my $n = (length($val) - $offset )/20;
|
||||
for (my $i=0; $i<$n; $i++) {
|
||||
my ($rlogtime, $posterid, $eventtime, $allowmask, $ditemid) =
|
||||
unpack("NNNNN", substr($val, $i*20+$offset, 20));
|
||||
$eventtime = LJ::mysql_time($eventtime, 1);
|
||||
my $security = $allowmask == 0 ? 'private' :
|
||||
($allowmask == 2**31 ? 'public' : 'usemask');
|
||||
my ($jitemid, $anum) = ($ditemid >> 8, $ditemid % 256);
|
||||
my $item = {};
|
||||
@$item{'posterid','eventtime','rlogtime','allowmask','ditemid',
|
||||
'security', 'jitemid', 'anum'} =
|
||||
($posterid, $eventtime, $rlogtime, $allowmask,
|
||||
$ditemid, $security, $jitemid, $anum);
|
||||
push @$items, $item;
|
||||
}
|
||||
push @$newval, $items;
|
||||
$val = $newval;
|
||||
}
|
||||
|
||||
if ($key =~ /^fgrp:/) {
|
||||
my $newval = [];
|
||||
my $ver = shift @$val;
|
||||
push @$newval, $ver;
|
||||
foreach(@$val) {
|
||||
push @$newval, LJ::MemCache::array_to_hash("fgrp", [$ver, @$_]);
|
||||
}
|
||||
$val = $newval;
|
||||
}
|
||||
|
||||
if ($key =~ /^upicinf:(\d+)$/) {
|
||||
my $userid = $1;
|
||||
my ($ver, $picstr, $kwstr) = @$val;
|
||||
my $info = {
|
||||
'version' => $ver,
|
||||
'pic' => {},
|
||||
'kw' => {},
|
||||
};
|
||||
|
||||
while (length $picstr >= 7) {
|
||||
my $pic = { userid => $userid };
|
||||
($pic->{picid},
|
||||
$pic->{width}, $pic->{height},
|
||||
$pic->{state}) = unpack "NCCA", substr($picstr, 0, 7, '');
|
||||
$info->{pic}{$pic->{picid}} = $pic;
|
||||
}
|
||||
|
||||
my ($pos, $nulpos);
|
||||
$pos = $nulpos = 0;
|
||||
while (($nulpos = index($kwstr, "\0", $pos)) > 0) {
|
||||
my $kw = substr($kwstr, $pos, $nulpos-$pos);
|
||||
my $id = unpack("N", substr($kwstr, $nulpos+1, 4));
|
||||
$pos = $nulpos + 5; # skip NUL + 4 bytes.
|
||||
$info->{kw}{$kw} = $info->{pic}{$id} if $info;
|
||||
}
|
||||
$val = $info;
|
||||
}
|
||||
|
||||
if ($key =~ /^friends:/) {
|
||||
my $ver = substr($val, 0, 1, '');
|
||||
my $packfmt = "NH6H6NC";
|
||||
my $packlen = 15;
|
||||
my @cols = qw(friendid fgcolor bgcolor groupmask showbydefault);
|
||||
my %friends;
|
||||
|
||||
while (length($val) >= $packlen) {
|
||||
my @row = unpack($packfmt, substr($val, 0, $packlen, ''));
|
||||
|
||||
# add "#" to beginning of colors
|
||||
$row[$_] = "\#$row[$_]" foreach 1..2;
|
||||
|
||||
# turn unpacked row into hashref
|
||||
my $fid = $row[0];
|
||||
my $idx = 1;
|
||||
foreach my $col (@cols[1..$#cols]) {
|
||||
$friends{$fid}->{$col} = $row[$idx];
|
||||
$idx++;
|
||||
}
|
||||
}
|
||||
$val = [$ver, \%friends];
|
||||
}
|
||||
|
||||
if ($key =~ /^tu:/) {
|
||||
$val = unpack("N", $val);
|
||||
}
|
||||
if ($key =~ /^te:/) {
|
||||
$val = unpack("N", $val);
|
||||
}
|
||||
# just in case this remains a packed scalar
|
||||
if (not ref $val) {
|
||||
$val =~ s/([\x00-\x1f])/sprintf("\\x%02x", $1)/eg;
|
||||
}
|
||||
$ret .= "<b>Data: </b>";
|
||||
|
||||
my $dumper = Data::Dumper->new([$val],["Value"]);
|
||||
$dumper->Terse(1);
|
||||
$dumper->Indent(2);
|
||||
my $d = $dumper->Dump();
|
||||
|
||||
$ret.= "<pre>" . LJ::ehtml($d) . "</pre>";
|
||||
|
||||
return;
|
||||
};
|
||||
|
||||
|
||||
if ($POST{'query'}) {
|
||||
foreach my $key (split(/\r\n/, $POST{'query'})) {
|
||||
|
||||
next unless $key =~ /\S/;
|
||||
# shortcuts
|
||||
$key =~ s/(##)(\w+)/$cuid->($2)/eg;
|
||||
$key =~ s/(#)(\w+)/$uid->($2)/eg;
|
||||
$key =~ s!\((\d+)\)!int($1/256)!eg;
|
||||
|
||||
my $sock = LJ::MemCache::_get_sock($key);
|
||||
$ret .= "<p><b>Key: </b>$key<br />";
|
||||
|
||||
unless ($sock) {
|
||||
$ret .= "<b>Error: </b>Could not connect to server<br /></p>";
|
||||
next;
|
||||
}
|
||||
|
||||
if ($POST{'sock'}) {
|
||||
$ret .= "<b>Socket:</b> $sock<br />";
|
||||
}
|
||||
|
||||
my $hashkey = $get_hashkey->($key);
|
||||
if ($hashkey) {
|
||||
$ret .= "<b>Hashkey:</b> $hashkey<br />";
|
||||
}
|
||||
my $pars = defined($hashkey) ? [$hashkey, $key] : $key;
|
||||
my $val = LJ::MemCache::get($pars);
|
||||
unless (defined $val) {
|
||||
$ret .= "<b>Data:</b> not found</br ></p>";
|
||||
next;
|
||||
}
|
||||
$display->($key, $val);
|
||||
$ret .= "</p>";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
#my $docurl = 'http://cvs.livejournal.org/browse.cgi/livejournal/doc/raw/memcache-keys.txt?rev=.&content-type=text/x-cvsweb-markup';
|
||||
#my $docurl = 'http://cvs-ljr.lenin.ru/cgi-bin/viewvc.cgi/LJR/livejournal/doc/raw/memcache-keys.txt?view=markup';
|
||||
my $docurl = 'http://lj.rossia.org/admin/memcache-keys.txt';
|
||||
|
||||
$ret .= "<p>Enter your memcache query(-ies) below.</p>";
|
||||
$ret .= "<p>Here\'s the <a href='$docurl'>reference</a> of key names.</p>";
|
||||
$ret .= "<p>Shortcuts: <blockquote>#username -> userid<br /> ##username -> cid:userid<br />(number) -> number/256 </blockquote></p>";
|
||||
|
||||
$ret .= "<form method='post' action='memcache_view.bml'>";
|
||||
$ret .= "<textarea name=query rows=3 cols=60 wrap=off></textarea> ";
|
||||
$ret .= "<p>" . LJ::html_check({ 'type' => 'check', 'name' => 'sock', 'id' => 'sock' });
|
||||
$ret .= "<label for='sock'>Show host/port per key.</label></p>";
|
||||
|
||||
$ret .= "<input type='submit' value='Submit'>";
|
||||
return $ret;
|
||||
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
56
local/htdocs/admin/netstat.bml
Executable file
56
local/htdocs/admin/netstat.bml
Executable file
@@ -0,0 +1,56 @@
|
||||
<html>
|
||||
<head><title>Netstat</title>
|
||||
<body>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
|
||||
|
||||
# only logged in users:
|
||||
|
||||
my $u = LJ::get_remote();
|
||||
return "You must be logged in to view this tool." unless $u;
|
||||
return "You don't have 'finduser' priv." unless LJ::check_priv($u, "finduser");
|
||||
|
||||
|
||||
# view load average
|
||||
##my $uptime = ` top -b |head -12 `;
|
||||
|
||||
my $uptime = `uptime`;
|
||||
|
||||
# but hide uptime :)
|
||||
my @uptime = split(/,\s*/, $uptime);
|
||||
@uptime = splice(@uptime, 3);
|
||||
$uptime = join(", ", @uptime);
|
||||
|
||||
|
||||
# netstat
|
||||
my $netstat0 = `nice netstat -tanW `;
|
||||
my $ip = '80.84.69.51';
|
||||
|
||||
my $netstat1 = `echo "$netstat0" | grep ':8' | awk '{print \$6}' | sort | uniq -c `;
|
||||
|
||||
my $netstat2 = `echo "$netstat0" |grep -v TIME_WAIT |grep "0 127.0.0.2:8" |grep -v LISTEN | sort -k 5 `;
|
||||
|
||||
my $netstat3 = `echo "$netstat0" |grep -v TIME_WAIT |grep $ip:80 |grep -v LISTEN | sort -k 5 `;
|
||||
|
||||
# but hide IP
|
||||
$netstat3 =~ s/$ip/" lj.rossia.org"/eg;
|
||||
|
||||
my $netstat = $netstat1 . "\n" . $netstat2 . "\n" . $netstat3 ;
|
||||
|
||||
|
||||
# htmt
|
||||
my $ret = $uptime ;
|
||||
$ret = $ret . " <a href='http://lj.rossia.org/1488_server-status_'>requests</a>";
|
||||
|
||||
$ret = "<pre>" . $ret . "\n" . $netstat . "</pre>";
|
||||
|
||||
return $ret;
|
||||
|
||||
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
339
local/htdocs/admin/priv/index.bml
Executable file
339
local/htdocs/admin/priv/index.bml
Executable file
@@ -0,0 +1,339 @@
|
||||
<html><head>
|
||||
<meta name="robots" content="noindex, nofollow, noarchive" />
|
||||
<meta name="googlebot" content="nosnippet" />
|
||||
<title>Privilege Management</title>
|
||||
</head><body>
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%FORM);
|
||||
|
||||
my $dbh = LJ::get_db_writer;
|
||||
|
||||
my ($sth, $ret);
|
||||
my $mode = $FORM{'mode'};
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
LJ::load_user_privs($remote, 'admin') if $remote;
|
||||
|
||||
my @privs;
|
||||
my %priv;
|
||||
my %pcode2id;
|
||||
$sth = $dbh->prepare("SELECT prlid, privcode, privname, des, is_public, scope FROM priv_list ORDER BY privcode");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref) {
|
||||
push @privs, $_;
|
||||
$priv{$_->{'prlid'}} = $_;
|
||||
$pcode2id{$_->{'privcode'}} = $_->{'prlid'};
|
||||
}
|
||||
|
||||
if (LJ::did_post()) {
|
||||
return "<p><b>ERROR:</b> Invalid form submission" unless LJ::check_form_auth();
|
||||
}
|
||||
|
||||
unless ($mode)
|
||||
{
|
||||
if ($FORM{'user'}) { $mode = "viewuser"; }
|
||||
elsif ($FORM{'priv'}) { $mode = "viewpriv"; }
|
||||
}
|
||||
|
||||
if ($FORM{'devmode'}) {
|
||||
return "not in dev mode" unless $LJ::IS_DEV_SERVER;
|
||||
my $userid = $remote->{userid};
|
||||
if ($dbh->do("INSERT INTO priv_map (userid, prlid, arg) SELECT ?, prlid, ? FROM priv_list WHERE privcode=?",
|
||||
undef, $userid, $FORM{arg}, $FORM{priv})) {
|
||||
LJ::statushistory_add($dbh, $userid, $userid, "privadd", "DEVMODE Granting: \"$FORM{priv}\" with arg \"$FORM{arg}\"");
|
||||
return "done.";
|
||||
} else {
|
||||
return "fail.";
|
||||
}
|
||||
}
|
||||
|
||||
unless ($mode)
|
||||
{
|
||||
$ret .= "<h1>Privilege Management</h1>\n";
|
||||
$ret .= "<form method='get' action='index.bml'>";
|
||||
$ret .= "<p>View all privileges of user <input name='user' size='15' /> <input type='submit' value=\"Load\" /></p></form>";
|
||||
|
||||
$ret .= "<p>Or, show all users with privilege:</p><dl>";
|
||||
foreach my $priv (@privs) {
|
||||
my ($des, $args) = split(/arg=/, $priv->{'des'});
|
||||
$ret .= "<dt><strong><a href='./?priv=$priv->{'privcode'}'>$priv->{'privcode'}</a>: $priv->{'privname'}</strong>";
|
||||
$ret .= " <i>(Site Specific)</i>" if $priv->{'scope'} eq 'local';
|
||||
$ret .= "</dt>";
|
||||
$ret .= "<dd>$des\n";
|
||||
$ret .= "<br /><strong>Argument:</strong> $args" if $args;
|
||||
$ret .= "</dd>";
|
||||
}
|
||||
$ret .= "</dl>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
||||
# Returns true if the remote user can grant the given priv
|
||||
sub remote_can_grant
|
||||
{
|
||||
my ($remote, $priv, $arg) = @_;
|
||||
return 0 unless defined $priv;
|
||||
return LJ::check_priv($remote, 'admin', $priv) || LJ::check_priv($remote, 'admin', '*') || LJ::check_priv($remote, 'admin', "$priv/$arg");
|
||||
}
|
||||
|
||||
if ($mode eq "userchange" || $mode eq "privchange")
|
||||
{
|
||||
unless (LJ::did_post()) {
|
||||
return "<p><b>Error:</b> requires post</p>";
|
||||
}
|
||||
|
||||
unless ($FORM{'submit:refresh'}) {
|
||||
foreach my $key (keys %FORM) {
|
||||
if ($key =~ /^revoke:(\d+):(\d+)$/) {
|
||||
my $prmid = $1;
|
||||
my $del_userid1 = $2;
|
||||
my $sth = $dbh->prepare("SELECT userid, prlid, arg FROM priv_map WHERE prmid=$prmid");
|
||||
$sth->execute;
|
||||
my ($del_userid2, $prlid, $arg) = $sth->fetchrow_array;
|
||||
|
||||
unless (remote_can_grant($remote, $priv{$prlid}->{'privcode'}, $arg)) {
|
||||
$ret .= "ERROR: Invalid access to remove priv $priv{$prlid}->{'privcode'}.<br />";
|
||||
} else {
|
||||
if ($del_userid1 && $del_userid1 == $del_userid2)
|
||||
{
|
||||
$dbh->do("DELETE FROM priv_map WHERE prmid=$prmid");
|
||||
my $privcode = $priv{$prlid}->{'privcode'};
|
||||
LJ::statushistory_add($dbh, $del_userid1, $remote->{'userid'}, "privdel",
|
||||
"Denying: \"$privcode\" with arg \"$arg\"");
|
||||
$ret .= "Privilege removed.<br />\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($FORM{'grantpriv'}) {
|
||||
my $u = LJ::load_user($FORM{'user'});
|
||||
return "ERROR: Invalid user." unless $u;
|
||||
my $userid = $u->{'userid'};
|
||||
my $qpriv = $FORM{'grantpriv'}+0;
|
||||
my $privcode = $priv{$qpriv}->{'privcode'};
|
||||
my $arg = $FORM{'arg'};
|
||||
|
||||
if ($privcode) {
|
||||
if (remote_can_grant($remote, $privcode, $arg)) {
|
||||
if (LJ::check_priv($u, $privcode, $arg)) {
|
||||
$ret .= "ERROR: User already has specified priv <b>$privcode $arg</b>.<br />";
|
||||
} else {
|
||||
my $qarg = $dbh->quote($arg);
|
||||
$dbh->do("INSERT INTO priv_map (prmid, userid, prlid, arg) VALUES (NULL, $userid, $qpriv, $qarg)");
|
||||
LJ::statushistory_add($dbh, $userid, $remote->{'userid'}, "privadd", "Granting: \"$privcode\" with arg \"$arg\"");
|
||||
$ret .= "Privilege <b>$privcode $arg</b> granted.<br />\n";
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: You don't have access to grant <b>$privcode $arg</b>.<br />\n";
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: Unknown privilege.<br />\n";
|
||||
}
|
||||
}
|
||||
if ($FORM{'grantuser'}) {
|
||||
my $u = LJ::load_user($FORM{'grantuser'});
|
||||
return "ERROR: Invalid user." unless $u;
|
||||
my $userid = $u->{'userid'};
|
||||
my $privid = $pcode2id{$FORM{'priv'}};
|
||||
my $arg = $FORM{'arg'};
|
||||
my $qarg = $dbh->quote($arg);
|
||||
my $privcode = $priv{$privid}->{'privcode'};
|
||||
if ($privcode) {
|
||||
if (remote_can_grant($remote, $privcode, $arg)) {
|
||||
if (LJ::check_priv($u, $privcode, $arg)) {
|
||||
$ret .= "ERROR: User already has specified priv <b>$privcode $arg</b>.<br />";
|
||||
}
|
||||
elsif ($userid && $privid) {
|
||||
my $qarg = $dbh->quote($FORM{'arg'});
|
||||
$dbh->do("INSERT INTO priv_map (prmid, userid, prlid, arg) VALUES (NULL, $userid, $privid, $qarg)");
|
||||
LJ::statushistory_add($dbh, $userid, $remote->{'userid'}, "privadd", "Granting: \"$privcode\" with arg \"$FORM{'arg'}\"");
|
||||
$ret .= "Privilege added.<br />\n";
|
||||
}
|
||||
else {
|
||||
my $euser = LJ::ehtml($FORM{'grantuser'});
|
||||
unless ($userid) {
|
||||
$ret .= "ERROR: cannot grant priv to non-existent user <b>$euser</b><br />";
|
||||
}
|
||||
else { $ret .= "privid is 0!<br />"; }
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: You don't have access to grant <B>$privcode</B> with argument '$arg'.<br />\n";
|
||||
}
|
||||
} else {
|
||||
$ret .= "ERROR: Unknown privilege.<br />\n";
|
||||
}
|
||||
} # end if grantuser
|
||||
}
|
||||
|
||||
if ($mode eq "userchange") { $mode = "viewuser"; }
|
||||
if ($mode eq "privchange") { $mode = "viewpriv"; }
|
||||
}
|
||||
|
||||
if ($mode eq "viewuser")
|
||||
{
|
||||
my $user = LJ::canonical_username($FORM{'user'});
|
||||
my $userid = LJ::get_userid($user);
|
||||
|
||||
$ret .= "<h1><a href='./'><<</a> view user \"$user\"</h1>\n";
|
||||
unless ($userid) {
|
||||
$ret .= "<b>Error:</b> non-existent user\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret .= "<form method='post' action='./'>\n";
|
||||
$ret .= LJ::form_auth();
|
||||
$ret .= "<input type='hidden' name='mode' value='userchange' />\n";
|
||||
$ret .= "<input type='hidden' name='user' value='$user' />\n";
|
||||
$sth = $dbh->prepare("SELECT pm.prmid, pm.prlid, pm.arg FROM priv_map pm, priv_list pl WHERE pm.prlid=pl.prlid AND pm.userid=$userid ORDER BY pl.privcode,pm.arg");
|
||||
$sth->execute;
|
||||
$ret .= "<table cellpadding='5' cellspacing='1' border='1'><tr><td><b>Revoke</b></td><td><b>Privilege</b></td><td><b>Arg</b></td></tr>\n";
|
||||
while (my ($prmid, $prlid, $arg) = $sth->fetchrow_array)
|
||||
{
|
||||
my $prec = $priv{$prlid};
|
||||
my $pcode = $priv{$prlid}->{'privcode'};
|
||||
my $can_grant = remote_can_grant($remote, $pcode, $arg);
|
||||
|
||||
next unless ($prec->{'is_public'} || ($remote && $remote->{'userid'} == $userid) || $can_grant);
|
||||
|
||||
$ret .= "<tr><td align='center'>";
|
||||
if ($can_grant) {
|
||||
$ret .= "<input type='checkbox' name='revoke:$prmid:$userid' />";
|
||||
} else {
|
||||
$ret .= "--";
|
||||
}
|
||||
|
||||
$ret .= "</td><td><a href='./?priv=$pcode'>$pcode</a></td>";
|
||||
if ($arg)
|
||||
{
|
||||
$ret .= "<td><a href='./?priv=$pcode&viewarg=$arg'>$arg</a></td></tr>\n";
|
||||
} else {
|
||||
$ret .= "<td> </td></tr>\n";
|
||||
}
|
||||
}
|
||||
$ret .= "</table>";
|
||||
|
||||
if (LJ::check_priv($remote, 'admin')) {
|
||||
$ret .= "<p>Grant <b>$user</b> privilege:<div style='margin-left: 20px;'>\n";
|
||||
$ret .= "<select name='grantpriv'><option value='' selected='1'></option>";
|
||||
foreach my $priv (@privs) {
|
||||
$ret .= "<option value='$priv->{'prlid'}'>$priv->{'privcode'}</option>";
|
||||
}
|
||||
$ret .= "</select>\n";
|
||||
$ret .= "Arg: <input name='arg' size='10' maxlength='40' /></div>\n";
|
||||
} else {
|
||||
$ret .= "<p><i>(you do not have access to grant any privileges)</i></p>\n";
|
||||
}
|
||||
|
||||
$ret .= "<p>\n";
|
||||
if (LJ::check_priv($remote, 'admin')) {
|
||||
$ret .= "<input type=\"submit\" value=\"Make Changes\" />";
|
||||
}
|
||||
$ret .= " <input type=\"submit\" name=\"submit:refresh\" value=\"Just Refresh\" />";
|
||||
$ret .= "</form>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
if ($mode eq "viewpriv") {
|
||||
my $priv = $pcode2id{$FORM{'priv'}};
|
||||
my $prec = $priv{$priv};
|
||||
my $pcode = $prec->{'privcode'};
|
||||
my $skip = $FORM{'skip'} + 0;
|
||||
my $limit = 100;
|
||||
|
||||
my $viewarg;
|
||||
if ($FORM{'viewarg'}) {
|
||||
$viewarg = " AND pm.arg=" . $dbh->quote($FORM{'viewarg'});
|
||||
}
|
||||
|
||||
my $privname = join(' ', grep { $_ } $priv{$priv}->{'privcode'}, $FORM{'viewarg'});
|
||||
$ret .= "<h1><a href=\"./\"><<</a> view priv \"$privname\"</h1>\n";
|
||||
$ret .= "<p><b>Privilege Name:</b> $priv{$priv}->{'privname'}";
|
||||
my ($des, $args) = split(/arg=/, $priv{$priv}->{'des'});
|
||||
$ret .= "<br /><b>Description:</b> $des" if $des;
|
||||
$ret .= "<br /><b>Argument:</b> $args" if $args;
|
||||
$ret .= "</p>";
|
||||
|
||||
# $pcode is the name of the privilege list they're looking at, and $FORM{'viewarg'} is
|
||||
# the argument in particular they care about
|
||||
unless ($prec->{'is_public'} || remote_can_grant($remote, $pcode, $FORM{'viewarg'})) {
|
||||
$ret .= "<p><b>ERROR:</b> This privilege's access list is not public.</p>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
$ret .= "<form style='display: inline;' action='./' method='post'>\n";
|
||||
$ret .= LJ::form_auth();
|
||||
$ret .= "<p><b>View only privs with arg:</b> ";
|
||||
$ret .= "<input name='viewarg' size='10' /> ";
|
||||
$ret .= "<input type='submit' name='submit:load' value='Load' /></p>\n";
|
||||
|
||||
$ret .= "<input type='hidden' name='mode' value='privchange' />\n";
|
||||
$ret .= "<input type='hidden' name='priv' value='$pcode' />";
|
||||
$sth = $dbh->prepare("SELECT pm.prmid, u.user, u.userid, pm.arg ".
|
||||
"FROM priv_map pm, useridmap u WHERE pm.prlid=$priv AND pm.userid=u.userid$viewarg ".
|
||||
"ORDER BY u.user,pm.arg LIMIT $skip,$limit");
|
||||
$sth->execute;
|
||||
$ret .= "<table cellpadding='5' cellspacing='1' border='1'><tr><td><b>Revoke</b></td><td><b>User</b></td><td><b>Arg</b></td></tr>\n";
|
||||
|
||||
my $showgrant = remote_can_grant($remote, $pcode, $FORM{'viewarg'});
|
||||
my $foundcount = 0;
|
||||
|
||||
while ($_ = $sth->fetchrow_hashref)
|
||||
{
|
||||
$foundcount++;
|
||||
$ret .= "<tr><td align='center'>";
|
||||
if (remote_can_grant($remote, $priv{$priv}->{'privcode'}, $_->{'arg'}))
|
||||
{
|
||||
$ret .= "<input type='checkbox' name=\"revoke:$_->{'prmid'}:$_->{'userid'}\" />";
|
||||
} else {
|
||||
$ret .= "--";
|
||||
}
|
||||
$ret .= "</td><td><a href=\"./?user=$_->{'user'}\">$_->{'user'}</a></td>";
|
||||
if ($_->{'arg'} ne "")
|
||||
{
|
||||
$ret .= "<td><a href=\"./?priv=$priv{$priv}->{'privcode'}&viewarg=$_->{'arg'}\">$_->{'arg'}</a></td></tr>\n";
|
||||
} else {
|
||||
$ret .= "<td> </td></tr>\n";
|
||||
}
|
||||
}
|
||||
$ret .= "<tr><td colspan='3'><b>$foundcount users</b></td></tr>\n";
|
||||
$ret .= "</table>";
|
||||
|
||||
if ($foundcount >= $limit) {
|
||||
$ret .= "<a href='" . BML::self_link({'skip'=>($skip +$limit)}) . "'>See more...</a>\n";
|
||||
}
|
||||
|
||||
if ($showgrant) {
|
||||
$ret .= "<p>Grant <b>$privname</b> privilege to:<ul>";
|
||||
$ret .= "User: <input name='grantuser' size='15' maxlength='15' /> ";
|
||||
$ret .= "Arg: <input name='arg' size='10' maxlength='40' value='$FORM{'viewarg'}'/></ul>\n";
|
||||
} else {
|
||||
$ret .= "<p><i>(you don't have access to grant this privilege to other users)</i></p>\n";
|
||||
}
|
||||
|
||||
if ($showgrant) {
|
||||
$ret .= "<input name=\"submit:change\" type='submit' value=\"Make Changes\" />\n";
|
||||
}
|
||||
$ret .= "</form>\n";
|
||||
|
||||
$ret .= "<form style='display: inline;' method='post' action='./'>\n";
|
||||
$ret .= LJ::form_auth();
|
||||
$ret .= LJ::html_hidden('mode', 'privchange',
|
||||
'priv', $pcode,
|
||||
'viewarg', $FORM{'viewarg'}) . "\n";
|
||||
$ret .= "<input type='submit' name=\"submit:refresh\" value=\"Just Refresh\" />\n";
|
||||
$ret .= "</form>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
return "Unknown mode.";
|
||||
|
||||
_code?>
|
||||
</body>
|
||||
</html>
|
||||
<?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl
|
||||
link: htdocs/admin/priv/index.bml
|
||||
post: htdocs/admin/priv/index.bml
|
||||
</LJDEP _c?>
|
||||
12
local/htdocs/bots/index.html
Executable file
12
local/htdocs/bots/index.html
Executable file
@@ -0,0 +1,12 @@
|
||||
<title></title>
|
||||
|
||||
<h2>Please advise your robots to use Last-Modified header.</h2>
|
||||
|
||||
<a href='http://fishbowl.pastiche.org/2002/10/21/http_conditional_get_for_rss_hackers/'>1</a>,
|
||||
<a href='http://www.kbcafe.com/rss/rssfeedstate.html#lastmodified'>2</a>
|
||||
<p>
|
||||
Support of gzip decompression on a client side recommended.
|
||||
<p>
|
||||
Also, RSS are cached on the server so polling interval faster than 5 minutes will not help.
|
||||
|
||||
|
||||
178
local/htdocs/changepassword.bml
Executable file
178
local/htdocs/changepassword.bml
Executable file
@@ -0,0 +1,178 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
head=><?_code return LJ::robot_meta_tags(); _code?>
|
||||
body<=
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
|
||||
my $body;
|
||||
|
||||
if ($LJ::SERVER_DOWN) {
|
||||
$body = LJ::server_down_html();
|
||||
return $body;
|
||||
}
|
||||
|
||||
|
||||
# Only logged user can change its own password
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return LJ::bad_input($ML{'error.noremote'})
|
||||
unless $remote;
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $memoryu = LJ::get_authas_user($authas);
|
||||
return LJ::bad_input($ML{'error.invalidauth'})
|
||||
unless $memoryu;
|
||||
|
||||
|
||||
|
||||
if ($LJ::USE_SSL && ! $LJ::IS_SSL && $FORM{'ssl'} ne "no") {
|
||||
return BML::redirect("$LJ::SSLROOT/changepassword.bml");
|
||||
}
|
||||
|
||||
my $crumb = $LJ::IS_SSL ? 'securechangepass' : 'changepass';
|
||||
LJ::set_active_crumb($crumb);
|
||||
|
||||
my $update_form = sub {
|
||||
my $ret;
|
||||
|
||||
# else, show the form to change:
|
||||
$ret .= "<form action='changepassword.bml' method='post'>\n";
|
||||
$ret .= LJ::html_hidden(mode => 'submit',
|
||||
ssl => $GET{'ssl'});
|
||||
|
||||
$ret .= "<?h1 $ML{'.changepassword.header'} h1?>\n";
|
||||
$ret .= "<?p $ML{'.changepassword.instructions'} p?>\n";
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
# Warn them if logged in and not validated
|
||||
if (!LJ::did_post() && $remote && $remote->{'status'} ne 'A') {
|
||||
$ret .= "<?warningbar <b>$ML{'label.warning'}</b> $ML{'.error.notvalidated'} warningbar?>";
|
||||
$ret .= "<br />";
|
||||
}
|
||||
|
||||
$ret .= "<?standout\n";
|
||||
$ret .= "$ML{'Username'}: $authas <br />\n<br />\n";
|
||||
|
||||
# we make the field for the new password *longer* than the max length
|
||||
# for a password - that way we can tell if someone is trying to use an
|
||||
# excessively long password, instead of silently truncating it.
|
||||
|
||||
$ret .= "$ML{'.oldpassword'}<br />\n";
|
||||
$ret .= "<input type='password' name='password' size='30' maxlength='30' /><br />\n";
|
||||
$ret .= "$ML{'.newpassword'}<br />\n";
|
||||
$ret .= "<input type='password' name='newpass1' size='30' maxlength='31' /><br />\n";
|
||||
$ret .= "$ML{'.newpasswordagain'}<br />\n";
|
||||
$ret .= "<input type='password' name='newpass2' size='30' maxlength='31' /><br />\n";
|
||||
$ret .= "standout?>\n";
|
||||
|
||||
$ret .= "<?h1 $ML{'Proceed'} h1?>\n";
|
||||
$ret .= "<?p $ML{'.proceed.instructions'} p?>\n";
|
||||
|
||||
$ret .= "<?standout\n";
|
||||
$ret .= "<input type='submit' value='$ML{'.btn.proceed'}' />\n";
|
||||
$ret .= "standout?>\n";
|
||||
$ret .= "</form>\n";
|
||||
return $ret;
|
||||
};
|
||||
|
||||
unless (LJ::did_post()) {
|
||||
$body .= $update_form->();
|
||||
} elsif ($POST{'mode'} eq 'submit') {
|
||||
my $user = $authas; #LJ::canonical_username($POST{'user'});
|
||||
my $password = $POST{'password'};
|
||||
my $newpass1 = LJ::trim($POST{'newpass1'});
|
||||
my $newpass2 = LJ::trim($POST{'newpass2'});
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
my $u = LJ::load_user($user);
|
||||
|
||||
my @errors = ();
|
||||
if ($user eq "test") { push @errors, $ML{'.error.changetestaccount'}; }
|
||||
unless ($user) {
|
||||
push @errors, $ML{'.error.mustenterusername'};
|
||||
} else {
|
||||
unless (defined $u) {
|
||||
push @errors, BML::ml('.error.invaliduser', {'user' => $user} );
|
||||
} else {
|
||||
if (LJ::login_ip_banned($u)) {
|
||||
push @errors, $ML{'error.ipbanned'};
|
||||
} elsif ($u->{'password'} eq "" || $u->{'password'} ne $password) {
|
||||
push @errors, $ML{'.error.badoldpassword'};
|
||||
LJ::handle_bad_login($u);
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($newpass1 ne $newpass2) {
|
||||
push @errors, $ML{'.error.badnewpassword'};
|
||||
} else {
|
||||
if ($newpass1 eq "") {
|
||||
push @errors, $ML{'.error.blankpassword'};
|
||||
} elsif (length $newpass1 > 30) {
|
||||
push @errors, $ML{'.error.characterlimit'};
|
||||
} else {
|
||||
|
||||
my @checkpass = LJ::run_hooks("bad_password",
|
||||
{ 'user' => $u->{'user'}, 'password' => $newpass1,
|
||||
'name' => $u->{'name'}, 'email' => $u->{'email'} });
|
||||
if (@checkpass && $checkpass[0]->[0]) {
|
||||
push @errors, BML::ml('.error.badcheck', {'error' => $checkpass[0]->[0]});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# don't allow changes if email address is not validated
|
||||
unless ($u->{'status'} eq 'A') {
|
||||
push @errors, $ML{'.error.notvalidated'};
|
||||
}
|
||||
|
||||
unless (LJ::is_ascii($newpass1)) {
|
||||
push @errors, $ML{'.error.nonascii'};
|
||||
}
|
||||
|
||||
if (@errors) {
|
||||
$body .= LJ::error_list(@errors);
|
||||
$body .= $update_form->();
|
||||
return $body;
|
||||
}
|
||||
|
||||
## make note of changed password
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $oldval = Digest::MD5::md5_hex($u->{'password'} . "change");
|
||||
LJ::infohistory_add($u, 'password', $oldval);
|
||||
|
||||
LJ::update_user($u, { password => $POST{'newpass1'} });
|
||||
|
||||
# Kill all sessions, forcing user to relogin
|
||||
$u->kill_all_sessions;
|
||||
|
||||
LJ::send_mail({
|
||||
'to' => $u->{'email'},
|
||||
'from' => $LJ::ADMIN_EMAIL,
|
||||
'fromname' => $LJ::SITENAME,
|
||||
'charset' => 'utf-8',
|
||||
'subject' => $ML{'.email.subject'},
|
||||
'body' => BML::ml('.email.body', {'sitename'=>$LJ::SITENAME, 'siteroot'=>$LJ::SITEROOT})});
|
||||
|
||||
$body = "<?h1 $ML{'Success'} h1?><?p $ML{'.success.text'} p?>";
|
||||
|
||||
# if they were logged in, tell them to relogin
|
||||
$body .= "<?p " . BML::ml('.relogin', { 'aopts' => "href='/login.bml'" }) . " p?>" if $remote;
|
||||
|
||||
LJ::run_hooks("post_changepassword", {
|
||||
"u" => $u,
|
||||
"newpassword" => $POST{'newpass1'},
|
||||
"oldpassword" => $u->{'password'},
|
||||
});
|
||||
}
|
||||
|
||||
return $body;
|
||||
_code?>
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
post: htdocs/changepassword.bml
|
||||
lib: Digest::MD5
|
||||
hook: post_changepassword
|
||||
</LJDEP> _c?>
|
||||
315
local/htdocs/community/create.bml
Executable file
315
local/htdocs/community/create.bml
Executable file
@@ -0,0 +1,315 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
|
||||
LJ::set_active_crumb('createcommunity');
|
||||
|
||||
return LJ::server_down_html() if $LJ::SERVER_DOWN;
|
||||
return "<?badinput?>" unless LJ::text_in(\%POST);
|
||||
|
||||
my $mode = $POST{mode} || 'getinfo';
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return "<?needlogin?>" if !$remote;
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'.error.notperson'} p?>"
|
||||
if $remote->{journaltype} ne 'P';
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'.error.notactive'} p?>"
|
||||
unless $remote->{statusvis} eq 'V';
|
||||
|
||||
if ($remote->underage) {
|
||||
return BML::redirect("$LJ::SITEROOT/agecheck/?s=1");
|
||||
}
|
||||
|
||||
# fix up the incoming data (is used in getinfo mode and submit mode so it's here)
|
||||
$POST{membership} = 'open'
|
||||
unless $POST{membership} =~ m/^(?:open|moderated|closed)$/;
|
||||
$POST{postlevel} = 'members'
|
||||
unless $POST{postlevel} =~ m/^(?:members|select)$/;
|
||||
$POST{nonmember_posting} = '0'
|
||||
unless $POST{nonmember_posting} =~ m/^[01]$/;
|
||||
$POST{moderated} = '0'
|
||||
unless $POST{moderated} =~ m/^[01]$/;
|
||||
|
||||
# MODE: submit - try to create an account. might change mode
|
||||
# if there are errors, we'll populate $error and
|
||||
# return to "getinfo" mode below
|
||||
my $error;
|
||||
SUBMIT:
|
||||
while ($mode eq 'submit') # using while instead of if so we can 'last' out of it
|
||||
{
|
||||
return "<b>$ML{'Error'}</b>: $ML{'.error.postrequired'}" unless LJ::did_post();
|
||||
|
||||
my $user = LJ::canonical_username($POST{user});
|
||||
my $title = $POST{title} || $user;
|
||||
|
||||
# reject this email?
|
||||
return LJ::sysban_block(0, "Create user blocked based on email",
|
||||
{ new_user => $user, email => $remote->{email}, name => $user })
|
||||
if LJ::sysban_check('email', $remote->{email});
|
||||
|
||||
$error = "$ML{'error.usernamelong'}" if length($user) > 15;
|
||||
$error = "$ML{'error.usernameinvalid'}" if $POST{user} && !$user;
|
||||
$error = "$ML{'.error.username.mustenter'}" unless $POST{user};
|
||||
|
||||
my $u = LJ::load_user($user);
|
||||
|
||||
if(!LJ::check_priv($remote, 'create_protected_com')){
|
||||
foreach my $re ("^system\$", @LJ::PROTECTED_USERNAMES) {
|
||||
next unless $user =~ /$re/;
|
||||
|
||||
# you can give people sharedjournal priv ahead of time to create
|
||||
# reserved communities:
|
||||
next if LJ::check_priv($remote, "sharedjournal", $user);
|
||||
|
||||
$error = "$ML{'.error.username.reserved'}";
|
||||
}
|
||||
}
|
||||
|
||||
my $second_submit = 0;
|
||||
if ($u) {
|
||||
my $in_use = 1;
|
||||
|
||||
if ($u->{email} eq $remote->{email}) {
|
||||
if (LJ::login_ip_banned($u)) {
|
||||
# brute-force possible going on
|
||||
} else {
|
||||
if ($u->{password} eq $remote->{password}) {
|
||||
# oh, they double-clicked the submit button
|
||||
$second_submit = 1;
|
||||
|
||||
# if we found a comm and everything matches, they double hit. if
|
||||
# we found a person/etc, then they tried to recreate their community,
|
||||
# which isn't allowed anymore
|
||||
$in_use = $u->{journaltype} eq 'C' ? 0 : 1;
|
||||
} else {
|
||||
LJ::handle_bad_login($u);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($in_use) {
|
||||
$error = "$ML{'.error.username.inuse'}";
|
||||
}
|
||||
}
|
||||
|
||||
last SUBMIT if $error;
|
||||
|
||||
my $qclusterid = LJ::new_account_cluster() + 0;
|
||||
die "Cluster 0 not supported" unless $qclusterid;
|
||||
|
||||
my $userid = ref $u ? $u->{userid} : 0;
|
||||
unless ($second_submit) {
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my $errorcounter = 0;
|
||||
my $old_print_error = $dbh->{PrintError}; # save PrintError mode
|
||||
$dbh->{PrintError} = 0; # will check for errors manually
|
||||
|
||||
while (1) {
|
||||
my $ruserid = LJ::get_new_userid("P");
|
||||
|
||||
if (!$ruserid) {
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'error.procrequest'} p?>";
|
||||
}
|
||||
$dbh->do("set insert_id = $ruserid");
|
||||
|
||||
$dbh->do(
|
||||
"INSERT INTO user (user, email, status, caps, name, clusterid, dversion, journaltype) ".
|
||||
"VALUES (?, ?, ?, ?, ?, ?, $LJ::MAX_DVERSION, 'C')",
|
||||
undef, $user, $remote->{email}, $remote->{status}, int($LJ::NEWUSER_CAPS), $title, $qclusterid);
|
||||
|
||||
if ($dbh->err) {
|
||||
# who wants to try forever
|
||||
if ($errorcounter > 10) {
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'error.procrequest'} <b>" . $dbh->errstr . "</b> p?>";
|
||||
}
|
||||
|
||||
$errorcounter++;
|
||||
sleep 1; # let it breathe
|
||||
next; # try again
|
||||
}
|
||||
else {
|
||||
$userid = $dbh->{'mysql_insertid'}; # smells like success
|
||||
$dbh->{PrintError} = $old_print_error; # restore error reporting
|
||||
|
||||
return 0 unless $userid; # but?
|
||||
|
||||
last; # finally
|
||||
}
|
||||
}
|
||||
|
||||
if ($LJ::LJR_FIF) {
|
||||
use LJ::MemCache;
|
||||
my $ljr_fif_id = LJ::get_userid($LJ::LJR_FIF);
|
||||
if ($ljr_fif_id) {
|
||||
$dbh->do("INSERT INTO friends (userid, friendid) VALUES (?, ?)", undef, $ljr_fif_id, $userid);
|
||||
# refresh memcache
|
||||
#my $memkey = [$ljr_fif_id, "friends:$ljr_fif_id"];
|
||||
#LJ::MemCache::delete($memkey);
|
||||
LJ::get_friends($ljr_fif_id, undef, undef, 'force', {} );
|
||||
}
|
||||
}
|
||||
|
||||
$dbh->do("REPLACE INTO useridmap (userid, user) VALUES (?, ?)", undef, $userid, $user);
|
||||
$dbh->do("REPLACE INTO userusage (userid, timecreate) VALUES (?, NOW())", undef, $userid);
|
||||
|
||||
# set any properties that get set in new users
|
||||
$u = LJ::load_userid($userid);
|
||||
while (my ($name, $val) = each %LJ::USERPROP_INIT) {
|
||||
LJ::set_userprop($u, $name, $val);
|
||||
}
|
||||
|
||||
# since they're a community, let's do more setup
|
||||
$dbh->do("REPLACE INTO community (userid, membership, postlevel) VALUES (?, ?, ?)",
|
||||
undef, $userid, $POST{membership}, $POST{postlevel});
|
||||
LJ::set_userprop($u, 'nonmember_posting', $POST{nonmember_posting} + 0);
|
||||
LJ::set_userprop($u, 'moderated', $POST{moderated} + 0);
|
||||
LJ::set_rel($userid, $remote->{userid}, 'M') if $POST{moderated}; # moderator if moderated
|
||||
LJ::set_rel($userid, $remote->{userid}, 'A'); # maintainer
|
||||
LJ::join_community($remote, $u, 0, 1); # make them a member of the community
|
||||
|
||||
LJ::run_hooks("post_create", {
|
||||
'userid' => $userid,
|
||||
'user' => $user,
|
||||
});
|
||||
}
|
||||
|
||||
my $nu = LJ::load_userid($userid, "force");
|
||||
|
||||
# log creation
|
||||
$nu->log_event('account_create', { remote => $remote });
|
||||
|
||||
# local sites may want to override what happens at this point
|
||||
my $ret;
|
||||
my $redirect;
|
||||
my $stop_output;
|
||||
LJ::run_hooks("create.bml_postsession", {
|
||||
post => \%POST,
|
||||
u => $nu,
|
||||
type => 'community',
|
||||
redirect => \$redirect,
|
||||
ret => \$ret,
|
||||
stop_output => \$stop_output,
|
||||
});
|
||||
return BML::redirect($redirect) if $redirect;
|
||||
return $ret if $stop_output;
|
||||
|
||||
$ret = "<?h1 $ML{'.success.head'} h1?><?p $ML{'.success.text1'} p?>";
|
||||
my $uri = LJ::journal_base($nu);
|
||||
$ret .= "<?p $ML{'.success.text2'} p?>\n";
|
||||
$ret .= "<?standout <font size='+1' face='arial'><b><a href='$uri'>$uri/</a></b></font> standout?>\n";
|
||||
$ret .= "<?p $ML{'.success.text3'} p?>\n";
|
||||
|
||||
$ret .= "<form method='get' action='$LJ::SITEROOT/editinfo.bml?authas=$nu->{user}'>";
|
||||
$ret .= "<p align='center'>" . LJ::html_submit(undef, "$ML{'.success.btn.enterinfo'} →") . "</p>";
|
||||
$ret .= "</form>\n";
|
||||
|
||||
return $ret;
|
||||
|
||||
}
|
||||
|
||||
if ($mode eq "getinfo" || $error)
|
||||
{
|
||||
my $ret;
|
||||
|
||||
if ($error) {
|
||||
$ret .= "<?errorbar <strong>$ML{'.errors.label'}</strong><ul>";
|
||||
$ret .= "<li>$error</li>";
|
||||
$ret .= "</ul> errorbar?>";
|
||||
}
|
||||
|
||||
$ret .= "<?p $ML{'.create.text'} p?>" unless $error;
|
||||
$ret .= "<form action=\"create.bml\" method=\"post\">\n";
|
||||
$ret .= LJ::html_hidden(mode => 'submit', ssl => $FORM{'ssl'});
|
||||
|
||||
$ret .= "<ol>";
|
||||
|
||||
# username
|
||||
my $v = LJ::ehtml($FORM{'user'});
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.username.head'}</div>";
|
||||
$ret .= "<p class='formitemFlag'>$error</p>";
|
||||
$ret .= "<div class='formitemDesc'>" . BML::ml(".username.text", { sitename => $LJ::SITENAME }) . "</div>";
|
||||
$ret .= LJ::html_text({'name' => 'user', 'size' => 15, 'maxlength' => 15, 'value' => $v, raw => 'style="<?commloginboxstyle?>"' });
|
||||
$ret .= "<br />" . BML::ml('.person', { aopts => "href='$LJ::SITEROOT/create.bml'" });
|
||||
$ret .= "<div class='formitemNote'>$ML{'.username.charsallowed'}</div>" unless $error;
|
||||
$ret .= "</div></li>";
|
||||
|
||||
# account title
|
||||
$v = LJ::ehtml($FORM{'title'});
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.name.head'}</div>";
|
||||
$ret .= "<div class='formitemDesc'>$ML{'.name.text'}</div>";
|
||||
$ret .= LJ::html_text({ name => 'title', style => 'width: 60%;', maxlength => 80, value => $v, });
|
||||
$ret .= "</div></li>";
|
||||
|
||||
# membership levels
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'/community/settings.bml.label.membership'}" .
|
||||
"</div><div class='formitemDesc'>$ML{'/community/settings.bml.label.whocanjoin'}</div><div><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'membership', id => 'memopen',
|
||||
value => 'open', selected => ($POST{membership} eq 'open' ? 1 : 0)});
|
||||
$ret .= "<label for='memopen' $ML{'/community/settings.bml.label.openmemb'}</label><br /></p><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'membership', id => 'memmoderated',
|
||||
value => 'moderated', selected => ($POST{membership} eq 'moderated' ? 1 : 0)});
|
||||
$ret .= "<label for='memmoderated' $ML{'/community/settings.bml.label.moderatedmemb'}</label></p><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'membership', id => 'memclosed',
|
||||
value => 'closed', selected => ($POST{membership} eq 'closed' ? 1 : 0)});
|
||||
$ret .= "<label for='memclosed' $ML{'/community/settings.bml.label.closedmemb2'}</label></p>";
|
||||
$ret .= "</div></div></li>";
|
||||
|
||||
# posting access options
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'/community/settings.bml.label.postaccess'}" .
|
||||
"</div><div class='formitemDesc'>$ML{'/community/settings.bml.label.whocanpost'}</div><div><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'postlevel', id => 'postopen',
|
||||
value => 'members', selected => ($POST{postlevel} eq 'members' ? 1 : 0)});
|
||||
$ret .= "<label for='postopen'>$ML{'/community/settings.bml.label.anybodycan'}</label></p><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'postlevel', id => 'postclosed',
|
||||
value => 'select', selected => ($POST{postlevel} eq 'select' ? 1 : 0)});
|
||||
$ret .= "<label for='postclosed'>$ML{'/community/settings.bml.label.selcan'}</label></p>";
|
||||
$ret .= "</div></div></li>";
|
||||
|
||||
# nonmember posting options
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'/community/settings.bml.label.nmheader'}" .
|
||||
"</div><div class='formitemDesc'>$ML{'/community/settings.bml.label.nmtext'}</div><div><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'nonmember_posting', id => 'nonopen',
|
||||
value => '0', selected => ($POST{nonmember_posting} eq '0' ? 1 : 0)});
|
||||
$ret .= "<label for='nonopen'>$ML{'/community/settings.bml.label.nmcant'}</label></p><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'nonmember_posting', id => 'nonclosed',
|
||||
value => '1', selected => ($POST{nonmember_posting} eq '1' ? 1 : 0)});
|
||||
$ret .= "<label for='nonclosed'>$ML{'/community/settings.bml.label.nmcan'}</label></p>";
|
||||
$ret .= "</div></div></li>";
|
||||
|
||||
# moderated options
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'/community/settings.bml.label.modheader'}" .
|
||||
"</div><div class='formitemDesc'>$ML{'/community/settings.bml.label.modtext'}</div><div><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'moderated', id => 'radunmod',
|
||||
value => '0', selected => ($POST{moderated} eq '0' ? 1 : 0)});
|
||||
$ret .= "<label for='radunmod'>$ML{'/community/settings.bml.label.modisnt'}</label></p><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'moderated', id => 'radmod',
|
||||
value => '1', selected => ($POST{moderated} eq '1' ? 1 : 0)});
|
||||
$ret .= "<label for='radmod'>$ML{'/community/settings.bml.label.modis'}</label></p>";
|
||||
$ret .= "</div></div></li>";
|
||||
|
||||
LJ::run_hooks("create.bml_opts", {
|
||||
post => \%POST,
|
||||
get => \%GET,
|
||||
ret => \$ret,
|
||||
});
|
||||
|
||||
$ret .= "</ol>";
|
||||
|
||||
$ret .= "<div style='width:600; text-align: center'>";
|
||||
$ret .= "<input type='submit' value=\"$ML{'.btn.create'}\">";
|
||||
$ret .= "</div>";
|
||||
$ret .= "</form>";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
return "$ML{'error.unknownmode'}: <b>$mode</b>";
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
148
local/htdocs/community/join.bml
Executable file
148
local/htdocs/community/join.bml
Executable file
@@ -0,0 +1,148 @@
|
||||
<?_code
|
||||
|
||||
LJ::set_active_crumb('joincomm');
|
||||
|
||||
$title = $ML{'.title'};
|
||||
$body = "";
|
||||
|
||||
# is there a user out there?
|
||||
my $remote = LJ::get_remote();
|
||||
unless ($remote) {
|
||||
$body = "<?h1 $ML{'Sorry'}.. h1?><?p $ML{'.label.loginfirst'} p?>";
|
||||
return;
|
||||
}
|
||||
|
||||
# bad statusvis?
|
||||
unless ($remote->{statusvis} eq 'V') {
|
||||
$body = "<?h1 $ML{'.error.statusvis.title'} h1?><?p $ML{'.error.statusvis.body'} p?>";
|
||||
return;
|
||||
}
|
||||
|
||||
# get info about the community
|
||||
my $cuserid = $FORM{'cuserid'}+0;
|
||||
my $cu = $FORM{comm} ?
|
||||
LJ::load_user($FORM{comm}) : # they gave us the comm name
|
||||
LJ::load_userid($cuserid); # they gave us the comm id
|
||||
|
||||
# NOTE: we wrapped this in an eval due to code going live; the library isn't going to go
|
||||
# live at the same time as the BML file, and we don't want weird things happening, so we
|
||||
# verify that this is all good and return an error if it's not okay.
|
||||
my $ci;
|
||||
eval { $ci = LJ::get_community_row($cu); };
|
||||
if ($@) {
|
||||
$body = "<?h1 Temporarily Disabled h1?><?p This page is disabled while we update the site. Please try again later. p?>";
|
||||
return;
|
||||
}
|
||||
$cuserid = $ci->{'userid'};
|
||||
|
||||
LJ::text_out(\$ci->{'name'});
|
||||
my $ecname = LJ::ehtml($ci->{'name'});
|
||||
|
||||
# does this community even exit?
|
||||
unless ($cu) {
|
||||
$body .= "<?h1 $ML{'Error'} h1?><?p $ML{'.label.errorcomminfo'} p?>";
|
||||
return;
|
||||
}
|
||||
|
||||
# make sure a community doesn't join a community (that's confusing
|
||||
# or something)
|
||||
unless ($remote->{'journaltype'} eq "P") {
|
||||
$body .= "<?h1 $ML{'Error'} h1?><?p $ML{'.label.commlogged'} p?>";
|
||||
return;
|
||||
}
|
||||
|
||||
# ensure this user isn't banned
|
||||
if (LJ::is_banned($remote, $cuserid)) {
|
||||
$body .= "<?h1 $ML{'Sorry'} h1?><?p $ML{'.label.banned'} p?>";
|
||||
return;
|
||||
}
|
||||
|
||||
# # and make sure they're not already a member
|
||||
# if (LJ::is_friend($cuserid, $remote->{userid})) {
|
||||
# $body .= "<?h1 $ML{'Error'} h1?><?p $ML{'.error.already.member'} p?>";
|
||||
# return;
|
||||
# }
|
||||
|
||||
# get the list of maintainers and their usernames
|
||||
my $dbr = LJ::get_db_reader();
|
||||
my $admins = $dbr->selectcol_arrayref("SELECT u.user FROM useridmap u, reluser r ".
|
||||
"WHERE r.userid=$cuserid AND r.targetid=u.userid AND r.type='A'") || [];
|
||||
my $list = "<ul>";
|
||||
foreach (sort @$admins) { $list .= "<li><?ljuser $_ ljuser?></li>"};
|
||||
$list .= "</ul>";
|
||||
|
||||
# can't join closed communities
|
||||
# but if invited, go around and finally join
|
||||
|
||||
my $invited=0;
|
||||
|
||||
if ($ci->{membership} eq 'closed') {
|
||||
|
||||
my $inv = LJ::get_sent_invites($cuserid) || [];
|
||||
|
||||
foreach my $invite (@$inv) {
|
||||
my $id = $invite->{userid};
|
||||
if (($invited!=1) && ($id == $remote->{'userid'})) {$invited=1;}
|
||||
}
|
||||
|
||||
if($invited == 0){
|
||||
$body .= "<?h1 $ML{'Sorry'} h1?><?p " .
|
||||
BML::ml('.error.closed', { admins => $list }) .
|
||||
" p?>";
|
||||
return;
|
||||
}
|
||||
}
|
||||
# now do the join
|
||||
if ($POST{confirm}) {
|
||||
# can members join this community openly?
|
||||
# another case if user is already invited - then we will not make a request
|
||||
if (($ci->{membership} ne 'open') && ($invited == 0)) {
|
||||
# hit up the maintainers to let them know a join was requested
|
||||
LJ::comm_join_request($cu, $remote);
|
||||
$body .= "<?h1 $ML{'.reqsubmitted.title'} h1?><?p $ML{'.reqsubmitted.body'} $list p?>";
|
||||
return;
|
||||
}
|
||||
|
||||
# make remote user a friend of the community
|
||||
LJ::join_community($remote, $cu, $FORM{addfriend});
|
||||
|
||||
# success message
|
||||
$body .= "<?h1 $ML{'.success'} h1?><?p " . BML::ml('.label.membernow',
|
||||
{ username => $ci->{user}, commname => $ecname}) . " p?>";
|
||||
|
||||
# if community permits it, tell the user they have access
|
||||
if ($ci->{postlevel} eq "members") {
|
||||
$body .= "<?p $ML{'.label.allowposting'} p?>";
|
||||
} else {
|
||||
$body .= "<?p " . BML::ml('.label.auth', { admins => $list }) . " p?>";
|
||||
}
|
||||
} else {
|
||||
if (($ci->{membership} ne 'open') && ($invited == 0)) {
|
||||
$body .= "<?h1 $ML{'.request.title'} h1?><?p ";
|
||||
$body .= BML::ml('.request.body', { comm => LJ::ljuser($cu) }) . "<br /> p?>";
|
||||
$body .= "<div style='margin-left: 30px;'><form method='post' action='join.bml'>";
|
||||
$body .= "<input type='hidden' name='cuserid' value='$ci->{userid}' />";
|
||||
$body .= "<input type='hidden' name='confirm' value='1' />";
|
||||
$body .= "<input type='submit' value=\"$ML{'.button.join'}\" /></form></div>";
|
||||
return;
|
||||
}
|
||||
|
||||
$body .= "<?h1 $ML{'.label.sure'} h1?><?p " . BML::ml('.label.expls', { maintainer => $ecname });
|
||||
$body .= "<form method='post' action='join.bml'>";
|
||||
$body .= "<input type='hidden' name='cuserid' value='$ci->{'userid'}' />";
|
||||
$body .= "<input type='hidden' name='confirm' value='1' /><center>";
|
||||
$body .= "<input type='checkbox' name='addfriend' checked>";
|
||||
$body .= BML::ml('.label.addtofriends', { maintainer => $ecname });
|
||||
$body .= "<br><input type='submit' value=\"$ML{'.button.join'}\" /></center></form> p?>";
|
||||
}
|
||||
|
||||
return;
|
||||
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?><?_c <LJDEP>
|
||||
link: htdocs/login.bml, htdocs/userinfo.bml
|
||||
post: htdocs/community/join.bml
|
||||
</LJDEP> _c?>
|
||||
|
||||
135
local/htdocs/community/pending.bml
Executable file
135
local/htdocs/community/pending.bml
Executable file
@@ -0,0 +1,135 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
|
||||
LJ::set_active_crumb('commpending');
|
||||
|
||||
return LJ::server_down_html() if $LJ::SERVER_DOWN;
|
||||
|
||||
# always have links at top
|
||||
my $ret = BML::ml('Backlink', {
|
||||
'link' => '/community/manage.bml',
|
||||
'text' => $ML{'/community/members.bml.manage2'},
|
||||
});
|
||||
|
||||
# get remote
|
||||
my $remote = LJ::get_remote();
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'error.noremote'} p?>"
|
||||
unless $remote;
|
||||
|
||||
my $cname = $GET{'comm'};
|
||||
return BML::redirect("$LJ::SITEROOT/community/manage.bml") unless $cname;
|
||||
|
||||
# get $c object
|
||||
my $c = LJ::load_user($cname);
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'/community/members.bml.error.nocomm'} p?>"
|
||||
unless $c;
|
||||
my $cid = $c->{'userid'};
|
||||
|
||||
# is $remote an admin?
|
||||
unless (LJ::can_manage($remote, $c)) {
|
||||
$ret .= "<?h1 $ML{'Error'} h1?><?p ";
|
||||
$ret .= BML::ml('/community/members.bml.error.noaccess',
|
||||
{ comm => LJ::ljuser($cname, { type => 'C' }) });
|
||||
$ret .= " p?>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
# hit up the database to find pending members
|
||||
my $pendids = LJ::get_pending_members($c) || [];
|
||||
my $us = LJ::load_userids(@$pendids);
|
||||
|
||||
# nothing pending?
|
||||
return "<?h1 $ML{'.nopending.title'} h1?><?p $ML{'.nopending.body'} p?>"
|
||||
unless @$pendids || LJ::did_post();
|
||||
|
||||
# saving a form submission
|
||||
if ($POST{'action:update'}) {
|
||||
my @userids = split(',', $POST{'ids'});
|
||||
|
||||
# need a db handle now
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
# hit up each user to find out what to do with them
|
||||
my ($added, $rejected, $ignored, $previous);
|
||||
foreach my $id (@userids) {
|
||||
unless ($us->{$id}) {
|
||||
$previous++;
|
||||
next;
|
||||
}
|
||||
if ($POST{"pending_$id"} eq 'yes') {
|
||||
LJ::approve_pending_member($cid, $id);
|
||||
$added++;
|
||||
} elsif ($POST{"pending_$id"} eq 'no') {
|
||||
LJ::reject_pending_member($cid, $id);
|
||||
$rejected++;
|
||||
} else {
|
||||
$ignored++;
|
||||
}
|
||||
}
|
||||
|
||||
$ret .= "<?h1 $ML{'/community/members.bml.success.header'} h1?><?p $ML{'/community/members.bml.success.message2'} p?>";
|
||||
$ret .= "<?p " . BML::ml('.success.added', { num => $added }) . " p?>" if $added;
|
||||
$ret .= "<?p " . BML::ml('.success.rejected', { num => $rejected }) . " p?>" if $rejected;
|
||||
$ret .= "<?p " . BML::ml('.success.ignored', { num => $ignored }) . " p?>" if $ignored;
|
||||
$ret .= "<?p " . BML::ml('.success.previous', { num => $previous }) . " p?>" if $previous;
|
||||
$ret .= "<?p " . BML::ml("/community/members.bml.success.return", { 'link' => BML::get_uri() . "?comm=$cname" }) . " p?>";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
my @users = sort { $a->{user} cmp $b->{user} } values %$us;
|
||||
my $page_size = 100; # change to adjust page size
|
||||
|
||||
# how to make links back to this page
|
||||
my $self_link = sub {
|
||||
return "pending.bml?comm=$cname&page=$_[0]";
|
||||
};
|
||||
|
||||
my %items = BML::paging(\@users, $GET{page}, $page_size);
|
||||
my $navbar = LJ::paging_bar($items{page}, $items{pages},
|
||||
{ self_link => $self_link });
|
||||
@users = @{$items{items}};
|
||||
|
||||
# output starts here
|
||||
$ret .= "<?p " . BML::ml('/community/members.bml.name', { name => LJ::ljuser($cname, { type => 'C' }) });
|
||||
$ret .= " " . BML::ml('/community/members.bml.settings', { 'link' => "settings.bml?comm=$cname"}) . " p?>";
|
||||
|
||||
$ret .= "<form method='post' action='pending.bml?comm=$cname'>";
|
||||
|
||||
# table headers
|
||||
$ret .= "<br /><div align='center'><table class='borderedtable' cellspacing='0' cellpadding='2'>\n<tr>" .
|
||||
"<th>$ML{'/community/members.bml.key.user'}</th><th colspan='2'>$ML{'.approve.title'}</th></tr>\n";
|
||||
|
||||
# rows for existing users
|
||||
my $rc = 0;
|
||||
foreach (@users) {
|
||||
my $rstyle = ($rc++ & 1) ? '<?altcolor1?>' : '<?altcolor2?>';
|
||||
$ret .= "<tr style='background-color: $rstyle;'><td>" . LJ::ljuser($_->{user}) . "</td>";
|
||||
$ret .= "<td>" . LJ::html_check({ type => 'radio', name => "pending_$_->{userid}",
|
||||
id => "pending_$_->{userid}_yes", value => 'yes' });
|
||||
$ret .= " <label for='pending_$_->{userid}_yes'>$ML{'.yes'}</label></td>\n";
|
||||
$ret .= "<td>" . LJ::html_check({ type => 'radio', name => "pending_$_->{userid}",
|
||||
id => "pending_$_->{userid}_no", value => 'no' });
|
||||
$ret .= " <label for='pending_$_->{userid}_no'>$ML{'.no'}</label></td>\n";
|
||||
$ret .= "</tr>\n";
|
||||
}
|
||||
|
||||
# some hidden values
|
||||
$ret .= LJ::html_hidden('ids', join(',', map { $_->{userid}} @users)) . "\n";
|
||||
$ret .= "</table><p>" . LJ::html_submit('action:update', $ML{'/community/members.bml.update'}) . "</p>\n";
|
||||
$ret .= "</div></form>\n\n";
|
||||
|
||||
$ret .= $navbar;
|
||||
|
||||
return $ret;
|
||||
|
||||
}
|
||||
_code?>
|
||||
|
||||
<=body
|
||||
page?>
|
||||
252
local/htdocs/community/settings.bml
Executable file
252
local/htdocs/community/settings.bml
Executable file
@@ -0,0 +1,252 @@
|
||||
<?page
|
||||
title<=
|
||||
<?_code
|
||||
if ($GET{'mode'} eq 'create') {
|
||||
return $ML{'.title.create'};
|
||||
}
|
||||
else {
|
||||
return $ML{'.title.modify'};
|
||||
}
|
||||
_code?>
|
||||
<=title
|
||||
head<=
|
||||
<style type='text/css'>
|
||||
div.opts { margin: 10px 0 10px 30px; }
|
||||
</style>
|
||||
<=head
|
||||
body<=
|
||||
<?_code
|
||||
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
|
||||
# always have links at top
|
||||
my $ret = BML::ml('Backlink', {
|
||||
'link' => '/community/manage.bml',
|
||||
'text' => $ML{'/community/members.bml.manage2'},
|
||||
});
|
||||
my %errors;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
unless ($remote) {
|
||||
$ret .= "<?h1 $ML{'Error'} h1?><?p $ML{'error.noremote'} p?>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
unless ($remote->{'journaltype'} eq 'P') {
|
||||
$ret .= "<?h1 $ML{'Error'} h1?><?p $ML{'.error.maintainertype'} p?>";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
my $mode = "modify";
|
||||
$mode = "create" if $GET{'mode'} eq 'create';
|
||||
|
||||
if (LJ::did_post())
|
||||
{
|
||||
my $sth;
|
||||
my $cuser = LJ::canonical_username($POST{'cuser'});
|
||||
my $cu = LJ::load_user($cuser);
|
||||
|
||||
unless ($cu) {
|
||||
$errors{'username'} = $ML{'.error.notfound'};
|
||||
}
|
||||
|
||||
if ($cu && $cu->{'userid'} == $remote->{'userid'}) {
|
||||
$errors{'username'} = $ML{'.error.samenames'};
|
||||
}
|
||||
|
||||
# if we're changing rather than creating, check that we can
|
||||
if ($mode eq 'modify' && !LJ::can_manage_other($remote, $cu)) {
|
||||
$errors{'username'} = BML::ml('.error.noaccess', {'comm'=>$cuser});
|
||||
}
|
||||
|
||||
# if we're creating, community password must match
|
||||
if ($mode eq 'create' && $cu && !LJ::auth_okay($cu, $POST{'cpassword'})) {
|
||||
$errors{'password'} = $ML{'.error.badpassword'};
|
||||
}
|
||||
|
||||
# disallow changing the journal type if the journal has entries
|
||||
if ($mode eq 'create' && !%errors && !LJ::check_priv($remote, "changejournaltype", "")) {
|
||||
my $count;
|
||||
my $userid=$cu->{'userid'}+0;
|
||||
|
||||
my $dbcr = LJ::get_cluster_reader($cu);
|
||||
$count = $dbcr->selectrow_array("SELECT COUNT(*) FROM log2 WHERE journalid=$userid AND posterid=journalid");
|
||||
|
||||
$errors{'username'} = $ML{'.error.hasentries'} if $count;
|
||||
}
|
||||
|
||||
# if it's already a community, don't let them turn it into a community
|
||||
if ($mode eq 'create' && !%errors && $cu->{journaltype} eq 'C') {
|
||||
$errors{'username'} = $ML{'.error.alreadycomm'};
|
||||
}
|
||||
|
||||
# if we found errors, we'll redisplay the form below. otherwise,
|
||||
# proceed.
|
||||
unless (%errors) {
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $cid = $cu->{'userid'};
|
||||
my $qmembership = $POST{membership};
|
||||
$qmembership = 'closed' unless $qmembership =~ m/(?:open|moderated|closed)/;
|
||||
$qmembership = $dbh->quote($qmembership);
|
||||
my $qpostlevel = $dbh->quote($POST{'postlevel'} eq "members" ? "members" : "select");
|
||||
|
||||
LJ::update_user($cu, { journaltype => 'C' });
|
||||
if ($mode eq 'create') {
|
||||
$dbh->do("REPLACE INTO community (userid, membership, postlevel) VALUES ($cid, $qmembership, $qpostlevel)");
|
||||
LJ::set_rel($cu, $remote, 'A');
|
||||
|
||||
# delete existing friends
|
||||
my $friends = LJ::get_friends($cid, undef, undef, 'force') || {};
|
||||
LJ::remove_friend($cid, [ keys %$friends ]);
|
||||
|
||||
} else {
|
||||
$dbh->do("UPDATE community SET membership=$qmembership, postlevel=$qpostlevel WHERE userid=$cid");
|
||||
}
|
||||
|
||||
my $nonmembers = $POST{'nonmember_posting'} + 0;
|
||||
my $moderated = $POST{'moderated'} + 0;
|
||||
|
||||
LJ::set_userprop($cu, 'nonmember_posting', $nonmembers);
|
||||
LJ::set_userprop($cu, 'moderated', $moderated);
|
||||
|
||||
if ($moderated && ! LJ::load_rel_user($cu->{'userid'}, 'M')->[0]) {
|
||||
LJ::set_rel($cu->{'userid'}, $remote->{'userid'}, 'M');
|
||||
}
|
||||
|
||||
$ret .= "<?h1 $ML{'.success'} h1?>";
|
||||
if ($mode eq 'create') {
|
||||
$ret .= "<?p $ML{'.label.commcreated'} p?>";
|
||||
} else {
|
||||
$ret .= "<?p $ML{'.label.commchanged'} p?>";
|
||||
}
|
||||
|
||||
$ret .= "<?p $ML{'.label.rellinks'} <ul><li><a href='$LJ::SITEROOT/community/$cu->{'user'}/'>$ML{'.label.commsite'}</a></li>";
|
||||
$ret .= "<li><a href='/userinfo.bml?user=$cu->{'user'}'>$ML{'.label.comminfo'}</a></li><li>"
|
||||
. BML::ml('.label.managepage', { 'aopts' => 'href="/community/manage.bml"' }) . "</li></ul> p?>";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
}
|
||||
|
||||
# we're either creating a new community or modifying settings of an existing one
|
||||
# based on whether $mode is 'create' or 'modify'. Most of the page is the same in
|
||||
# either case, and additionally we must preload existing settings when modifying.
|
||||
|
||||
my ($cname, $c);
|
||||
|
||||
$cname = $POST{'cuser'}; # if we're falling through with errors when creating
|
||||
|
||||
my %info = (
|
||||
'membership'=>$POST{'membership'} || 'open',
|
||||
'postlevel'=>$POST{'postlevel'} || 'members',
|
||||
'nonmember_posting'=>$POST{'nonmember_posting'} || 0,
|
||||
'moderated'=>$POST{'moderated'} || 0,
|
||||
);
|
||||
|
||||
if ($mode eq 'modify') {
|
||||
$cname = LJ::canonical_username($GET{'comm'});
|
||||
$c = LJ::load_user($cname);
|
||||
unless ($c) {
|
||||
# if no community was specified, redirect to manage.bml
|
||||
return BML::redirect("$LJ::SITEROOT/community/manage.bml");
|
||||
}
|
||||
unless ($c->{'journaltype'} eq 'C') {
|
||||
$ret = "<?h1 $ML{'Error'} h1?><?p $ML{'.error.notcomm'} p?>";
|
||||
return $ret;
|
||||
}
|
||||
my $dbr = LJ::get_db_reader();
|
||||
($info{'membership'},$info{'postlevel'}) =
|
||||
$dbr->selectrow_array("SELECT membership, postlevel FROM community WHERE userid=$c->{'userid'}");
|
||||
LJ::load_user_props($c, "nonmember_posting", "moderated");
|
||||
$info{'nonmember_posting'} = $c->{'nonmember_posting'} ? 1 : 0;
|
||||
$info{'moderated'} = $c->{'moderated'} ? 1 : 0;
|
||||
}
|
||||
|
||||
$ret .= "<form method='post' action='settings.bml?mode=$mode'>";
|
||||
|
||||
if ($mode eq 'modify') {
|
||||
$ret .= "<?h1 $ML{'.label.changeheader'} h1?><?p $ML{'.label.changetext'} p?>";
|
||||
} else {
|
||||
$ret .= "<?h1 $ML{'.label.createheader'} h1?><?p $ML{'.label.createtext'} p?>";
|
||||
}
|
||||
|
||||
if ($mode eq 'create') {
|
||||
LJ::set_active_crumb('createcommunity');
|
||||
$ret .= "<?h2 $ML{'.label.commheader'} h2?>" .
|
||||
($mode eq 'modify' ? "<?p $ML{'.label.commchanged'} p?>" : "<?p $ML{'.label.commcreate'} p?>");
|
||||
$ret .= "<?standout <table width='350' cellpadding='7'><tr valign='top'><td><b>$ML{'.label.maintainer'}</b></td>";
|
||||
$ret .= "<td><?ljuser $remote->{'user'} ljuser?><br />$ML{'.label.maintainer.login'}</td></tr>";
|
||||
$ret .= "<tr valign='top'><td><b>$ML{'.label.community'}</b></td>";
|
||||
$ret .= "<td>$ML{'.label.username'}<br /><input name='cuser' maxlength='15' value='$cname' /><br />";
|
||||
$ret .= "<?inerr $errors{'username'} inerr?><br />";
|
||||
$ret .= "$ML{'.label.password'}<br /><input name='cpassword' type='password' /><br />";
|
||||
$ret .= "<?inerr $errors{'password'} inerr?></td></tr></table> standout?>";
|
||||
} else {
|
||||
LJ::set_active_crumb('commsettings');
|
||||
$ret .= LJ::html_hidden('cuser', $cname);
|
||||
$ret .= "<?p " . BML::ml('.name',{'name'=>"<?ljcomm $cname ljcomm?>"});
|
||||
$ret .= " " . BML::ml('.members',{'link'=>"/community/members.bml?comm=$cname"}) . " p?>";
|
||||
}
|
||||
|
||||
$ret .= "<?h1 $ML{'.label.commopts'} h1?><?p $ML{'.label.howoperates'} p?>";
|
||||
$ret .= "<?h2 $ML{'.label.membership'} h2?><?p $ML{'.label.whocanjoin'} p?><div class='opts'>";
|
||||
|
||||
# membership levels
|
||||
$ret .= "<p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'membership', id => 'memopen',
|
||||
value => 'open', selected => ($info{membership} eq 'open' ? 1 : 0)});
|
||||
$ret .= "<label for='memopen' $ML{'.label.openmemb'}</label></p><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'membership', id => 'memmoderated',
|
||||
value => 'moderated', selected => ($info{membership} eq 'moderated' ? 1 : 0)});
|
||||
$ret .= "<label for='memmoderated' $ML{'.label.moderatedmemb'}</label></p><p>";
|
||||
$ret .= LJ::html_check({ type => 'radio', name => 'membership', id => 'memclosed',
|
||||
value => 'closed', selected => ($info{membership} eq 'closed' ? 1 : 0)});
|
||||
$ret .= "<label for='memclosed' $ML{'.label.closedmemb2'}</label></p>";
|
||||
$ret .= "</div>";
|
||||
|
||||
my ($optopen,$optclosed);
|
||||
if ($info{'postlevel'} eq 'members') {
|
||||
($optopen,$optclosed)=(" checked='checked'","");
|
||||
} else {
|
||||
($optopen,$optclosed)=("", " checked='checked'");
|
||||
}
|
||||
|
||||
$ret .= "<?h2 $ML{'.label.postaccess'} h2?><?p $ML{'.label.whocanpost'} p?><div class='opts'>";
|
||||
$ret .= "<input type='radio' id='postopen' name='postlevel' value='members'$optopen /><label for='postopen'> $ML{'.label.anybodycan'}</label>";
|
||||
$ret .= "<p><input type='radio' id='postclosed' name='postlevel' value='select'$optclosed /><label for='postclosed'> $ML{'.label.selcan'}</label>";
|
||||
$ret .= "</div>";
|
||||
|
||||
if ($info{'nonmember_posting'}) {
|
||||
($optopen,$optclosed)=(" checked='checked'","");
|
||||
} else {
|
||||
($optopen,$optclosed)=("", " checked='checked'");
|
||||
}
|
||||
|
||||
$ret .= "<?h2 $ML{'.label.nmheader'} h2?><?p $ML{'.label.nmtext'} p?><div class='opts'>";
|
||||
$ret .= "<input type='radio' id='nonopen' name='nonmember_posting' value='0'$optclosed /><label for='nonopen'> $ML{'.label.nmcant'}</label>";
|
||||
$ret .= "<p><input type='radio' id='nonclosed' name='nonmember_posting' value='1'$optopen /><label for='nonclosed'> $ML{'.label.nmcan'}</label>";
|
||||
$ret .= "</div>";
|
||||
|
||||
if ($info{'moderated'}) {
|
||||
($optopen,$optclosed)=(" checked='checked'","");
|
||||
} else {
|
||||
($optopen,$optclosed)=("", " checked='checked'");
|
||||
}
|
||||
|
||||
$ret .= "<?h2 $ML{'.label.modheader'} h2?><?p $ML{'.label.modtext'} p?><div class='opts'>";
|
||||
$ret .= "<input type='radio' id='radunmod' name='moderated' value='0'$optclosed /><label for='radunmod'> $ML{'.label.modisnt'}</label>";
|
||||
$ret .= "<p><input type='radio' id='radmod' name='moderated' value='1'$optopen /><label for='radmod'> $ML{'.label.modis'}</label>";
|
||||
$ret .= "</div>\n";
|
||||
|
||||
$ret .= "<center><input type='submit' value='" .
|
||||
($mode eq 'create' ? "$ML{'.button.createcommunity'}" : "$ML{'.button.changecommunity'}") .
|
||||
"' /></center></form>";
|
||||
|
||||
return $ret;
|
||||
|
||||
_code?>
|
||||
|
||||
<=body
|
||||
page?>
|
||||
639
local/htdocs/create.bml
Executable file
639
local/htdocs/create.bml
Executable file
@@ -0,0 +1,639 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
head<=
|
||||
<style type="text/css">
|
||||
|
||||
|
||||
.tablecontent {
|
||||
border-top: 1px solid #dfdfdf;
|
||||
border-bottom: 1px solid #dfdfdf;
|
||||
padding-top: 5px;
|
||||
padding-bottom: 5px;
|
||||
text-align: center;
|
||||
width: 8%;
|
||||
}
|
||||
|
||||
.tablelabel {
|
||||
border-top: 1px solid #dfdfdf;
|
||||
border-bottom: 1px solid #dfdfdf;
|
||||
padding-top: 5px;
|
||||
padding-bottom: 5px;
|
||||
width: 20%;
|
||||
font-size: .9em;
|
||||
}
|
||||
|
||||
.tablehead {
|
||||
border-bottom: 1px solid #dfdfdf;
|
||||
padding-top: 5px;
|
||||
padding-bottom: 5px;
|
||||
font-weight: bold;
|
||||
white-space: nowrap;
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
.tablebottom {
|
||||
border-top: 1px solid #dfdfdf;
|
||||
padding-top: 5px;
|
||||
white-space: nowrap;
|
||||
}
|
||||
</style>
|
||||
<=head
|
||||
body<=
|
||||
<?_code
|
||||
|
||||
use Captcha::reCAPTCHA;
|
||||
|
||||
|
||||
my $crumb = $LJ::IS_SSL ? 'securecreatejournal' : 'createjournal';
|
||||
LJ::set_active_crumb($crumb);
|
||||
|
||||
return LJ::server_down_html() if ($LJ::SERVER_DOWN);
|
||||
|
||||
return "<?badinput?>" unless LJ::text_in(\%POST);
|
||||
|
||||
my $mode = $POST{'mode'};
|
||||
my $code = $POST{'code'} || $GET{'code'};
|
||||
|
||||
if ($LJ::USE_SSL && ! $LJ::IS_SSL && $FORM{'ssl'} ne "no") {
|
||||
return BML::redirect("$LJ::SSLROOT/create.bml");
|
||||
}
|
||||
|
||||
# with no mode, decide which screen the user sees first, based
|
||||
# on whether or not this LJ installation lets in free users
|
||||
if ($mode eq "") {
|
||||
$mode = $LJ::USE_ACCT_CODES ?
|
||||
($code ? "codesubmit" : "entercode")
|
||||
: "getinfo";
|
||||
}
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
my %errors;
|
||||
my $error_msg = sub {
|
||||
my $key = shift;
|
||||
my $pre = shift;
|
||||
my $post = shift;
|
||||
my $msg = $errors{$key};
|
||||
return unless $msg;
|
||||
return "$pre $msg $post";
|
||||
};
|
||||
|
||||
# Flag to indicate they've submitted with 'audio' as the answer to the spambot
|
||||
# challenge.
|
||||
my $wants_audio = 0;
|
||||
|
||||
# Captcha
|
||||
my $recaptcha = Captcha::reCAPTCHA->new;
|
||||
|
||||
# validate a code they've entered and throw them back to entercode
|
||||
# mode if it's invalid
|
||||
if ($code && $mode eq "submit" || # account codes turned off, but one specified anyway
|
||||
$LJ::USE_ACCT_CODES && ($mode eq "codesubmit" || $mode eq "submit")) # account codes required
|
||||
{
|
||||
my $error;
|
||||
my $userid = 0; # acceptable userid for double-click protection
|
||||
if ($mode eq "submit") {
|
||||
my $u = LJ::load_user($POST{'user'});
|
||||
$userid = $u->{'userid'};
|
||||
}
|
||||
$errors{'code'} = $error
|
||||
unless (LJ::acct_code_check($code, \$error, $userid));
|
||||
if (%errors) {
|
||||
$mode = "entercode";
|
||||
} elsif ($mode eq "codesubmit") {
|
||||
$mode = "getinfo";
|
||||
}
|
||||
}
|
||||
|
||||
# MODE: entercode - enter an account code to proceed making an account
|
||||
if ($LJ::USE_ACCT_CODES && $mode eq "entercode")
|
||||
{
|
||||
my $ret;
|
||||
my $v;
|
||||
|
||||
$ret .= "<form method=\"post\" action=\"create.bml\">\n";
|
||||
$ret .= LJ::html_hidden(mode => 'codesubmit',
|
||||
ssl => $FORM{'ssl'});
|
||||
|
||||
$ret .= "<?h1 $ML{'.useacctcodes.welcome'} h1?><?p $ML{'.useacctcodes.entercode'} p?>";
|
||||
|
||||
$v = LJ::ehtml($code);
|
||||
$ret .= "<?standout Code: <input type=\"text\" name=\"code\" value=\"$v\" size=\"13\" maxlength=\"12\"> <input type=\"submit\" value=\"$ML{'.btn.proceed'}\">";
|
||||
$ret .= $error_msg->('code', '<br>');
|
||||
$ret .= " standout?>";
|
||||
$ret .= "</form>\n";
|
||||
|
||||
open (REM, "$LJ::HOME/htdocs/inc/account-codes");
|
||||
while (<REM>) {
|
||||
$ret .= $_;
|
||||
}
|
||||
close REM;
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
# MODE: submit - if they've given 'audio' as the answer to the spambot-blocker,
|
||||
# reset the mode to 'getinfo' and set the audio flag
|
||||
if ( $LJ::HUMAN_CHECK{create} && $mode eq 'submit' && lc($POST{answer}) eq 'audio' )
|
||||
{
|
||||
$mode = 'getinfo';
|
||||
$wants_audio = 1;
|
||||
}
|
||||
|
||||
# MODE: submit - try to create an account. might change mode
|
||||
# if there are errors, we'll populate %errors and
|
||||
# return to "getinfo" mode below
|
||||
SUBMIT:
|
||||
while ($mode eq "submit") # using while instead of if so we can 'last' out of it
|
||||
{
|
||||
return "<b>$ML{'Error'}</b>: $ML{'.error.postrequired'}" unless LJ::did_post();
|
||||
|
||||
my $user = LJ::canonical_username($POST{'user'});
|
||||
my $email = LJ::trim(lc($POST{'email'}));
|
||||
|
||||
# setup global things that can be used to modify the user later
|
||||
my $is_underage = 0; # turn on if the user should be marked as underage
|
||||
my $ofage = 0; # turn on to note that the user is over 13 in actuality
|
||||
# (but is_underage might be on which just means that their
|
||||
# account is being marked as underage--even if they're old
|
||||
# enough [unique cookie check])
|
||||
|
||||
# reject this email?
|
||||
return LJ::sysban_block(0, "Create user blocked based on email",
|
||||
{ 'new_user' => $user, 'email' => $email, 'name' => $user })
|
||||
if LJ::sysban_check('email', $email);
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
if (length($user) > 15) {
|
||||
$errors{'username'} = "$ML{'error.usernamelong'}";
|
||||
}
|
||||
if ($POST{'user'} && ! $user) {
|
||||
$errors{'username'} = "$ML{'error.usernameinvalid'}";
|
||||
}
|
||||
unless ($POST{'user'}) {
|
||||
$errors{'username'} = "$ML{'.error.username.mustenter'}";
|
||||
}
|
||||
foreach my $re ("^system\$", @LJ::PROTECTED_USERNAMES) {
|
||||
next unless ($user =~ /$re/);
|
||||
|
||||
# you can give people sharedjournal priv ahead of time to create
|
||||
# reserved communities:
|
||||
next if LJ::check_priv($remote, "sharedjournal", $user);
|
||||
|
||||
$errors{'username'} = "$ML{'.error.username.reserved'}";
|
||||
}
|
||||
|
||||
# see if they're confused and entered a valid account code
|
||||
# for their username (happens often)
|
||||
if ($LJ::USE_ACCT_CODES && $user =~ /^.....a[ab].....$/) {
|
||||
# see if the acctcode is valid and unused
|
||||
my ($acid, $auth) = LJ::acct_code_decode($user);
|
||||
my $is_valid = $dbh->selectrow_array("SELECT COUNT(*) FROM acctcode ".
|
||||
"WHERE acid=? AND rcptid=0",
|
||||
undef, $acid);
|
||||
$errors{'username'} = "$ML{'.error.username.iscode'}"
|
||||
if $is_valid;
|
||||
}
|
||||
|
||||
my $u = LJ::load_user($user);
|
||||
my $second_submit = 0;
|
||||
if ($u) {
|
||||
my $in_use = 1;
|
||||
|
||||
if ($u->{'email'} eq $POST{'email'}) {
|
||||
if (LJ::login_ip_banned($u)) {
|
||||
# brute-force possible going on
|
||||
} else {
|
||||
if ($u->{'password'} eq $POST{'password1'}) {
|
||||
# oh, they double-clicked the submit button
|
||||
$second_submit = 1;
|
||||
$in_use = 0;
|
||||
} else {
|
||||
LJ::handle_bad_login($u);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($in_use) {
|
||||
$errors{'username'} = "$ML{'.error.username.inuse'}";
|
||||
}
|
||||
}
|
||||
|
||||
$POST{'password1'} = LJ::trim($POST{'password1'});
|
||||
$POST{'password2'} = LJ::trim($POST{'password2'});
|
||||
|
||||
if ($POST{'password1'} ne $POST{'password2'}) {
|
||||
$errors{'password'} = "$ML{'.error.password.nomatch'}";
|
||||
} else {
|
||||
my @checkpass = LJ::run_hooks("bad_password",
|
||||
{ 'user' => $user, 'name' => $user,
|
||||
'email' => $email, 'password' => $POST{'password1'} });
|
||||
if (@checkpass && $checkpass[0]->[0]) {
|
||||
$errors{'password'} = "Bad password: $checkpass[0]->[0]";
|
||||
}
|
||||
}
|
||||
if (! $POST{'password1'}) {
|
||||
$errors{'password'} = "$ML{'.error.password.blank'}";
|
||||
} elsif (length $POST{'password1'} > 30) {
|
||||
$errors{'password'} = "$ML{'password.max30'}";
|
||||
}
|
||||
|
||||
unless (LJ::is_ascii($POST{'password1'})) {
|
||||
$errors{'password'} = "$ML{'.error.password.asciionly'}";
|
||||
}
|
||||
|
||||
### start COPPA_CHECK
|
||||
# age checking to determine how old they are
|
||||
if ($LJ::COPPA_CHECK) {
|
||||
my $uniq;
|
||||
if ($LJ::UNIQ_COOKIES) {
|
||||
$uniq = Apache->request->notes('uniq');
|
||||
if ($uniq) {
|
||||
my $timeof = $dbh->selectrow_array('SELECT timeof FROM underage WHERE uniq = ?', undef, $uniq);
|
||||
$is_underage = 1 if $timeof && $timeof > 0;
|
||||
}
|
||||
}
|
||||
|
||||
my ($year, $mon, $day) = ( $POST{"bday_yyyy"}+0, $POST{"bday_mm"}+0, $POST{"bday_dd"}+0 );
|
||||
if ($year < 100) {
|
||||
$POST{'bday_yyyy'} += 1900;
|
||||
$year += 1900;
|
||||
}
|
||||
|
||||
# get current time
|
||||
my ($nday, $nmon, $nyear) = (gmtime())[3, 4, 5];
|
||||
$nyear += 1900;
|
||||
$nmon += 1;
|
||||
|
||||
# require dates in the 1900s (or beyond)
|
||||
if ($year && $mon && $day && $year >= 1900 && $year <= $nyear) {
|
||||
# now see how many years back they are
|
||||
my $ofageyear = $year + 13;
|
||||
if ($ofageyear > $nyear) {
|
||||
$is_underage = 1;
|
||||
} elsif ($ofageyear == $nyear) {
|
||||
# years match, see if they were born after this month
|
||||
if ($mon > $nmon) {
|
||||
$is_underage = 1;
|
||||
} elsif ($mon == $nmon) {
|
||||
# now check the day
|
||||
if ($day > $nday) {
|
||||
$is_underage = 1;
|
||||
} else {
|
||||
$ofage = 1;
|
||||
}
|
||||
} else {
|
||||
$ofage = 1;
|
||||
}
|
||||
} else {
|
||||
$ofage = 1;
|
||||
}
|
||||
} else {
|
||||
$errors{'bday'} = "$ML{'.error.birthday.invalid'}";
|
||||
}
|
||||
|
||||
# note this unique cookie as underage (if we have a unique cookie)
|
||||
if ($is_underage && $uniq) {
|
||||
$dbh->do("REPLACE INTO underage (uniq, timeof) VALUES (?, UNIX_TIMESTAMP())", undef, $uniq);
|
||||
}
|
||||
}
|
||||
### end COPPA_CHECK
|
||||
|
||||
if ($LJ::TOS_CHECK && ! $POST{'agree_tos'}) {
|
||||
$errors{'agree_tos'} = $ML{'tos.error'};
|
||||
}
|
||||
|
||||
# check the email address
|
||||
{
|
||||
my @email_errors;
|
||||
LJ::check_email($email, \@email_errors);
|
||||
if ($LJ::USER_EMAIL and $email =~ /\@\Q$LJ::USER_DOMAIN\E$/i) {
|
||||
push @email_errors, BML::ml(".error.email.lj_domain",
|
||||
{domain => $LJ::USER_DOMAIN});
|
||||
}
|
||||
$errors{'email'} = join(", ", @email_errors) if @email_errors;
|
||||
}
|
||||
|
||||
# Check the turing test answer if it's turned on
|
||||
if ($LJ::HUMAN_CHECK{create}) {
|
||||
my $result = $recaptcha->check_answer($LJ::recaptcha_private_key, LJ::get_remote_ip(),
|
||||
$POST{recaptcha_challenge_field},
|
||||
$POST{recaptcha_response_field});
|
||||
$errors{'captcha'} = $ML{'.captcha.invalid'} unless $result->{is_valid};
|
||||
}
|
||||
|
||||
if ($LJ::LJR_NEWACC_RATE && $LJ::LJR_NEWACC_RATEPERIOD) {
|
||||
my $numaccs = $dbh->selectrow_array(
|
||||
"SELECT count(*) FROM userlog WHERE ip = ? and action = 'account_create' and logtime > UNIX_TIMESTAMP() - ?",
|
||||
undef, LJ::get_remote_ip(), $LJ::LJR_NEWACC_RATEPERIOD);
|
||||
if ($numaccs > $LJ::LJR_NEWACC_RATE) {
|
||||
$errors{'banned'} = 'Sorry, we do not accept that much accounts from one person that fast.';
|
||||
}
|
||||
}
|
||||
|
||||
use Golem;
|
||||
my $tnet = Golem::get_containing_net(LJ::get_remote_ip(), {"with_props" => 1});
|
||||
$tnet = Golem::get_net(LJ::get_remote_ip(), 32, {"with_props" => 1}) unless $tnet;
|
||||
if ($tnet && $tnet->{'props'}->{'data'}->{'ban_new_accounts'}) {
|
||||
$errors{'banned'} = 'Sorry, we do not accept accounts from you.';
|
||||
}
|
||||
|
||||
last SUBMIT if %errors;
|
||||
|
||||
my $clusterid = ($LJ::ALLOW_CLUSTER_SELECT
|
||||
? $POST{'cluster_id'}
|
||||
: LJ::new_account_cluster()) + 0;
|
||||
die "Cluster 0 not supported" unless $clusterid;
|
||||
|
||||
my $userid = $u ? $u->{'userid'}+0 : 0;
|
||||
unless ($second_submit)
|
||||
{
|
||||
my $caps = int($LJ::NEWUSER_CAPS);
|
||||
my $status = ($LJ::EVERYONE_VALID ? 'A' : 'N');
|
||||
|
||||
my $errorcounter = 0;
|
||||
my $old_print_error = $dbh->{PrintError}; # save PrintError mode
|
||||
$dbh->{PrintError} = 0; # will check for errors manually
|
||||
|
||||
while (1) {
|
||||
my $ruserid = LJ::get_new_userid("P");
|
||||
|
||||
if (!$ruserid) {
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'error.procrequest'} p?>";
|
||||
}
|
||||
$dbh->do("set insert_id = $ruserid");
|
||||
|
||||
$dbh->do(
|
||||
"INSERT INTO user (user, email, password, status, caps, name, clusterid, dversion) ".
|
||||
"VALUES (?, ?, ?, ?, ?, ?, ?, ?)",
|
||||
undef, $user, $email, $POST{'password1'}, $status, $caps,
|
||||
$user, $clusterid, $LJ::MAX_DVERSION);
|
||||
|
||||
if ($dbh->err) {
|
||||
# who wants to try forever
|
||||
if ($errorcounter > 10) {
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'error.procrequest'} <b>" . $dbh->errstr . "</b> p?>";
|
||||
}
|
||||
|
||||
$errorcounter++;
|
||||
sleep 1; # let it breathe
|
||||
next; # try again
|
||||
}
|
||||
else {
|
||||
$userid = $dbh->{'mysql_insertid'}; # smells like success
|
||||
$dbh->{PrintError} = $old_print_error; # restore error reporting
|
||||
|
||||
return 0 unless $userid; # but?
|
||||
|
||||
last; # finally
|
||||
}
|
||||
}
|
||||
|
||||
if ($LJ::LJR_FIF) {
|
||||
use LJ::MemCache;
|
||||
my $ljr_fif_id = LJ::get_userid($LJ::LJR_FIF);
|
||||
if ($ljr_fif_id) {
|
||||
$dbh->do("INSERT INTO friends (userid, friendid) VALUES (?, ?)", undef, $ljr_fif_id, $userid);
|
||||
# refresh memcache
|
||||
#my $memkey = [$ljr_fif_id, "friends:$ljr_fif_id"];
|
||||
#LJ::MemCache::delete($memkey);
|
||||
LJ::get_friends($ljr_fif_id, undef, undef, 'force', {} );
|
||||
}
|
||||
}
|
||||
|
||||
$dbh->do("REPLACE INTO useridmap (userid, user) VALUES (?, ?)", undef, $userid, $user);
|
||||
$dbh->do("REPLACE INTO userusage (userid, timecreate) VALUES (?, NOW())", undef, $userid);
|
||||
|
||||
# if we're using account codes on this site, mark the code as used
|
||||
if ($code) {
|
||||
my ($acid, $auth) = LJ::acct_code_decode($code);
|
||||
$dbh->do("UPDATE acctcode SET rcptid=$userid WHERE acid=$acid");
|
||||
if ($dbh->err) { return $dbh->errstr; }
|
||||
}
|
||||
|
||||
# if we have initial friends for new accounts, add them.
|
||||
foreach my $friend (@LJ::INITIAL_FRIENDS) {
|
||||
my $friendid = LJ::get_userid($friend);
|
||||
LJ::add_friend($userid, $friendid) if $friendid;
|
||||
}
|
||||
foreach my $friend (@LJ::INITIAL_OPTIONAL_FRIENDS) {
|
||||
my $friendid = LJ::get_userid($friend);
|
||||
LJ::add_friend($userid, $friendid) if $friendid and $POST{"initial_optional_friend_$friend"};
|
||||
}
|
||||
|
||||
# Set any properties that get set in new users
|
||||
while (my ($name, $val) = each %LJ::USERPROP_INIT) {
|
||||
LJ::set_userprop($userid, $name, $val);
|
||||
}
|
||||
|
||||
LJ::run_hooks("post_create", {
|
||||
'userid' => $userid,
|
||||
'user' => $user,
|
||||
'code' => $code,
|
||||
});
|
||||
}
|
||||
|
||||
# send welcome mail... unless they're underage
|
||||
unless ($is_underage) {
|
||||
my $aa = {};
|
||||
if ($userid) {
|
||||
$aa = LJ::register_authaction($userid, "validateemail", $email);
|
||||
}
|
||||
|
||||
my $body = BML::ml('email.newacct2.body', {
|
||||
"email" => $email,
|
||||
"regurl" => "$LJ::SITEROOT/confirm/$aa->{'aaid'}.$aa->{'authcode'}",
|
||||
"username" => $user,
|
||||
"sitename" => $LJ::SITENAME,
|
||||
"siteroot" => $LJ::SITEROOT,
|
||||
"admin_email" => $LJ::ADMIN_EMAIL,
|
||||
"bogus_email" => $LJ::BOGUS_EMAIL,
|
||||
});
|
||||
|
||||
LJ::send_mail({
|
||||
'to' => $email,
|
||||
'from' => $LJ::ADMIN_EMAIL,
|
||||
'fromname' => $LJ::SITENAME,
|
||||
'charset' => 'utf-8',
|
||||
'subject' => BML::ml('email.newacct.subject', {'sitename' => $LJ::SITENAME}),
|
||||
'body' => $body,
|
||||
});
|
||||
}
|
||||
|
||||
my $nu = LJ::load_userid($userid, "force");
|
||||
|
||||
# now flag as underage (and set O to mean was old or Y to mean was young)
|
||||
$nu->underage(1, $ofage ? 'O' : 'Y', 'account creation') if $is_underage;
|
||||
|
||||
if ($LJ::TOS_CHECK) {
|
||||
my $err = "";
|
||||
$nu->tosagree_set(\$err)
|
||||
or return LJ::bad_input($err);
|
||||
}
|
||||
|
||||
# record create information
|
||||
$nu->log_event('account_create', { remote => $remote });
|
||||
|
||||
$nu->make_login_session;
|
||||
|
||||
# local sites may want to override what happens at this point
|
||||
my $redirect = undef;
|
||||
my $stop_output;
|
||||
LJ::run_hooks("create.bml_postsession", {
|
||||
post => \%POST,
|
||||
u => $nu,
|
||||
redirect => \$redirect,
|
||||
ret => \$ret,
|
||||
stop_output => \$stop_output,
|
||||
});
|
||||
return BML::redirect($redirect) if $redirect;
|
||||
return $ret if $stop_output;
|
||||
|
||||
$ret = "<?h1 $ML{'.success.head'} h1?><?p ".BML::ml(".success.text1", {'email' => $email, 'username' => $user}) ." p?>";
|
||||
my $uri = LJ::journal_base($nu);
|
||||
$ret .= "<?p $ML{'.success.text2'} p?>\n";
|
||||
$ret .= "<?standout <font size='+1' face='arial'><b><a href='$uri'>$uri/</a></b></font> standout?>\n";
|
||||
$ret .= "<?p $ML{'.success.text3'} p?>\n";
|
||||
|
||||
$ret .= "<form method='get' action='$LJ::SITEROOT/editinfo.bml?authas=$user'>";
|
||||
$ret .= "<p align='center'>" . LJ::html_submit(undef, "$ML{'.success.btn.enterinfo'} →") . "</p>";
|
||||
$ret .= "</form>\n";
|
||||
|
||||
return $ret;
|
||||
|
||||
}
|
||||
|
||||
if ($mode eq "getinfo" || %errors)
|
||||
{
|
||||
my $ret;
|
||||
my $v;
|
||||
|
||||
if (%errors) {
|
||||
my @errors_order = ('code', 'username', 'email', 'password', 'agree_tos', 'captcha');
|
||||
my %errors_def;
|
||||
$errors_def{$_} = 1 for @errors_order;
|
||||
foreach my $key (keys %errors) { push @errors_order, $key unless $errors_def{$key}; }
|
||||
$ret .= "<?standout <strong>$ML{'.errors.label'}</strong><ul><li>";
|
||||
$ret .= join ("</li><li>", grep { $_ } map { $errors{$_} } @errors_order);
|
||||
$ret .= "</li></ul> standout?>";
|
||||
}
|
||||
|
||||
$ret .= "<?p $ML{'.create.text'} p?>" unless %errors;
|
||||
$ret .= "<form action=\"create.bml\" method=\"post\">\n";
|
||||
$ret .= LJ::html_hidden(mode => 'submit',
|
||||
code => $code,
|
||||
ssl => $FORM{'ssl'});
|
||||
|
||||
$ret .= "<ol>";
|
||||
|
||||
### username
|
||||
$v = LJ::ehtml($FORM{'user'});
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.username.box.head'}</div>";
|
||||
$ret .= $error_msg->('username', '<p class="formitemFlag">', '</p>');
|
||||
$ret .= "<div class='formitemDesc'>" . BML::ml(".username.text", {'sitename' => $LJ::SITENAME}) . "</div>";
|
||||
$ret .= LJ::html_text({'name' => 'user', 'size' => 15, 'maxlength' => 15, 'value' => $v, raw => 'style="<?loginboxstyle?>"' });
|
||||
$ret .= "<br />" . BML::ml('.community', { aopts => "href='$LJ::SITEROOT/community/create.bml'" });
|
||||
$ret .= "<div class='formitemNote'>$ML{'.username.charsallowed'}</div>" if (!%errors || exists $errors{'username'});
|
||||
$ret .= "</div></li>";
|
||||
|
||||
### email address
|
||||
$v = LJ::ehtml($FORM{'email'});
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.email.input.head'}</div>";
|
||||
$ret .= $error_msg->('email', '<p class="formitemFlag">', '</p>');
|
||||
$ret .= "<div class='formitemDesc'>" . BML::ml('.email.text3', {
|
||||
aopts => "target='_new' href='$LJ::SITEROOT/privacy.bml'",
|
||||
}) . "</div>";
|
||||
$ret .= LJ::html_text({'name' => 'email', 'size' => 40, 'maxlength' => 50, 'value' => $v,});
|
||||
$ret .= "</div></li>";
|
||||
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.password.input.head1'}</div>";
|
||||
$ret .= $error_msg->('password', '<p class="formitemFlag">', '</p>');
|
||||
$ret .= "<div class='formitemFlag'>$ML{'.password.secure'}</div>" if exists $errors{'password'};
|
||||
$ret .= "<div class='formitemDesc'>$ML{'.password.text'}</div>";
|
||||
my $pass_value = $errors{'password'} ? "" : $POST{'password1'};
|
||||
$ret .= LJ::html_text({'name' => 'password1', 'size' => 30, 'maxlength' => 31, 'type' => "password",
|
||||
value => $pass_value, });
|
||||
$ret .= "<div class='formitemDesc'>$ML{'.password.input.head2'}</div>";
|
||||
$ret .= LJ::html_text({'name' => 'password2', 'size' => 30, 'maxlength' => 31, 'type' => "password",
|
||||
value => $pass_value, });
|
||||
$ret .= "</div></li>";
|
||||
|
||||
if (@LJ::INITIAL_OPTIONAL_FRIENDS) {
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.initialfriends.heading'}</div>";
|
||||
$ret .= "<div class='formitemDesc'>$ML{'.initialfriends'}</div>";
|
||||
$ret .= "<div>";
|
||||
foreach my $friend (@LJ::INITIAL_OPTIONAL_FRIENDS) {
|
||||
$ret .= LJ::html_check({'name' => "initial_optional_friend_$friend",
|
||||
'value' => 1,
|
||||
'selected' => $POST{"initial_optional_friend_$friend"},
|
||||
'id' => "optfriend_$friend",
|
||||
});
|
||||
$ret .= "<label for='optfriend_$friend'>" .
|
||||
LJ::ljuser($friend) . " " . $ML{".initial.friend.$friend"} .
|
||||
"</label><br />";
|
||||
}
|
||||
$ret .= "</div></div></li>";
|
||||
}
|
||||
|
||||
if ($LJ::COPPA_CHECK)
|
||||
{
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.birthday.head'}</div>";
|
||||
$ret .= "<div class='formitemFlag'>$errors{'bday'}</div>" if exists $errors{'bday'};
|
||||
$ret .= "<div class='formitemDesc'>$ML{'.birthday.question'}</div><div>";
|
||||
$ret .= "<table><tr><td><span style='font-weight: bold;'>$ML{'.birthday.birthdate'}</span></td><td>";
|
||||
$ret .= LJ::html_datetime({ name => 'bday', notime => 1,
|
||||
default => sprintf("%04d-%02d-%02d", $POST{bday_yyyy}, $POST{bday_mm}, $POST{bday_dd}) });
|
||||
$ret .= "</td><td><span style='font-style: italic;'>$ML{'.birthday.required'}</span></td></tr>";
|
||||
$ret .= "</table></div></div></li>";
|
||||
}
|
||||
|
||||
LJ::run_hooks("create.bml_opts", {
|
||||
post => \%POST,
|
||||
get => \%GET,
|
||||
ret => \$ret,
|
||||
});
|
||||
|
||||
if ($LJ::TOS_CHECK)
|
||||
{
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.tos.heading'}</div>";
|
||||
$ret .= LJ::tosagree_widget($POST{agree_tos}, $errors->{agree_tos});
|
||||
$ret .= "</div></li>";
|
||||
}
|
||||
|
||||
if ($LJ::ALLOW_CLUSTER_SELECT) {
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.clusterselect.head'}</div>";
|
||||
$ret .= "<div class='formitemDesc'>$ML{'.clusterselect.text'}</div>";
|
||||
$ret .= LJ::html_select({ 'name' => 'cluster_id' },
|
||||
"0", "$BML{'.clusterselect.nocluster'}",
|
||||
map { $_, BML::ml(".clusterselect.clusternum", {'number' => $_}) } @LJ::CLUSTERS);
|
||||
|
||||
$ret .= "<div class='formitemNote'>$ML{'.clusterselect.cluster'}</div>";
|
||||
$ret .= "</div></li>";
|
||||
}
|
||||
|
||||
if ($LJ::HUMAN_CHECK{create}) {
|
||||
$ret .= "<li><div class='formitem'><div class='formitemName'>$ML{'.captcha.prove'}</div>";
|
||||
$ret .= $recaptcha->get_html($LJ::recaptcha_public_key);
|
||||
}
|
||||
|
||||
$ret .= "</ol>";
|
||||
|
||||
$ret .= "<div style='width:600; text-align: center'>";
|
||||
$ret .= "<input type=\"submit\" value=\"$ML{'.btn.create'}\">";
|
||||
$ret .= "</div>";
|
||||
$ret .= "</form>";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
return "$ML{'error.unknownmode'}: <b>$mode</b>";
|
||||
|
||||
_code?>
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
link: htdocs/privacy.bml
|
||||
post: htdocs/create.bml, htdocs/editinfo.bml
|
||||
file: htdocs/inc/account-codes
|
||||
hook: post_create
|
||||
</LJDEP> _c?>
|
||||
308
local/htdocs/customize/advanced/layerbrowse.bml
Executable file
308
local/htdocs/customize/advanced/layerbrowse.bml
Executable file
@@ -0,0 +1,308 @@
|
||||
<?_code # -*-bml-*-
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST $title $body);
|
||||
|
||||
LJ::set_active_crumb('layerbrowse');
|
||||
|
||||
# start of content
|
||||
$body = BML::ml("Backlink", {
|
||||
'link' => './',
|
||||
'text' => 'Advanced Customization',
|
||||
});
|
||||
|
||||
my $err = sub {
|
||||
$title = "Error";
|
||||
$body = shift;
|
||||
return;
|
||||
};
|
||||
|
||||
my $pub = LJ::S2::get_public_layers();
|
||||
|
||||
my $id;
|
||||
if ($GET{'id'} =~ /^\d+$/) { # numeric
|
||||
$id = $GET{'id'};
|
||||
} elsif ($GET{'id'}) { # redist_uniq
|
||||
$id = $pub->{$GET{'id'}}->{'s2lid'};
|
||||
}
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
# show the public layers
|
||||
unless ($id) {
|
||||
$title = "Public Layers";
|
||||
my %layerinfo;
|
||||
my @to_load = grep { /^\d+$/ } keys %$pub;
|
||||
LJ::S2::load_layer_info(\%layerinfo, \@to_load);
|
||||
|
||||
my $recurse = sub {
|
||||
my $self = shift;
|
||||
my $lid = shift; # layer id
|
||||
my $lay = $pub->{$lid};
|
||||
return unless $lay;
|
||||
|
||||
# set to true if the layer is not core and is not a layout
|
||||
my $is_child = $lay->{'type'} ne 'core' && $lay->{'type'} ne 'layout';
|
||||
|
||||
my $typedes = " ($lay->{'type'}" . (! $is_child ? ": <b>$lid</b>" : '') . ")";
|
||||
|
||||
# show link to detailed view
|
||||
$body .= "<li><a href='layerbrowse.bml?id=$lay->{'uniq'}'>" . LJ::ehtml($layerinfo{$lid}->{'name'});
|
||||
$body .= "</a>$typedes</li>";
|
||||
|
||||
# done unless there are children to recurse through
|
||||
return unless ! $is_child && $lay->{'children'};
|
||||
|
||||
# if we're not expanding these children, stop and show a link
|
||||
if ($lay->{'type'} eq 'layout' && $GET{'expand'} != $lid) {
|
||||
$body .= "<ul><li>[<a href='layerbrowse.bml?expand=$lid'>";
|
||||
$body .= scalar(@{$lay->{'children'}}) . " children...</a>]</li></ul>";
|
||||
return;
|
||||
}
|
||||
|
||||
# expand children
|
||||
$body .= "<ul>";
|
||||
foreach (@{$lay->{'children'}}) {
|
||||
$self->($self, $_);
|
||||
}
|
||||
$body .= "</ul>";
|
||||
|
||||
return;
|
||||
};
|
||||
|
||||
# iterate through core layers
|
||||
$body .= "<ul>";
|
||||
foreach (grep { $pub->{$_}->{'b2lid'} == 0 } grep { /^\d+$/ } keys %$pub) {
|
||||
$recurse->($recurse, $_); # start from the top
|
||||
}
|
||||
$body .= "</ul>";
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
### details on a specific layer ###
|
||||
|
||||
my $xlink = sub {
|
||||
my $r = shift;
|
||||
$$r =~ s/\[class\[(\w+)\]\]/<a href=\"\#class.$1\">$1<\/a>/g;
|
||||
$$r =~ s/\[method\[(.+?)\]\]/<a href=\"\#meth.$1\">$1<\/a>/g;
|
||||
$$r =~ s/\[function\[(.+?)\]\]/<a href=\"\#func.$1\">$1<\/a>/g;
|
||||
$$r =~ s/\[member\[(.+?)\]\]/<a href=\"\#member.$1\">$1<\/a>/g;
|
||||
};
|
||||
|
||||
# load layer info
|
||||
my $layer = defined $pub->{$id} ? $pub->{$id} : LJ::S2::load_layer($id);
|
||||
return $err->("The specified layer does not exist.")
|
||||
unless $layer;
|
||||
|
||||
my $layerinfo = {};
|
||||
LJ::S2::load_layer_info($layerinfo, [ $id ]);
|
||||
my $srcview = exists $layerinfo->{$id}->{'source_viewable'} ?
|
||||
$layerinfo->{$id}->{'source_viewable'} : undef;
|
||||
|
||||
# do they have access?
|
||||
my $isadmin = !defined $pub->{$id} && # public styles are pulled from the system
|
||||
(LJ::check_priv($remote, 'canview', 'styles') || # account, so we don't want to check privileges
|
||||
LJ::check_priv($remote, 'canview', '*')); # in case they're private styles
|
||||
return $err->("You are not authorized to view this layer.")
|
||||
unless defined $pub->{$id} || $srcview == 1 ||
|
||||
LJ::can_manage($remote, $layer->{'userid'}) ||
|
||||
$isadmin;
|
||||
|
||||
LJ::S2::load_layers($id);
|
||||
my $s2info = S2::get_layer_all($id);
|
||||
my $class = $s2info->{'class'} || {};
|
||||
|
||||
my $xlink_args = sub {
|
||||
my $r = shift;
|
||||
return unless
|
||||
$$r =~ /^(.+?\()(.*)\)$/;
|
||||
my ($new, @args) = ($1, split(/\s*\,\s*/, $2));
|
||||
foreach (@args) {
|
||||
s/^(\w+)/defined $class->{$1} ? "[class[$1]]" : $1/eg;
|
||||
}
|
||||
$new .= join(", ", @args) . ")";
|
||||
$$r = $new;
|
||||
$xlink->($r);
|
||||
};
|
||||
|
||||
$body .= "<br />";
|
||||
# link to layer list if this is a public layer, otherwise user's layer list
|
||||
if (defined $pub->{$id}) {
|
||||
$body .= BML::ml('Backlink', { 'link' => 'layerbrowse.bml', 'text' => 'Public Layers' }) . "\n";
|
||||
} else {
|
||||
$body .= BML::ml('Backlink', { 'link' => "layers.bml", 'text' => 'Your Layers' }) . "\n";
|
||||
$body .= BML::ml('Actionlink', { 'link' => "<a href='layeredit.bml?id=$id'>Edit Layer</a>" }) . "\n";
|
||||
}
|
||||
|
||||
if ($layer->{'b2lid'}) {
|
||||
$body .= "[<a href=\"layerbrowse.bml?id=$layer->{'b2lid'}\">Parent Layer</a>]\n";
|
||||
}
|
||||
if (defined $pub->{$id} && (! defined $srcview || $srcview != 0) ||
|
||||
$srcview == 1 ||
|
||||
LJ::can_manage($remote, $layer->{'userid'}) ||
|
||||
$isadmin) {
|
||||
|
||||
$body .= "[<a href=\"layersource.bml?id=$id\">Download</a>]\n";
|
||||
$body .= "[<a href=\"layersource.bml?id=$id&fmt=html\">View as HTML</a>]\n";
|
||||
}
|
||||
|
||||
# layerinfo
|
||||
if (my $info = $s2info->{'info'}) {
|
||||
$body .= "<?h1 Layer Info h1?>";
|
||||
$body .= "<table style='margin-bottom: 10px' border='1' cellpadding='2'>";
|
||||
foreach my $k (sort keys %$info) {
|
||||
my ($ek, $ev) = map { LJ::ehtml($_) } ($k, $info->{$k});
|
||||
$title = $ev if $k eq "name";
|
||||
$body .= "<tr><td><b>$ek</b></td><td>$ev</td></tr>\n";
|
||||
}
|
||||
$body .= "</table>";
|
||||
}
|
||||
|
||||
# sets
|
||||
if (my $set = $s2info->{'set'}) {
|
||||
$body .= "<?h1 Properties Set h1?>";
|
||||
$body .= "<table style='margin-bottom: 10px' border='1' cellpadding='2'>";
|
||||
foreach my $k (sort keys %$set) {
|
||||
my $v = $set->{$k};
|
||||
if (ref $v eq "HASH") {
|
||||
if ($v->{'_type'} eq "Color") {
|
||||
$v = "<span style=\"border: 1px solid #000000; padding-left: 2em; background-color: $v->{'as_string'}\"> </span> <tt>$v->{'as_string'}</tt>";
|
||||
} else {
|
||||
$v = "[unknown object type]";
|
||||
}
|
||||
} elsif (ref $v eq "ARRAY") {
|
||||
$v = "<i>List:</i> (" . join(", ", map { LJ::ehtml($_) } @$v) . ")";
|
||||
} else {
|
||||
$v = LJ::ehtml($v);
|
||||
}
|
||||
$body .= "<tr><td><b>$k</b></td><td>$v</td></tr>\n";
|
||||
}
|
||||
$body .= "</table>";
|
||||
}
|
||||
|
||||
# global functions
|
||||
my $gb = $s2info->{'global'};
|
||||
if (ref $gb eq "HASH" && %$gb) {
|
||||
$body .= "<?h1 Global Functions h1?>";
|
||||
$body .= "<table style='margin-bottom: 10px' border='1' cellpadding='2'>";
|
||||
foreach my $fname (sort keys %$gb) {
|
||||
my $rt = $gb->{$fname}->{'returntype'};
|
||||
if (defined $class->{$rt}) {
|
||||
$rt = "[class[$rt]]";
|
||||
}
|
||||
$xlink->(\$rt);
|
||||
my $ds = LJ::ehtml($gb->{$fname}->{'docstring'});
|
||||
$xlink->(\$ds);
|
||||
|
||||
my $args = $gb->{$fname}->{'args'};
|
||||
$xlink_args->(\$args);
|
||||
|
||||
$body .= "<tr><td><nobr><a name='func.$fname'><tt>$args : $rt</tt></a></nobr></td><td>$ds</td></tr>";
|
||||
}
|
||||
$body .= "</table>";
|
||||
}
|
||||
|
||||
|
||||
if (%$class)
|
||||
{
|
||||
# class index
|
||||
$body .= "<?h1 Classes h1?>";
|
||||
$body .= "<table style='margin-bottom: 10px'><tr valign='top' align='left'>";
|
||||
$body .= "<td width='50%'>Alphabetical";
|
||||
$body .= "<ul>";
|
||||
foreach my $cname (sort { lc($a) cmp lc($b) } keys %$class) {
|
||||
$body .= "<li><a href='#class.$cname'><b>$cname</b></a></li>\n";
|
||||
}
|
||||
$body .= "</ul>";
|
||||
$body .= "</td>";
|
||||
$body .= "<td width='50%'>Hierarchical";
|
||||
my $dumpsub = sub {
|
||||
my $self = shift;
|
||||
my $parent = shift;
|
||||
$body .= "<li><a href='#class.$parent'><b>$parent</b></a></li>\n"
|
||||
if $parent;
|
||||
my $didul = 0;
|
||||
foreach my $cname (sort { lc($a) cmp lc($b) } keys %$class) {
|
||||
next unless $class->{$cname}->{'parent'} eq $parent;
|
||||
unless ($didul++) { $body .= "<ul>"; }
|
||||
$self->($self, $cname);
|
||||
}
|
||||
if ($didul) { $body .= "</ul>"; }
|
||||
};
|
||||
$dumpsub->($dumpsub, "");
|
||||
$body .= "</td></tr></table>";
|
||||
|
||||
# classes
|
||||
foreach my $cname (sort { lc($a) cmp lc($b) } keys %$class) {
|
||||
$body .= "<a name='class.$cname'><?h1 $cname Class h1?></a>";
|
||||
my $ds = LJ::ehtml($class->{$cname}->{'docstring'});
|
||||
if ($class->{$cname}->{'parent'}) {
|
||||
$ds = "Child class of [class[$class->{$cname}->{'parent'}]]. $ds";
|
||||
}
|
||||
if ($ds) {
|
||||
$xlink->(\$ds);
|
||||
$body .= "<?p $ds p?>";
|
||||
}
|
||||
|
||||
# build functions & methods
|
||||
my (%func, %var);
|
||||
my $add = sub {
|
||||
my ($self, $aname) = @_;
|
||||
foreach (keys %{$class->{$aname}->{'funcs'}}) {
|
||||
$func{$_} = $class->{$aname}->{'funcs'}->{$_};
|
||||
$func{$_}->{'_declclass'} = $aname;
|
||||
}
|
||||
foreach (keys %{$class->{$aname}->{'vars'}}) {
|
||||
$var{$_} = $class->{$aname}->{'vars'}->{$_};
|
||||
$var{$_}->{'_declclass'} = $aname;
|
||||
}
|
||||
|
||||
my $parent = $class->{$aname}->{'parent'};
|
||||
$self->($self, $parent) if $parent;
|
||||
};
|
||||
$add->($add, $cname);
|
||||
|
||||
$body .= "<table style='margin-bottom: 10px' border='1' cellpadding='2'><?h2 Members h2?>" if %var;
|
||||
foreach (sort keys %var) {
|
||||
my $type = $var{$_}->{'type'};
|
||||
$type =~ s/(\w+)/defined $class->{$1} ? "[class[$1]]" : $1/eg;
|
||||
$xlink->(\$type);
|
||||
|
||||
my $ds = LJ::ehtml($var{$_}->{'docstring'});
|
||||
$xlink->(\$ds);
|
||||
|
||||
if ($var{$_}->{'readonly'}) {
|
||||
$ds = "<i>(Read-only)</i> $ds";
|
||||
}
|
||||
|
||||
$body .= "<tr><td><nobr><a name='member.${cname}.$_'><tt>$type $_</tt></a></nobr></td><td>$ds</td></tr>";
|
||||
}
|
||||
$body .= "</table>" if %var;
|
||||
|
||||
$body .= "<table style='margin-bottom: 10px' border='1' cellpadding='2'><?h2 Methods h2?>" if %func;
|
||||
foreach (sort keys %func) {
|
||||
my $rt = $func{$_}->{'returntype'};
|
||||
if (defined $class->{$rt}) {
|
||||
$rt = "[class[$rt]]";
|
||||
}
|
||||
$xlink->(\$rt);
|
||||
my $ds = LJ::ehtml($func{$_}->{'docstring'});
|
||||
$xlink->(\$ds);
|
||||
|
||||
my $args = $_;
|
||||
$xlink_args->(\$args);
|
||||
|
||||
$body .= "<tr><td><nobr><a name='meth.${cname}::$_'><tt>$args : $rt</tt></a></nobr></td><td>$ds</td></tr>";
|
||||
}
|
||||
$body .= "</table>" if %func;
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
_code?><?page title=><?_code return $title; _code?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?>
|
||||
|
||||
139
local/htdocs/customize/advanced/layeredit.bml
Executable file
139
local/htdocs/customize/advanced/layeredit.bml
Executable file
@@ -0,0 +1,139 @@
|
||||
<style>
|
||||
em.error { font-weight: bold; color: red; font-style: normal; }
|
||||
textarea.s2code { width: 100%; display: block; clear: both; padding: 2px; }
|
||||
</style>
|
||||
<?_code # -*-bml-*-
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
|
||||
# for error reporting
|
||||
my $err = sub {
|
||||
return "<title>Error</title>\n<h2>Error</h2>" . shift;
|
||||
};
|
||||
|
||||
# we need a valid id
|
||||
my $id = $GET{'id'} if $GET{'id'} =~ /^\d+$/;
|
||||
return $err->("You have not specified a layer to edit.")
|
||||
unless $id;
|
||||
|
||||
# authenticate user;
|
||||
my $remote = LJ::get_remote();
|
||||
return $err->("You must be logged in to edit layers.")
|
||||
unless $remote;
|
||||
|
||||
# load layer
|
||||
my $lay = LJ::S2::load_layer($id);
|
||||
return $err->("The specified layer does not exist.")
|
||||
unless $lay;
|
||||
|
||||
# if the b2lid of this layer has been remapped to a new layerid
|
||||
# then update the b2lid mapping for this layer
|
||||
my $b2lid = $lay->{b2lid};
|
||||
if ($b2lid && $LJ::S2LID_REMAP{$b2lid}) {
|
||||
LJ::S2::b2lid_remap($remote, $id, $b2lid);
|
||||
$lay->{b2lid} = $LJ::S2LID_REMAP{$b2lid};
|
||||
}
|
||||
|
||||
# is authorized admin for this layer?
|
||||
return $err->('You are not authorized to edit this layer.')
|
||||
unless LJ::can_manage($remote, $lay->{'userid'});
|
||||
|
||||
# get u of user they are acting as
|
||||
my $u = $lay->{'userid'} == $remote->{'userid'} ? $remote : LJ::load_userid($lay->{'userid'});
|
||||
|
||||
# check priv and ownership
|
||||
return $err->("You are not authorized to edit styles.")
|
||||
unless LJ::get_cap($u, "s2styles");
|
||||
|
||||
# at this point, they are authorized, allow viewing & editing
|
||||
my $ret;
|
||||
$ret .= "<form method='post' action='layeredit.bml?id=$id'>\n";
|
||||
$ret .= BML::ml('Backlink', { 'text' => 'Your Layers', 'link' => "layers.bml?authas=$u->{'user'}" }) . "\n";
|
||||
|
||||
# get s2 code from db - use writer so we know it's up-to-date
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $s2code = $POST{'s2code'};
|
||||
$s2code = $dbh->selectrow_array("SELECT s2code FROM s2source WHERE s2lid=?",
|
||||
undef, $lay->{'s2lid'}) unless $s2code;
|
||||
|
||||
# we tried to compile something
|
||||
if ($POST{'action'} eq "compile") {
|
||||
$ret .= "<div style='margin: 20px 0 20px 40px'>\n";
|
||||
$ret .= "<b>S2 Compiler Output</b> <em>at " . scalar(localtime) . "</em><br />\n";
|
||||
|
||||
my $error;
|
||||
$POST{'s2code'} =~ s/\r//g; # just in case
|
||||
unless (LJ::S2::layer_compile($lay, \$error, { 's2ref' => \$POST{'s2code'} })) {
|
||||
|
||||
$error =~ s/LJ::S2,.+//s;
|
||||
$error =~ s!, .+?(src/s2|cgi-bin)/!, !g;
|
||||
|
||||
$ret .= "Error compiling layer:\n<pre style=\"border-left: 1px red solid\">$error</pre>";
|
||||
|
||||
# display error with helpful context
|
||||
if ($error =~ /^compile error: line (\d+)/i) {
|
||||
my $errline = $1;
|
||||
my $kill = $errline - 5 < 0 ? 0 : $errline - 5;
|
||||
my $prehilite = $errline - 1 > 4 ? 4: $errline - 1;
|
||||
my $snippet = $s2code;
|
||||
|
||||
# make sure there's a newlilne at the end
|
||||
chomp $snippet;
|
||||
$snippet .= "\n";
|
||||
|
||||
# and now, fun with regular expressions
|
||||
my $ct = 0;
|
||||
$snippet =~ s!(.*?)\n!sprintf("%3d", ++$ct) . ": " .
|
||||
$1 . "\n"!ge; # add line breaks and numbering
|
||||
$snippet = LJ::ehtml($snippet);
|
||||
$snippet =~ s!^((?:.*?\n){$kill,$kill}) # kill before relevant lines
|
||||
((?:.*?\n){$prehilite,$prehilite}) # capture context before error
|
||||
(.*?\n){0,1} # capture error
|
||||
((?:.*?\n){0,4}) # capture context after error
|
||||
.* # kill after relevant lines
|
||||
!$2<em class='error'>$3</em>$4!sx;
|
||||
|
||||
$ret .= "<b>Context</b><br /><pre>$snippet</pre>\n";
|
||||
}
|
||||
|
||||
} else {
|
||||
$ret .= "No errors\n";
|
||||
}
|
||||
$ret .= "</div>\n\n";
|
||||
}
|
||||
|
||||
$ret .= LJ::html_hidden("action", "compile") . "\n";
|
||||
$ret .= "<p>" . LJ::html_submit('submit', 'Compile', {
|
||||
'style' => 'float: right; margin-bottom: 2px',
|
||||
'accesskey' => 'c',
|
||||
'title' => 'alt-C: compile',
|
||||
} ) . "\n";
|
||||
$ret .= "<b>Edit layer source</b>\n";
|
||||
$ret .= LJ::html_textarea({ 'name' => 's2code', 'class' => 's2code', 'wrap' => 'off',
|
||||
'cols' => '50', 'rows' => '40', 'value' => $s2code }) . "\n";
|
||||
$ret .= LJ::html_submit('submit', 'Compile') . "\n";
|
||||
$ret .= "</p></form>\n";
|
||||
|
||||
# load layer info
|
||||
my $layinf = {};
|
||||
LJ::S2::load_layer_info($layinf, [ $id ]);
|
||||
|
||||
# find a title to display on this page
|
||||
my $type = $layinf->{$id}->{'type'};
|
||||
my $name = $layinf->{$id}->{'name'};
|
||||
|
||||
# find name of parent layer if this is a child layer
|
||||
if (! $name && $type =~ /^(user|theme|i18n)$/) {
|
||||
my $par = $lay->{'b2lid'} + 0;
|
||||
LJ::S2::load_layer_info($layinf, [$par]);
|
||||
$name = $layinf->{$par}->{'name'};
|
||||
}
|
||||
|
||||
# Only use the layer name if there is one and it's more than just whitespace
|
||||
my $title = "[$type] ";
|
||||
$title .= $name && $name =~ /[^\s]/ ? "$name [\#$id]" : "Layer \#$id";
|
||||
|
||||
return "<title>" . LJ::ehtml($title) . " - Edit</title>\n" . $ret;
|
||||
}
|
||||
_code?>
|
||||
260
local/htdocs/customize/advanced/layers.bml
Executable file
260
local/htdocs/customize/advanced/layers.bml
Executable file
@@ -0,0 +1,260 @@
|
||||
<?_code # -*-bml-*-
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST $title $body);
|
||||
|
||||
LJ::set_active_crumb('yourlayers');
|
||||
|
||||
my $remote;
|
||||
|
||||
# authas switcher form
|
||||
my $authasform = sub {
|
||||
$body .= "<form method='get' action='styles.bml'>\n";
|
||||
$body .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} }) . "\n";
|
||||
$body .= "</form>\n\n";
|
||||
};
|
||||
|
||||
# used for error messages
|
||||
my $err = sub {
|
||||
$title = "Error";
|
||||
$body = '';
|
||||
$authasform->() if $remote;
|
||||
$body .= "<?p $_[0] p?>";
|
||||
return;
|
||||
};
|
||||
|
||||
# id is optional
|
||||
my $id = $POST{'id'} if $POST{'id'} =~ /^\d+$/;
|
||||
|
||||
# this catches core_hidden if it's set
|
||||
$POST{'parid'} ||= $POST{'parid_hidden'};
|
||||
|
||||
# authenticate user
|
||||
$remote = LJ::get_remote();
|
||||
return $err->('You must be logged in to view your layers.')
|
||||
unless $remote;
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $u = LJ::get_authas_user($authas);
|
||||
|
||||
# if we don't have a u, maybe they're an admin and can view stuff anyway?
|
||||
my $noactions = 0;
|
||||
if ($GET{user} && (LJ::check_priv($remote, 'canview', 'styles') ||
|
||||
LJ::check_priv($remote, 'canview', '*'))) {
|
||||
return $err->('This privilege cannot be used on the system account.')
|
||||
if $GET{user} eq 'system';
|
||||
$u = LJ::load_user($GET{user});
|
||||
$noactions = 1; # don't let admins change anything
|
||||
}
|
||||
return $err->('You could not be authenticated as the specified user.')
|
||||
unless $u;
|
||||
|
||||
# load user and public layers
|
||||
my $pub = LJ::S2::get_public_layers();
|
||||
my $ulay = LJ::S2::get_layers_of_user($u);
|
||||
|
||||
my $has_priv = LJ::get_cap($u, 's2styles');
|
||||
return $err->($remote->{user} eq $u->{user} ?
|
||||
'Your account type does not allow advanced customization.' :
|
||||
'The selected user\'s account type does not allow advanced customization.' )
|
||||
unless $has_priv;
|
||||
|
||||
# start of output
|
||||
$title = "Your Layers";
|
||||
$body .= BML::ml("Backlink", {
|
||||
'link' => './',
|
||||
'text' => 'Advanced Customization',
|
||||
}) . "\n";
|
||||
$body .= BML::ml("Actionlink", {
|
||||
'link' => "<a href='styles.bml?authas=$authas'>Your Styles</a>",
|
||||
}) . "\n";
|
||||
|
||||
|
||||
### perform actions ###
|
||||
|
||||
# create
|
||||
if ($POST{'action:create'} && !$noactions) {
|
||||
return $err->("You have reached your maximum number of allowed layers")
|
||||
if keys %$ulay >= LJ::get_cap($u, 's2layersmax');
|
||||
|
||||
my $err_badparid = "No/bogus parent layer ID given (for layouts and core languages, use core parent ID; for themes and layout languages, use layout ID)";
|
||||
my $type = $POST{'type'} or return $err->("No layer type selected.");
|
||||
my $parid = $POST{'parid'}+0 or return $err->($err_badparid);
|
||||
return $err->("Invalid layer type") unless $type =~ /^layout|theme|user|i18nc?$/;
|
||||
my $parent_type = ($type eq "theme" || $type eq "i18n" || $type eq "user") ? "layout" : "core";
|
||||
|
||||
# parent ID is public layer
|
||||
if ($pub->{$parid}) {
|
||||
# of the wrong type
|
||||
return $err->($err_badparid) if $pub->{$parid}->{'type'} ne $parent_type;
|
||||
|
||||
# parent ID is user layer, or completely invalid
|
||||
} else {
|
||||
return $err->($err_badparid) if
|
||||
! $ulay->{$parid} || $ulay->{$parid}->{'type'} != $parent_type;
|
||||
}
|
||||
|
||||
my $id = LJ::S2::create_layer($u, $parid, $type);
|
||||
return $err->("Error creating layer") unless $id;
|
||||
|
||||
my $lay = {
|
||||
'userid' => $u->{'userid'},
|
||||
'type' => $type,
|
||||
'b2lid' => $parid,
|
||||
's2lid' => $id,
|
||||
};
|
||||
|
||||
# help user out a bit, creating the beginning of their layer.
|
||||
my $s2 = "layerinfo \"type\" = \"$type\";\n";
|
||||
$s2 .= "layerinfo \"name\" = \"\";\n\n";
|
||||
my $error;
|
||||
unless (LJ::S2::layer_compile($lay, \$error, { 's2ref' => \$s2 })) {
|
||||
return $err->("Error setting up & compiling layer: $error");
|
||||
}
|
||||
|
||||
# redirect so they can't refresh and create a new layer again
|
||||
return BML::redirect("layers.bml?authas=$authas");
|
||||
}
|
||||
|
||||
# delete
|
||||
if ($POST{'action:del'} && !$noactions) {
|
||||
my $id = $POST{'id'}+0;
|
||||
my $lay = LJ::S2::load_layer($id);
|
||||
return $err->("The specified layer does not exist")
|
||||
unless $lay;
|
||||
|
||||
return $err->("You do not own the specified layer")
|
||||
unless $lay->{'userid'} == $u->{'userid'};
|
||||
|
||||
unless ($POST{'confirm'}) {
|
||||
my $layerinfo = {};
|
||||
LJ::S2::load_layer_info($layerinfo, [ $id ]);
|
||||
my $name = $layerinfo->{$id}->{'name'} ? "'$layerinfo->{$id}->{'name'}'" : "#$id";
|
||||
$name = LJ::ehtml($name);
|
||||
|
||||
$title = "Deleting layer $name";
|
||||
$body .= "<br /> ";
|
||||
$body .= BML::ml("Backlink", {
|
||||
'link' => "layers.bml?authas=$authas",
|
||||
'text' => 'Your Layers',
|
||||
}) . "\n";
|
||||
$body .= "<form method='post' action='layers.bml?authas=$authas'>";
|
||||
$body .= LJ::html_hidden('action:del', '1', 'id', $id);
|
||||
|
||||
$body .= "Are you sure you want to delete $lay->{'type'} layer $name?";
|
||||
$body .= "<p>" . LJ::html_submit('confirm', 'Delete') . "</p>\n";;
|
||||
$body .= "</form>\n";
|
||||
return;
|
||||
}
|
||||
|
||||
LJ::S2::delete_layer($u, $id);
|
||||
return BML::redirect("layers.bml?authas=$authas");
|
||||
}
|
||||
|
||||
# authas switcher form
|
||||
unless ($noactions) {
|
||||
$authasform->();
|
||||
}
|
||||
|
||||
# show list of layers
|
||||
$body .= "<?h1 Your Layers h1?>\n";
|
||||
if (%$ulay) {
|
||||
$body .= "<table style='margin-bottom: 10px' cellpadding='3' border='1'>\n";
|
||||
$body .= "<tr><td><b>LayerID</b></td><td><b>Type</b></td><td><b>Name</b></td><td><b>Actions</b></td></tr>\n";
|
||||
my $lastbase = 0;
|
||||
foreach my $lid (sort { $ulay->{$a}->{'b2lid'} <=> $ulay->{$b}->{'b2lid'} || $a <=> $b }
|
||||
keys %$ulay)
|
||||
{
|
||||
my $bid = $ulay->{$lid}->{'b2lid'};
|
||||
if ($bid != $lastbase) {
|
||||
$lastbase = $bid;
|
||||
my $parlay = $ulay->{$bid} || $pub->{$bid};
|
||||
my $pname = LJ::ehtml($parlay->{'name'});
|
||||
$body .= "<tr><td colspan='4'><small>Child of <a href='layerbrowse.bml?id=$bid'>layer $bid</a>: $pname</small></td></tr>\n";
|
||||
}
|
||||
my $lay = $ulay->{$lid};
|
||||
my $name = LJ::ehtml($lay->{'name'}) || "<i>(none)</i>";
|
||||
$body .= "<tr><td><a href='layerbrowse.bml?id=$lid'>$lid</a></td><td>$lay->{'type'}</td><td>$name</td><td>";
|
||||
$body .= "<form method='post' style='display:inline' action='layeredit.bml?id=$lid'>";
|
||||
$body .= LJ::html_submit('action:edit', 'Edit...', { disabled => $noactions });
|
||||
$body .= "</form>";
|
||||
|
||||
$body .= "<form method='post' style='display:inline' action='layers.bml?authas=$authas'>";
|
||||
$body .= LJ::html_hidden('id', $lid);
|
||||
$body .= LJ::html_submit('action:del', 'Delete...', { disabled => $noactions });
|
||||
$body .= "</form>";
|
||||
$body .= "</td></tr>\n"
|
||||
}
|
||||
$body .= "</table>\n\n";
|
||||
} else {
|
||||
$body .= "<?p <i>None</i> p?>\n\n";
|
||||
}
|
||||
|
||||
# jump out if we're just viewing
|
||||
return if $noactions;
|
||||
|
||||
# create layer
|
||||
$body .= "<?h1 Create Layer h1?>\n";
|
||||
|
||||
$body .= "<div style='margin-top: 10px;'>\n";
|
||||
$body .= "<?h2 Create top-level layer h2?>\n";
|
||||
$body .= "<form method='post' action='layers.bml?authas=$authas'>\n";
|
||||
|
||||
$body .= "Type: " . LJ::html_select({ 'name' => 'type' },
|
||||
"" => "",
|
||||
"layout" => "Layout",
|
||||
"i18nc" => "Language",
|
||||
) . "\n";
|
||||
|
||||
my @corelayers = map { $_, $pub->{$_}->{'majorversion'} }
|
||||
sort { $pub->{$b}->{'majorversion'} <=> $pub->{$a}->{'majorversion'} }
|
||||
grep { $pub->{$_}->{'b2lid'} == 0 && $pub->{$_}->{'type'} eq 'core' && /^\d+$/}
|
||||
keys %$pub;
|
||||
$body .= " Core Version: " . LJ::html_select({ 'name' => 'parid',
|
||||
'selected' => $corelayers[0],
|
||||
'disabled' => @corelayers > 2 ? 0: 1 },
|
||||
@corelayers ) . "\n";
|
||||
|
||||
# store value in hidden to later be copied to 'parid' if necessary
|
||||
# defaults to $corelayers[0] which should be the highest numbered core
|
||||
$body .= LJ::html_hidden("parid_hidden", $POST{'parid'} || $corelayers[0]) . "\n";
|
||||
$body .= LJ::html_submit("action:create", "Create") . "\n";
|
||||
$body .= "</form>\n";
|
||||
$body .= "</div>\n\n";
|
||||
|
||||
$body .= "<?h2 Create layout-specific layer h2?>\n";
|
||||
$body .= "<form method='post' action='layers.bml?authas=$authas'>\n";
|
||||
|
||||
$body .= "Type: " . LJ::html_select({ 'name' => 'type' },
|
||||
"" => "",
|
||||
"theme" => "Theme",
|
||||
"i18n" => "Language",
|
||||
"user" => "User"
|
||||
) . "\n";
|
||||
|
||||
my @layouts = ('', '');
|
||||
push @layouts, map { $_, $pub->{$_}->{'name'} }
|
||||
sort { $pub->{$a}->{'name'} cmp $pub->{$b}->{'name'} || $a <=> $b}
|
||||
grep { $pub->{$_}->{'type'} eq 'layout' && /^\d+$/}
|
||||
keys %$pub;
|
||||
if (%$ulay) {
|
||||
my @ulayouts = ();
|
||||
push @ulayouts, map { $_, "$ulay->{$_}->{'name'} (#$_)" }
|
||||
sort { $ulay->{$a}->{'name'} cmp $ulay->{$b}->{'name'} || $a <=> $b}
|
||||
grep { $ulay->{$_}->{'type'} eq 'layout' }
|
||||
keys %$ulay;
|
||||
push @layouts, ('', '---', @ulayouts) if @ulayouts;
|
||||
}
|
||||
|
||||
$body .= "Layout: " . LJ::html_select({ 'name' => 'parid' }, @layouts) . "\n";
|
||||
|
||||
$body .= LJ::html_submit("action:create", "Create") . "\n";
|
||||
$body .= "</form>\n\n";
|
||||
|
||||
return;
|
||||
}
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?>
|
||||
|
||||
465
local/htdocs/customize/advanced/styles.bml
Executable file
465
local/htdocs/customize/advanced/styles.bml
Executable file
@@ -0,0 +1,465 @@
|
||||
<?_code # -*-bml-*-
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST $title $body);
|
||||
|
||||
LJ::set_active_crumb('yourstyles');
|
||||
|
||||
my $remote;
|
||||
|
||||
# authas switcher form
|
||||
my $authasform = sub {
|
||||
$body .= "<form method='get' action='styles.bml'>\n";
|
||||
$body .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} }) . "\n";
|
||||
$body .= "</form>\n\n";
|
||||
};
|
||||
|
||||
# used for error messages
|
||||
my $err = sub {
|
||||
$title = "Error";
|
||||
$body = '';
|
||||
$authasform->() if $remote;
|
||||
$body .= "<?p $_[0] p?>";
|
||||
return;
|
||||
};
|
||||
|
||||
# authenticate user
|
||||
$remote = LJ::get_remote();
|
||||
return $err->('You must be logged in to view your styles.')
|
||||
unless $remote;
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $u = LJ::get_authas_user($authas);
|
||||
return $err->('You could not be authenticated as the specified user.')
|
||||
unless $u;
|
||||
|
||||
return $err->($remote->{user} eq $u->{user} ?
|
||||
'Your account type does not allow advanced customization.' :
|
||||
'The selected user\'s account type does not allow advanced customization.' )
|
||||
unless LJ::get_cap($u, 's2styles');
|
||||
|
||||
# extra arguments for get requests
|
||||
my $getextra = $authas ne $remote->{'user'} ? "?authas=$authas" : '';
|
||||
my $getextra_amp = "&authas=$authas" if $getextra;
|
||||
|
||||
# style id to edit, if we have one
|
||||
# if we have this we're assumed to be in 'edit' mode
|
||||
my $id = $GET{'id'}+0;
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
# variables declared here, but only filled in if $id
|
||||
my ($core, $layout); # scalars
|
||||
my ($pub, $ulay, $style); # hashrefs
|
||||
|
||||
# start of output
|
||||
$title = "Styles";
|
||||
$body = BML::ml("Backlink", {
|
||||
'link' => './',
|
||||
'text' => 'Advanced Customization',
|
||||
}) . "\n";
|
||||
$body .= BML::ml("Actionlink", {
|
||||
'link' => "<a href='layers.bml$getextra'>Your Layers</a>",
|
||||
}) . "\n";
|
||||
|
||||
# edit mode
|
||||
if ($id) {
|
||||
|
||||
# load style
|
||||
$style = LJ::S2::load_style($id);
|
||||
return $err->('Style not found') unless $style;
|
||||
|
||||
# check that they own the style
|
||||
return $err->("You do not own this style.")
|
||||
unless $style->{'userid'} == $u->{'userid'};
|
||||
|
||||
# use selected style
|
||||
if ($POST{'action:usestyle'}) {
|
||||
|
||||
# save to db and update user object
|
||||
LJ::set_userprop($u, "stylesys", '2');
|
||||
LJ::set_userprop($u, "s2_style", $id);
|
||||
return BML::redirect("styles.bml$getextra");
|
||||
}
|
||||
|
||||
# get public layers
|
||||
$pub = LJ::S2::get_public_layers();
|
||||
|
||||
# get user layers
|
||||
$ulay = LJ::S2::get_layers_of_user($u);
|
||||
|
||||
# find effective layerids being used
|
||||
my %eff_layer = ();
|
||||
my @other_layers = ();
|
||||
foreach (qw(i18nc layout theme i18n user)) {
|
||||
my $lid = $POST{$_} eq "_other" ? $POST{"other_$_"} : $POST{$_};
|
||||
next unless $lid;
|
||||
$eff_layer{$_} = $lid;
|
||||
|
||||
unless ($ulay->{$eff_layer{$_}} || $pub->{$eff_layer{$_}}) {
|
||||
push @other_layers, $lid;
|
||||
}
|
||||
}
|
||||
|
||||
# core lid (can't use user core layer)
|
||||
$POST{'core'} ||= $POST{'core_hidden'};
|
||||
$core = defined $POST{'core'} ? $POST{'core'} : $style->{'layer'}->{'core'};
|
||||
unless ($core) { # default to highest numbered core
|
||||
map { $core = $_ if $pub->{$_}->{'type'} eq 'core' && /^\d+$/ &&
|
||||
$pub->{$_}->{'majorversion'} > $pub->{$core}->{'majorversion'} } keys %$pub;
|
||||
|
||||
# update in POST to keep things in sync
|
||||
$POST{'core'} = $core;
|
||||
}
|
||||
|
||||
# layout lid
|
||||
$layout = $POST{'action:change'} ? $eff_layer{'layout'} : $style->{'layer'}->{'layout'};
|
||||
|
||||
# if we're changing core, clear everything
|
||||
if ($POST{'core'} && $style->{'layer'}->{'core'} &&
|
||||
$POST{'core'} != $style->{'layer'}->{'core'}) {
|
||||
foreach (qw(i18nc layout theme i18n user)) {
|
||||
delete $eff_layer{$_};
|
||||
}
|
||||
undef $layout;
|
||||
}
|
||||
|
||||
# if we're changing layout, clear everything below
|
||||
if ($eff_layer{'layout'} && $style->{'layer'}->{'layout'} &&
|
||||
$eff_layer{'layout'} != $style->{'layer'}->{'layout'}) {
|
||||
foreach (qw(theme i18n user)) {
|
||||
delete $eff_layer{$_};
|
||||
}
|
||||
}
|
||||
|
||||
# set up start of output
|
||||
$title = "Edit Style";
|
||||
$body .= "<br />" . BML::ml('Backlink', { 'text' => 'Your Styles', 'link' => "styles.bml$getextra" }) . "\n";
|
||||
|
||||
### process edit actions
|
||||
|
||||
# delete
|
||||
if ($POST{'action:delete'}) {
|
||||
LJ::S2::delete_user_style($u, $id);
|
||||
undef $id; # don't show form below
|
||||
return BML::redirect("styles.bml$getextra");
|
||||
}
|
||||
|
||||
# save changes
|
||||
if ($POST{'action:change'} || $POST{'action:savechanges'}) {
|
||||
|
||||
# are they renaming their style?
|
||||
if ($POST{'stylename'} && $style->{'name'} &&
|
||||
$POST{'stylename'} ne $style->{'name'}) {
|
||||
|
||||
# update db
|
||||
my $styleid = $style->{'styleid'};
|
||||
$dbh->do("UPDATE s2styles SET name=? WHERE styleid=? AND userid=?",
|
||||
undef, $POST{'stylename'}, $styleid, $u->{'userid'});
|
||||
LJ::MemCache::delete([$styleid, "s2s:$styleid"]);
|
||||
|
||||
# update style object
|
||||
$style->{'name'} = $POST{'stylename'};
|
||||
}
|
||||
|
||||
# load layer info of any "other" layers
|
||||
my %other_info = ();
|
||||
if (@other_layers) {
|
||||
LJ::S2::load_layer_info(\%other_info, \@other_layers);
|
||||
foreach (@other_layers) {
|
||||
return $err->("Layer not found: $_") unless exists $other_info{$_};
|
||||
return $err->("Layer not public: $_") unless $other_info{$_}->{'is_public'};
|
||||
}
|
||||
}
|
||||
|
||||
# error check layer modifications
|
||||
my $get_layername = sub {
|
||||
my $lid = shift;
|
||||
|
||||
my $name;
|
||||
$name = $pub->{$lid}->{'name'} if $pub->{$lid};
|
||||
$name ||= $ulay->{$lid}->{'name'} if $ulay->{$lid};
|
||||
$name ||= "#$lid";
|
||||
|
||||
return $name;
|
||||
};
|
||||
|
||||
# check layer hierarchy
|
||||
my $error_check = sub {
|
||||
my ($type, $parentid) = @_;
|
||||
|
||||
my $lid = $eff_layer{$type};
|
||||
next if ! $lid;
|
||||
|
||||
my $layer = $ulay->{$lid} || $pub->{$lid} || LJ::S2::load_layer($lid);
|
||||
my $parentname = $get_layername->($parentid);
|
||||
my $layername = $get_layername->($lid);
|
||||
|
||||
# is valid layer type?
|
||||
return "Invalid layer type: <i>$layername</i> is not a $type layer"
|
||||
if $layer->{'type'} ne $type;
|
||||
|
||||
# is a child?
|
||||
return "Layer hierarchy mismatch: <i>$layername</i> is not a child $type layer of <i>$parentname</i>"
|
||||
unless $layer->{'b2lid'} == $parentid;
|
||||
|
||||
return undef;
|
||||
};
|
||||
|
||||
# check child layers of core
|
||||
foreach my $type (qw(i18nc layout)) {
|
||||
my $errmsg = $error_check->($type, $core);
|
||||
return $err->($errmsg) if $errmsg;
|
||||
}
|
||||
|
||||
# don't check sub-layout layers if there's no layout
|
||||
if ($layout) {
|
||||
|
||||
# check child layers of selected layout
|
||||
foreach my $type (qw(theme i18n user)) {
|
||||
my $errmsg = $error_check->($type, $layout);
|
||||
return $err->($errmsg) if $errmsg;
|
||||
}
|
||||
}
|
||||
|
||||
# save in database
|
||||
my @layers = ( 'core' => $core );
|
||||
push @layers, map { $_, $eff_layer{$_} } qw(i18nc layout i18n theme user);
|
||||
LJ::S2::set_style_layers($u, $style->{'styleid'}, @layers);
|
||||
|
||||
# redirect if they clicked the bottom button
|
||||
return BML::redirect("styles.bml$getextra") if $POST{'action:savechanges'};
|
||||
}
|
||||
|
||||
# no style id, process actions for non-edit mode
|
||||
# and load in data necessary for style list
|
||||
} else {
|
||||
|
||||
# load user styles
|
||||
my $ustyle = LJ::S2::load_user_styles($u);
|
||||
|
||||
# process create action
|
||||
if ($POST{'action:create'} && $POST{'stylename'}) {
|
||||
|
||||
return $err->('You have reached your maximum number of styles.')
|
||||
if scalar(keys %$ustyle) >= LJ::get_cap($u, 's2stylesmax');
|
||||
|
||||
my $styleid = LJ::S2::create_style($u, $POST{'stylename'});
|
||||
return $err->('Style not created: Database error') unless $styleid;
|
||||
|
||||
return BML::redirect("styles.bml?id=$styleid$getextra_amp");
|
||||
}
|
||||
|
||||
# load style currently in use
|
||||
LJ::load_user_props($u, 's2_style');
|
||||
|
||||
# set up page header
|
||||
$title = "Your Styles";
|
||||
|
||||
$authasform->();
|
||||
|
||||
$body .= "<div><?h1 Your Styles h1?></div>\n";
|
||||
|
||||
# show style listing
|
||||
$body .= "<table style='margin-left: 40px'>\n";
|
||||
if (%$ustyle) {
|
||||
my $journalbase = LJ::journal_base($u);
|
||||
foreach my $styleid (sort { $ustyle->{$a} cmp $ustyle->{$b} || $a <=> $b} keys %$ustyle) {
|
||||
$body .= "<tr><td><form style='display:inline' method='post' action='styles.bml?id=$styleid$getextra_amp'>";
|
||||
my @b = $styleid == $u->{'s2_style'} ? "<b>" : "</b>";
|
||||
$body .= $b[0] . LJ::ehtml($ustyle->{$styleid});
|
||||
$body .= " (<a href='$journalbase/?s2id=$styleid'>\#$styleid</a>)$b[1] ";
|
||||
$body .= "</td><td>";
|
||||
$body .= LJ::html_submit('action:edit', 'Edit') . " ";
|
||||
$body .= LJ::html_submit('action:delete', 'Delete',
|
||||
{ 'onclick' => "return confirm('Are you sure you want to delete style \#$styleid?')" }) . " ";
|
||||
$body .= LJ::html_submit('action:usestyle', 'Use', { 'disabled' => $styleid == $u->{'s2_style'} }),
|
||||
$body .= "</form></td></tr>\n";
|
||||
}
|
||||
} else {
|
||||
$body .= "<tr><td><i>none</i></td></tr>\n";
|
||||
}
|
||||
$body .= "</table>\n";
|
||||
}
|
||||
|
||||
|
||||
### show create / edit form
|
||||
|
||||
my $extra = $id ? "?id=$id" : '';
|
||||
$extra .= $extra ? $getextra_amp : $getextra;
|
||||
$body .= "<form name='styleForm' method='post' action='styles.bml$extra'>";
|
||||
|
||||
# create a new style, or change the name of the style currently being edited
|
||||
# note: this little bit of code appears whether there is an id passed or not.
|
||||
# the textbox just has a different purpose depending on the context.
|
||||
$body .= "<?h1 " . ($id ? "Style Options" : "Create Style") . " h1?>\n";
|
||||
$body .= "<table style='margin-bottom: 10px'>\n";
|
||||
$body .= "<tr><td>Name: </td><td>";
|
||||
$body .= LJ::html_text({ 'name' => 'stylename', 'size' => '30', 'maxlength' => '255',
|
||||
'value' => defined $POST{'stylename'} ? $POST{'stylename'} : $style->{'name'} });
|
||||
$body .= " " . LJ::html_submit('action:create', 'Create') unless $id;
|
||||
$body .= "</td></tr>\n";
|
||||
$body .= "</table>\n";
|
||||
|
||||
# if no id to edit, we're finished
|
||||
$body .= "</form>\n", return unless $id;
|
||||
|
||||
# from here on we have $pub, $ulay, and $style filled in
|
||||
|
||||
# sub to take a layer type, core, and parent layout
|
||||
# and return a list of options to feed to LJ::html_select()
|
||||
my $layerselect = sub {
|
||||
my ($type, $b2lid) = @_;
|
||||
|
||||
my @opts = ();
|
||||
|
||||
# returns html_select to caller
|
||||
my $html_select = sub {
|
||||
my $dis = scalar(@opts) > 2 ? 0 : 1;
|
||||
|
||||
my $lid = $POST{'action:change'} ? $POST{$type} : $style->{'layer'}->{$type};
|
||||
$lid = $POST{"other_$type"} if $lid eq "_other";
|
||||
my $sel = ($lid && ! $pub->{$lid} && ! $ulay->{$lid}) ? "_other" : $lid;
|
||||
return [ LJ::html_select({ 'name' => $type, 'id' => "select_$type",
|
||||
'onChange' => "showOther('$type')",
|
||||
'selected' => $sel,
|
||||
'disabled' => $dis }, @opts), { 'disabled' => $dis, } ];
|
||||
};
|
||||
|
||||
# greps, and sorts a list
|
||||
my $greplist = sub {
|
||||
my $ref = shift;
|
||||
return sort { $ref->{$a}->{'name'} cmp $ref->{$b}->{'name'} || $a <=> $b}
|
||||
grep { $ref->{$_}->{'type'} eq $type && $ref->{$_}->{'b2lid'} == $b2lid && /^\d+$/}
|
||||
keys %$ref;
|
||||
};
|
||||
|
||||
# public layers
|
||||
my $name = $type eq 'core' ? 'majorversion' : 'name';
|
||||
push @opts, map { $_, $pub->{$_}->{$name} } $greplist->($pub);
|
||||
|
||||
# no user core layers
|
||||
return $html_select->() if $type eq 'core';
|
||||
|
||||
# user layers
|
||||
push @opts, ('', '---');
|
||||
my $startsize = scalar(@opts);
|
||||
push @opts, map { $_, "$ulay->{$_}->{'name'} (\#$_)" } $greplist->($ulay);
|
||||
|
||||
# if we didn't push anything above, remove dividing line
|
||||
pop @opts, pop @opts unless scalar(@opts) > $startsize;
|
||||
|
||||
# add option for other layerids
|
||||
push @opts, ('_other', 'Other ...');
|
||||
|
||||
# add blank option to beginning of list
|
||||
unshift @opts, ('', @opts ? '' : ' ');
|
||||
|
||||
return $html_select->();
|
||||
};
|
||||
|
||||
my $layerother = sub {
|
||||
my $name = shift;
|
||||
|
||||
my $olid = $POST{'action:change'} ? $POST{"other_$name"} : $style->{'layer'}->{$name};
|
||||
my $disp = 'none';
|
||||
my $val;
|
||||
if ($olid && ! $pub->{$olid} && ! $ulay->{$olid}) {
|
||||
$disp = 'inline';
|
||||
$val = $olid;
|
||||
}
|
||||
|
||||
return "<div id='layer_$name' style='margin-left: 5px; display: $disp;'>Layerid: " .
|
||||
LJ::html_text({ 'name' => "other_$name", 'id' => "other_$name",
|
||||
'size' => 6, 'value' => $val }) .
|
||||
"</div>";
|
||||
};
|
||||
|
||||
### core version
|
||||
|
||||
$body .= "<?h1 Style Layers h1?>\n";
|
||||
$body .= "<table>\n";
|
||||
$body .= "<tr><td>Core Version: </td><td>";
|
||||
my $coresel = $layerselect->('core', 0);
|
||||
$body .= $coresel->[0];
|
||||
$body .= LJ::html_hidden('core_hidden', $core);
|
||||
my $dis = $coresel->[1]->{'disabled'} ? { 'disabled' => 'disabled' } : undef;
|
||||
$body .= " " . LJ::html_submit('action:change', 'Change', $dis) . "</td></tr>\n";
|
||||
$body .= "</table>\n";
|
||||
|
||||
### i18nc / layout
|
||||
|
||||
$body .= "<table style='margin: 10px 0 0 40px'>\n";
|
||||
|
||||
# i18nc
|
||||
$body .= "<tr><td>Language (i18nc): </td><td>";
|
||||
$body .= $layerselect->('i18nc', $core)->[0];
|
||||
$body .= $layerother->('i18nc');
|
||||
$body .= "</td></tr>\n";
|
||||
|
||||
# layout
|
||||
$body .= "<tr><td>Layout: </td><td>";
|
||||
my $layoutsel = $layerselect->('layout', $core);
|
||||
$body .= $layoutsel->[0];
|
||||
$body .= $layerother->('layout');
|
||||
my $dis = $layoutsel->[1]->{'disabled'} ? { 'disabled' => 'disabled' } : undef;
|
||||
$body .= " " . LJ::html_submit("action:change", "Change", $dis) . " </td></tr>\n";
|
||||
$body .= "</table>\n";
|
||||
|
||||
# do we need to show the rest of the form?
|
||||
$body .= "</form>\n", return unless $layout;
|
||||
|
||||
### theme / i18n / user
|
||||
|
||||
# theme
|
||||
$body .= "<table style='margin: 10px 0 0 80px'>\n";
|
||||
$body .= "<tr><td>Language (i18n): </td><td>";
|
||||
$body .= $layerselect->('i18n', $layout)->[0];
|
||||
$body .= $layerother->('i18n') . "</td></tr>\n";
|
||||
$body .= "<tr><td>Theme: </td><td>";
|
||||
$body .= $layerselect->('theme', $layout)->[0];
|
||||
$body .= $layerother->('theme') . "</td></tr>\n";
|
||||
$body .= "<tr><td>User: </td><td>";
|
||||
$body .= $layerselect->('user', $layout)->[0];
|
||||
$body .= $layerother->('user') . "</td></tr>\n";
|
||||
$body .= "<tr><td> </td><td>";
|
||||
$body .= LJ::html_submit('action:savechanges', 'Save Changes') . "</td></tr>\n";
|
||||
$body .= "</table>\n";
|
||||
|
||||
# end edit form
|
||||
$body .= "</form>\n";
|
||||
|
||||
return;
|
||||
}
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
head<=
|
||||
<script language="JavaScript">
|
||||
function showOther (name) {
|
||||
if (! document.getElementById) return false;
|
||||
var box = document.getElementById("other_" + name);
|
||||
var list = document.getElementById("select_" + name);
|
||||
var div = document.getElementById("layer_" + name);
|
||||
if (div && box) {
|
||||
div.style.display =
|
||||
(list.value == "_other" && box.value != '' || list.value == "_other")
|
||||
? "inline" : "none";
|
||||
}
|
||||
return false;
|
||||
}
|
||||
function pageload () {
|
||||
if (!document.getElementById) return false;
|
||||
|
||||
var layers = new Array('i18nc', 'layout', 'i18n', 'theme', 'user');
|
||||
for (var i=0; i<layers.length; i++) {
|
||||
showOther(layers[i]);
|
||||
}
|
||||
|
||||
return false;
|
||||
}
|
||||
</script>
|
||||
<=head
|
||||
body=><?_code return $body; _code?>
|
||||
bodyopts=>onLoad="pageload();"
|
||||
page?>
|
||||
|
||||
165
local/htdocs/delcomment.bml
Executable file
165
local/htdocs/delcomment.bml
Executable file
@@ -0,0 +1,165 @@
|
||||
<?_info
|
||||
nocache=>1
|
||||
_info?><?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET %POST);
|
||||
use vars qw($body);
|
||||
|
||||
my $jsmode = $GET{mode} eq "js";
|
||||
$body = "";
|
||||
|
||||
my $error = sub {
|
||||
if ($jsmode) {
|
||||
BML::finish();
|
||||
return "alert('" . LJ::ejs($_[0]) . "'); 0;";
|
||||
}
|
||||
$body = "<?h1 $ML{'Error'} h1?><?p $_[0] p?>";
|
||||
return;
|
||||
};
|
||||
my $bad_input = sub {
|
||||
return $error->("Bad input: $_[0]") if $jsmode;
|
||||
$body = LJ::bad_input($_[0]);
|
||||
return;
|
||||
};
|
||||
|
||||
LJ::set_active_crumb('delcomment');
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return $bad_input->($ML{'error.noremote'})
|
||||
unless $remote;
|
||||
|
||||
return $error->("Missing parameters.") unless $GET{'journal'} ne "" && $GET{'id'};
|
||||
|
||||
# $u is user object of journal that owns the talkpost
|
||||
my $u = LJ::load_user($GET{'journal'});
|
||||
return $bad_input->($ML{'error.nojournal'})
|
||||
unless $u;
|
||||
|
||||
# can't delete if you're suspended
|
||||
return $bad_input->($ML{'.error.suspended'})
|
||||
if $remote->{statusvis} eq 'S';
|
||||
|
||||
return $error->($LJ::MSG_READONLY_USER) if LJ::get_cap($u, "readonly");
|
||||
|
||||
my $dbcr = LJ::get_cluster_def_reader($u);
|
||||
return $error->($ML{'error.nodb'})
|
||||
unless $dbcr;
|
||||
|
||||
# $tp is a hashref of info about this individual talkpost row
|
||||
my $tpid = $GET{'id'} >> 8;
|
||||
my $tp = $dbcr->selectrow_hashref("SELECT jtalkid AS 'talkid', nodetype, state, " .
|
||||
"nodeid AS 'itemid', parenttalkid, journalid, posterid " .
|
||||
"FROM talk2 ".
|
||||
"WHERE journalid=? AND jtalkid=?",
|
||||
undef, $u->{'userid'}, $tpid);
|
||||
|
||||
return $bad_input->($ML{'.error.nocomment'})
|
||||
unless $tp;
|
||||
|
||||
return $bad_input->($ML{'.error.invalidtype'})
|
||||
unless $tp->{'nodetype'} eq 'L';
|
||||
|
||||
return $bad_input->($ML{'.error.alreadydeleted'})
|
||||
if $tp->{'state'} eq "D";
|
||||
|
||||
# get username of poster
|
||||
$tp->{'userpost'} = LJ::get_username($tp->{'posterid'});
|
||||
|
||||
# userid of user who posted journal entry
|
||||
my $jposterid = $dbcr->selectrow_array("SELECT posterid FROM log2 WHERE " .
|
||||
"journalid=? AND jitemid=?",
|
||||
undef, $u->{'userid'}, $tp->{'itemid'});
|
||||
my $jposter = LJ::load_userid($jposterid);
|
||||
|
||||
# can $remote delete this comment?
|
||||
unless (LJ::Talk::can_delete($remote, $u, $jposter, $tp->{'userpost'})) {
|
||||
my $err = $u->{'journaltype'} eq 'C' ? $ML{'.error.cantdelete.comm'} : $ML{'.error.cantdelete'};
|
||||
return $error->($err);
|
||||
}
|
||||
|
||||
my $can_manage = LJ::can_manage($remote, $u);
|
||||
|
||||
# can ban if can manage and the comment is by someone else and not anon
|
||||
my $can_ban = $can_manage && $tp->{'posterid'}
|
||||
&& $remote && $remote->{'userid'} != $tp->{'posterid'};
|
||||
my $can_delthread = $can_manage || $jposterid == $remote->{userid};
|
||||
|
||||
### perform actions
|
||||
if (LJ::did_post() && $POST{'confirm'}) {
|
||||
# mark this as spam?
|
||||
LJ::Talk::mark_comment_as_spam($u, $tp->{talkid})
|
||||
if $POST{spam};
|
||||
|
||||
# delete entire thread? or just the one comment?
|
||||
if ($POST{delthread} && $can_delthread) {
|
||||
# delete entire thread ...
|
||||
LJ::Talk::delete_thread($u, $tp->{'itemid'}, $tpid);
|
||||
} else {
|
||||
# delete single comment...
|
||||
LJ::Talk::delete_comments($u, "L", $tp->{'itemid'}, [$tpid]);
|
||||
}
|
||||
|
||||
# ban the user, if selected
|
||||
my $msg;
|
||||
if ($POST{'ban'} && $can_ban) {
|
||||
LJ::set_rel($u->{'userid'}, $tp->{'posterid'}, 'B');
|
||||
$msg = BML::ml('.success.andban', { 'user' => LJ::ljuser($tp->{'userpost'}) });
|
||||
}
|
||||
$msg ||= $ML{'.success.noban'};
|
||||
$msg .= "<?p $ML{'.success.spam'} p?>" if $POST{spam};
|
||||
|
||||
if ($jsmode) {
|
||||
BML::finish();
|
||||
return "1;";
|
||||
} else {
|
||||
$body = "<?h1 $ML{'.success.head'} h1?><?p $msg p?>";
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
### show confirmation form
|
||||
|
||||
$body .= "<?h1 $ML{'.confirm.head'} h1?>";
|
||||
$body .= "<?p $ML{'.confirm.body'} p?>";
|
||||
$body .= "<form method='post' action='delcomment.bml?";
|
||||
$body .= "journal=$u->{'user'}&id=$GET{'id'}'>\n";
|
||||
$body .= "<?standout ";
|
||||
|
||||
$body .= "<div align='center' style='margin: 8px'>" . LJ::html_submit('confirm', $ML{'.confirm.submit'}) . "</div>\n";
|
||||
|
||||
if ($can_ban) {
|
||||
$body .= "<div>" . LJ::html_check({ 'type' => 'check', 'name' => 'ban', 'id' => 'ban' });
|
||||
$body .= "<label for='ban'>";
|
||||
$body .= BML::ml('.confirm.banuser', { 'user' => LJ::ljuser($tp->{'userpost'}) });
|
||||
$body .= "</label></div>";
|
||||
}
|
||||
|
||||
if ($tp->{'posterid'} != $remote->{'userid'}) { # Despite the idea of natural selection, don't let users report their own comments as spam
|
||||
$body .= "<div>" . LJ::html_check({name => 'spam', id => 'spam'});
|
||||
$body .= "<label for='spam'>$ML{'.confirm.spam'}</label></div>";
|
||||
}
|
||||
|
||||
if ($can_delthread) {
|
||||
$body .= "<div>" . LJ::html_check({name => 'delthread', id => 'delthread'});
|
||||
$body .= "<label for='delthread'>$ML{'.confirm.delthread'}</label></div>";
|
||||
}
|
||||
|
||||
$body .= " standout?>";
|
||||
|
||||
if ($can_manage) {
|
||||
my $msg = BML::ml('.changeoptions', { 'link' =>
|
||||
"<a href='/editinfo.bml?authas=$u->{'user'}'>$ML{'/editinfo.bml.title'}</a>" });
|
||||
$body .= "<?p $msg p?>";
|
||||
}
|
||||
|
||||
$body .= "</form>\n";
|
||||
return;
|
||||
}
|
||||
_code?><?page
|
||||
title=><?_ml .title _ml?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?><?_c <LJDEP>
|
||||
link: htdocs/editinfo.bml
|
||||
post: htdocs/delcomment.bml
|
||||
</LJDEP> _c?>
|
||||
7
local/htdocs/developer/index.html
Executable file
7
local/htdocs/developer/index.html
Executable file
@@ -0,0 +1,7 @@
|
||||
<title>LJR Developer Area</title>
|
||||
<META content="text/html; charset=koi8-r" http-equiv=Content-Type>
|
||||
|
||||
<h2>Under construction.<h2>
|
||||
|
||||
<p>If you want to master a tool, you first have to master the use of
|
||||
that tool.
|
||||
380
local/htdocs/directory.bml
Executable file
380
local/htdocs/directory.bml
Executable file
@@ -0,0 +1,380 @@
|
||||
<?_code $head = ""; _code?><?page
|
||||
title=>Search Results
|
||||
body<=
|
||||
|
||||
<?_code
|
||||
|
||||
return LJ::server_down_html() if ($LJ::SERVER_DOWN);
|
||||
|
||||
LJ::set_active_crumb('searchregion');
|
||||
|
||||
my @errors = ();
|
||||
my @filters = LJ::Dir::validate(\%FORM, \@errors);
|
||||
return LJ::bad_input(@errors) if @errors;
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
|
||||
# the common case (small installations), people want the directory
|
||||
# to just work. so we'll support that by default. but on big sites,
|
||||
# you don't want the directory ever getting near the other databases,
|
||||
# so we provide a flag to make sure the code can't.
|
||||
my @extraroles = ("slave", "master");
|
||||
if ($LJ::DIRECTORY_SEPARATE) { @extraroles = (); }
|
||||
|
||||
my $dbdir = LJ::get_dbh("directory", @extraroles);
|
||||
return "Directory database not available." unless $dbdir;
|
||||
my @matches;
|
||||
my %info;
|
||||
my $ret = "";
|
||||
|
||||
if (BML::get_query_string() eq "")
|
||||
{
|
||||
LJ::load_codes({ state => \%state, country => \%country });
|
||||
$ret = "";
|
||||
$ret .= "<?h1 $ML{'.browse.usa.title'} h1?><?p $ML{'.browse.usa.desc'} p?>\n";
|
||||
$ret .= "<form action='get' name=\"stateForm\"><p align='center'>";
|
||||
$ret .= "<script language=\"JavaScript\" type='text/javascript'><!--\n document.write('<input name=\"s\" type=\"text\" size=\"30\"><br />'); \n// --></script>\n";
|
||||
|
||||
$ret .= "<script language=\"JavaScript\" type='text/javascript'><!--\nfunction updateStatus (text) { self.status = text; document.stateForm.s.value=text; return true; } \n// --></script>\n";
|
||||
|
||||
$ret .= "<img alt='US Map' src=\"$LJ::IMGPREFIX/us_map.gif\" width='489' height='315' border='0' usemap=\"#state_test\" ismap='ismap' /></p></form><map name='state_test' id='state_test'>\n";
|
||||
|
||||
$sth = $dbr->prepare("SELECT statcat, statkey, statval FROM stats WHERE statcat IN ('country', 'stateus')");
|
||||
$sth->execute;
|
||||
while ($_ = $sth->fetchrow_hashref) {
|
||||
$count{$_->{'statcat'}}->{$_->{'statkey'}} = $_->{'statval'};
|
||||
}
|
||||
|
||||
my @shapes = (
|
||||
"1,235,1,309,108,309,108,235,18,235,1,235", "AK",
|
||||
"328,196,328,236,355,235,345,195,328,196,328,196", "AL",
|
||||
"267,182,272,215,294,216,293,206,300,182,267,182,267,182", "AR",
|
||||
"86,162,72,205,113,225,124,167,86,162,86,162", "AZ",
|
||||
"14,86,6,110,22,166,54,198,69,189,29,123,38,90,14,86,14,86", "CA",
|
||||
"137,122,133,160,191,169,191,128,137,122,137,122", "CO",
|
||||
"444,91,443,99,456,92,456,88,444,91,444,91", "CT",
|
||||
"445,158,460,158,460,168,445,158", "DC",
|
||||
"428,122,433,134,436,132,430,121,428,122", "DE",
|
||||
"450,126,464,135", "DE",
|
||||
"335,240,335,244,371,242,391,259,410,293,414,279,390,238,335,240,335,240", "FL",
|
||||
"352,194,366,234,388,233,389,216,364,192,352,194,352,194", "GA",
|
||||
"119,269,185,312", "HI",
|
||||
"248,101,254,126,289,126,286,97,248,101,248,101", "IA",
|
||||
"86,24,73,90,114,99,118,76,100,72,86,24,86,24", "ID",
|
||||
"302,111,293,135,313,162,321,147,316,111,302,111,302,111", "IL",
|
||||
"326,119,328,154,344,143,343,114,326,119,326,119", "IN",
|
||||
"199,140,196,167,257,170,254,141,199,140,199,140", "KS",
|
||||
"325,172,324,161,341,160,348,148,366,149,367,164,325,172,325,172", "KY",
|
||||
"274,224,277,255,307,254,307,244,290,244,291,221,274,224,274,224", "LA",
|
||||
"471,79,488,88", "MA",
|
||||
"442,82,442,89,458,84,464,89,466,87,457,79,442,82,442,82", "MA",
|
||||
"465,142,483,153", "MD",
|
||||
"397,128,426,122,432,135,437,136,431,142,419,138,420,128,411,128,409,126,397,129,397,128", "MD",
|
||||
"462,27,457,52,461,64,476,38,469,25,462,27,462,27", "ME",
|
||||
"309,56,361,61,359,107,331,110,309,56,309,56", "MI",
|
||||
"243,36,250,92,277,92,268,65,283,46,243,36,243,36", "MN",
|
||||
"260,134,267,173,308,173,283,133,260,134,260,134", "MO",
|
||||
"322,196,321,240,299,237,301,204,322,196,322,196", "MS",
|
||||
"96,22,111,64,176,73,180,33,96,22,96,22", "MT",
|
||||
"388,171,374,181,415,186,423,166,388,171,388,171", "NC",
|
||||
"189,33,186,59,240,63,236,36,189,33,189,33", "ND",
|
||||
"184,104,182,119,200,121,200,134,248,135,237,108,184,104,184,104", "NE",
|
||||
"453,51,459,74,449,79,450,61,452,60,452,51,453,51,453,51", "NH",
|
||||
"435,27,452,36", "NH",
|
||||
"432,102,431,109,436,114,431,121,437,125,441,111,437,111,438,103,432,102,432,102", "NJ",
|
||||
"132,170,125,221,176,227,180,174,132,170,132,170", "NM",
|
||||
"45,93,37,122,72,173,82,102,45,93,45,93", "NV",
|
||||
"433,59,439,77,440,99,430,98,429,91,391,100,401,87,417,78,419,63,433,59", "NY",
|
||||
"450,99,440,106,445,109,455,100,450,99", "NY",
|
||||
"379,112,350,116,352,139,368,143,381,127,379,112,379,112", "OH",
|
||||
"186,172,186,175,212,177,214,201,259,207,259,174,186,172,186,172", "OK",
|
||||
"27,42,13,75,64,91,72,51,27,42,27,42", "OR",
|
||||
"386,106,388,125,428,117,425,99,386,106,386,106", "PA",
|
||||
"421,229,485,260", "PR",
|
||||
"472,100,482,110", "RI",
|
||||
"458,86,457,94,461,89,458,86", "RI",
|
||||
"375,191,395,210,410,193,375,191,375,191", "SC",
|
||||
"187,69,183,97,240,101,241,71,187,69,187,69", "SD",
|
||||
"315,180,311,190,355,188,372,172,315,180,315,180", "TN",
|
||||
"188,180,183,235,151,230,174,258,184,250,202,254,223,292,242,263,266,252,266,216,204,205,207,181,188,180,188,180", "TX",
|
||||
"97,103,86,153,126,160,131,120,112,119,114,106,97,103,97,103", "UT",
|
||||
"411,135,383,163,425,158,411,135,411,135", "VA",
|
||||
"454,272,481,307", "VI",
|
||||
"416,34,430,43", "VT",
|
||||
"437,58,442,80,446,79,447,54,437,58,437,58", "VT",
|
||||
"41,6,82,17,75,45,34,37,41,6,41,6", "WA",
|
||||
"282,62,283,81,293,87,297,103,313,102,308,66,282,62,282,62", "WI",
|
||||
"385,133,374,148,383,156,401,133,385,133,385,133", "WV",
|
||||
"126,73,122,111,174,120,178,80,126,73,126,73", "WY",
|
||||
);
|
||||
|
||||
while (my ($coords, $state) = splice(@shapes, 0, 2))
|
||||
{
|
||||
next unless ($count{'stateus'}->{$state});
|
||||
my $shape = "poly";
|
||||
if ($coords =~ /^[^,]+,[^,]+,[^,]+,[^,]+$/) { $shape = "RECTANGLE"; }
|
||||
$ret .= "<area shape='$shape' alt='$state' coords=\"$coords\" href=\"/directory.bml?loc_cn=US&loc_st=$state&opt_sort=ut\" onmouseover=\"updateStatus('";
|
||||
$ret .= BML::eall($state{$state});
|
||||
$ret .= " - ";
|
||||
$ret .= ($count{'stateus'}->{$state}+0);
|
||||
$s = $count{'stateus'}->{$state} != 1 ? "s" : "";
|
||||
$ret .= " Journal$s'); return true;\" onmouseout=\"updateStatus(''); return true;\" />\n";
|
||||
}
|
||||
|
||||
$ret .= "</map>\n";
|
||||
|
||||
# by country
|
||||
$ret .= "<?h1 $ML{'.browse.country.title'} h1?><?p $ML{'.browse.country.desc'} p?>";
|
||||
$ret .= "<table style='margin-left: 20px' cellpadding='5'><tr valign='top'><td align='left'><ul>";
|
||||
my $total = scalar(keys %{$count{'country'}});
|
||||
my $count = 0;
|
||||
my $col = 0;
|
||||
foreach (sort { $country{$a} cmp $country{$b} } keys %{$count{'country'}})
|
||||
{
|
||||
$count++;
|
||||
$ret .= "<li><a href=\"/directory.bml?loc_cn=$_&opt_sort=ut\">$country{$_}</a> <i>($count{'country'}->{$_})</i></li>\n";
|
||||
if ($col==0 && $count > ($total/2)) { $ret .= "</ul></td><td align='left'><ul>"; $col = 1; }
|
||||
}
|
||||
$ret .= "</ul></td></tr></table>\n";
|
||||
return $ret;
|
||||
}
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
# unless (LJ::check_priv($remote, "betatest", "directory") ||
|
||||
# LJ::get_cap($remote, "directory") ||
|
||||
# (@filters == 1 && $filters[0] eq "int" && $GET{'opt_format'} eq "simple"))
|
||||
#{
|
||||
# return $ML{'.error.accounttype'};
|
||||
#}
|
||||
|
||||
unless (LJ::Dir::do_search($dbr, $dbdir, \%FORM, \@matches, \%info)) {
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'Error'}: $info{'errmsg'} p?>";
|
||||
}
|
||||
|
||||
# opt_format and opt_sort might've been modified by do_search,
|
||||
# filling in appropriate defaults based on other parameters
|
||||
my $opt_format = $FORM{'opt_format'};
|
||||
my $opt_sort = $FORM{'opt_sort'};
|
||||
|
||||
$info{'allwhat'} ||= "users";
|
||||
|
||||
if ($info{'searching'}) {
|
||||
my ($uri, $args) = (BML::get_uri(), BML::get_query_string());
|
||||
$uri .= '?' . $args if $args;
|
||||
$head .= "<meta http-equiv='Refresh' content='3;URL=" . LJ::ehtml($LJ::SITEROOT . $uri) . "' />\n";
|
||||
return "<center><b>$ML{'.search.title'}<img src='$LJ::IMGPREFIX/searchingdots.gif' alt='...' width='18' height='12' /></b><p>$ML{'.search.monkey'}</p></center>";
|
||||
}
|
||||
|
||||
if ($POST{'com_do'} || $GET{'com_do'}) {
|
||||
$ret .= "<a href=\"/community/search.bml\"><< $ML{'.search.new'}</a><p>\n";
|
||||
} else {
|
||||
$ret .= "<a href=\"/directorysearch.bml\"><< $ML{'.search.new'}</a><p>\n";
|
||||
}
|
||||
unless (@{$info{'english'}}) {
|
||||
push @{$info{'english'}}, "wish to be listed in the public directory";
|
||||
}
|
||||
|
||||
$ret .= "Below are all $info{'allwhat'} that ";
|
||||
|
||||
my $count_preds = @{$info{'english'}};
|
||||
|
||||
### remove consecutive "are"s
|
||||
my $last_are = 0;
|
||||
foreach (@{$info{'english'}}) {
|
||||
if (/^are /) {
|
||||
if ($last_are) {
|
||||
s/^are //;
|
||||
}
|
||||
$last_are = 1;
|
||||
} else {
|
||||
$last_are = 0;
|
||||
}
|
||||
}
|
||||
my $last = pop @{$info{'english'}};
|
||||
if (@{$info{'english'}}) {
|
||||
$ret .= join(", ", map { LJ::ehtml($_) } @{$info{'english'}}) . ", and ";
|
||||
}
|
||||
$ret .= LJ::ehtml($last) . ".\n";
|
||||
|
||||
if ($info{'overflow'}) {
|
||||
$ret .= BML::ml(".search.overflow", {'count' => $info{'count'}});
|
||||
}
|
||||
|
||||
if ($count_preds == 1 && $GET{'int_like'}) {
|
||||
my $intid = $dbr->selectrow_array("SELECT intid FROM interests WHERE interest=?",
|
||||
undef, $GET{'int_like'});
|
||||
LJ::run_hooks("interests_bml", {
|
||||
'intid' => $intid,
|
||||
'int' => $interest,
|
||||
'ret' => \$ret,
|
||||
}) if $intid;
|
||||
}
|
||||
|
||||
########## make the navcrap
|
||||
my $navcrap;
|
||||
$navcrap .= "<?standout <CENTER><FONT FACE=\"Arial,Helvetica\" SIZE=-1><B>".BML::ml(".navcrap.matches", {'count' => $info{'count'}})."</B>";
|
||||
if ($info{'count'}) {
|
||||
if ($info{'pages'} > 1) {
|
||||
$navcrap .= "<BR>";
|
||||
$navcrap .= BML::ml(".navcrap.xofy", {'curpage' => $info{'page'}, 'totpages' => $info{'pages'}, 'reca' => $info{'first'}, 'recb' => $info{'last'}});
|
||||
$navcrap .= "<BR>";
|
||||
my $left = "<B><<</B>";
|
||||
if ($info{'page'} > 1) { $left = "<A HREF=\"" . BML::self_link({ 'page' => $info{'page'}-1 }) . "\">$left</A>"; }
|
||||
my $right = "<B>>></B>";
|
||||
if ($info{'page'} < $info{'pages'}) { $right = "<A HREF=\"" . BML::self_link({ 'page' => $info{'page'}+1 }) . "\">$right</A>"; }
|
||||
$navcrap .= $left . " ";
|
||||
for (my $i=1; $i<=$info{'pages'}; $i++) {
|
||||
my $link = "[$i]";
|
||||
if ($i != $info{'page'}) { $link = "<A HREF=\"" . BML::self_link({ 'page' => $i }) . "\">$link</A>"; }
|
||||
else { $link = "<FONT SIZE=+1><B>$link</B></FONT>"; }
|
||||
$navcrap .= "$link ";
|
||||
}
|
||||
$navcrap .= "$right";
|
||||
}
|
||||
$navcrap .= "</FONT></CENTER> standout?>\n";
|
||||
} else {
|
||||
$navcrap .= "</CENTER> standout?>\n";
|
||||
}
|
||||
####### end navcrap
|
||||
|
||||
$ret .= $navcrap . "<P>";
|
||||
|
||||
unless ($info{'count'}) { return $ret; }
|
||||
|
||||
if ($opt_sort eq "loc") {
|
||||
LJ::load_codes({ state => \%state, country => \%country });
|
||||
}
|
||||
|
||||
if ($opt_format eq "simple")
|
||||
{
|
||||
my $showloc = $GET{'opt_sort'} eq "loc" ? 1 : 0;
|
||||
my %last = ();
|
||||
$ret .= "<ul>\n";
|
||||
foreach my $rec (@matches)
|
||||
{
|
||||
if ($showloc) {
|
||||
if ($last{'country'} ne $rec->{'country'} ||
|
||||
$last{'state'} ne $rec->{'state'} ||
|
||||
$last{'city'} ne $rec->{'city'}) {
|
||||
foreach (qw(country state city)) { $last{$_} = $rec->{$_}; }
|
||||
my $country = $country{$rec->{'country'}};
|
||||
my ($state, $city);
|
||||
if ($rec->{'state'}) {
|
||||
$state = ", " . ($rec->{'country'} eq "US" ? $state{$rec->{'state'}} : $rec->{'state'});
|
||||
}
|
||||
if ($rec->{'city'}) {
|
||||
$city = ", $rec->{'city'}";
|
||||
}
|
||||
$ret .= "<?h1 $country$state$city h1?><BR>";
|
||||
}
|
||||
}
|
||||
|
||||
$ret .= "<a href=\"/userinfo.bml?user=$rec->{'user'}\">";
|
||||
if ($rec->{'journaltype'} eq "C") {
|
||||
$ret .= "<img border='0' src=\"$LJ::IMGPREFIX/community.gif\" width='16' height='16' align='absmiddle'>";
|
||||
} else {
|
||||
$ret .= "<img border='0' src=\"$LJ::IMGPREFIX/userinfo.gif\" width='17' height='17' align='absmiddle'>";
|
||||
}
|
||||
$ret .= "</a> ";
|
||||
$ret .= "<a href=\"/users/$rec->{'user'}/\">$rec->{'user'}</A> - <b>" . LJ::ehtml($rec->{'name'}) . "</b>, <font size='-1' face=\"Arial\"><i>Updated ";
|
||||
$ret .= LJ::ago_text($rec->{'secondsold'});
|
||||
$ret .= "</i></font><br />\n";
|
||||
}
|
||||
$ret .= "</ul>\n";
|
||||
}
|
||||
|
||||
if ($opt_format eq "com")
|
||||
{
|
||||
$ret .= "<TABLE CELLSPACING=3>\n";
|
||||
$ret .= "<TR><TD> </TD><TD><B>$ML{'.user'}</B></TD><TD><B>$ML{'.community'}</B></TD><TD><B>$ML{'.open'}</B></TD><TD><B>$ML{'.post'}</B></TD></TR>\n";
|
||||
foreach my $rec (@matches)
|
||||
{
|
||||
$ret .= "<TR VALIGN=TOP>";
|
||||
$ret .= "<TD NOWRAP><A HREF=\"/userinfo.bml?user=$rec->{'user'}\">";
|
||||
if ($rec->{'journaltype'} eq "C") {
|
||||
$ret .= "<IMG BORDER=0 SRC=\"$LJ::IMGPREFIX/community.gif\" WIDTH=16 HEIGHT=16 ALIGN=ABSMIDDLE>";
|
||||
} else {
|
||||
$ret .= "<IMG BORDER=0 SRC=\"$LJ::IMGPREFIX/userinfo.gif\" WIDTH=17 HEIGHT=17 ALIGN=ABSMIDDLE>";
|
||||
}
|
||||
$ret .= "</A></TD>";
|
||||
$ret .= "<TD><B><A HREF=\"/community/$rec->{'user'}/\">$rec->{'user'}</A></B></TD>";
|
||||
$ret .= "<td>" . LJ::ehtml($rec->{'name'}) . "</td>";
|
||||
|
||||
my $color;
|
||||
if ($rec->{'membership'} eq "open") { $color = "green"; } else { $color = "red"; }
|
||||
$ret .= "<TD ALIGN=CENTER><IMG SRC=\"$LJ::IMGPREFIX/dot_$color.gif\" WIDTH=14 HEIGHT=14></TD>";
|
||||
if ($rec->{'postlevel'} eq "members") { $color = "green"; } else { $color = "red"; }
|
||||
$ret .= "<TD ALIGN=CENTER><IMG SRC=\"$LJ::IMGPREFIX/dot_$color.gif\" WIDTH=14 HEIGHT=14></TD>";
|
||||
|
||||
$ret .= "</TR>";
|
||||
}
|
||||
$ret .= "</TABLE>\n";
|
||||
}
|
||||
|
||||
if ($opt_format eq "pics")
|
||||
{
|
||||
my $showloc = $GET{'opt_sort'} eq "loc" ? 1 : 0;
|
||||
my %last = ();
|
||||
|
||||
my %pic;
|
||||
my @picids = map { [$_, $_->{'defaultpicid'}] } @matches;
|
||||
LJ::load_userpics(\%pic, \@picids);
|
||||
|
||||
my $count = 0;
|
||||
my $pos = 0;
|
||||
my $more_to_show = 0;
|
||||
$ret .= "<TABLE CELLPADDING=3>\n";
|
||||
foreach my $rec (@matches)
|
||||
{
|
||||
if ($pos==5) { $ret .= "</TR>\n"; }
|
||||
$pos++; $pos %= 5;
|
||||
|
||||
if ($showloc) {
|
||||
if ($last{'country'} ne $rec->{'country'} ||
|
||||
$last{'state'} ne $rec->{'state'} ||
|
||||
$last{'city'} ne $rec->{'city'}) {
|
||||
foreach (qw(country state city)) { $last{$_} = $rec->{$_}; }
|
||||
my $country = $country{$rec->{'country'}};
|
||||
my ($state, $city);
|
||||
if ($rec->{'state'}) {
|
||||
$state = ", " . ($rec->{'country'} eq "US" ? $state{$rec->{'state'}} : $rec->{'state'});
|
||||
}
|
||||
if ($rec->{'city'}) {
|
||||
$city = ", $rec->{'city'}";
|
||||
}
|
||||
if ($pos > 1) { $ret .= "</TR>"; $pos = 1; }
|
||||
$ret .= "</TABLE>";
|
||||
$ret .= "<?h1 $country$state$city h1?><BR>";
|
||||
$ret .= "<TABLE CELLPADDING=3>\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if ($pos==1) { $ret .= "<TR ALIGN=CENTER VALIGN=BOTTOM>\n"; }
|
||||
my $picid = $rec->{'defaultpicid'};
|
||||
my $updateago = LJ::ago_text($rec->{'secondsold'});
|
||||
my $img;
|
||||
if ($picid) {
|
||||
$img = "<IMG SRC=\"$LJ::USERPIC_ROOT/$picid/$rec->{'userid'}\" ALT=\"$_->{'user'}\" WIDTH=$pic{$picid}->{'width'} HEIGHT=$pic{$picid}->{'height'} BORDER=0><BR>";
|
||||
}
|
||||
$ret .= "<TD>";
|
||||
$ret .= $img;
|
||||
$ret .= LJ::ljuser($rec->{'user'});
|
||||
$ret .= "<BR><FONT SIZE=-1><B>$Ml{'.update'} </B> $updateago</FONT></TD>\n";
|
||||
}
|
||||
$ret .= "</TR></TABLE>\n";
|
||||
}
|
||||
|
||||
if ($info{'pages'} > 1) { $ret .= $navcrap; }
|
||||
return $ret;
|
||||
|
||||
|
||||
_code?>
|
||||
|
||||
<=body
|
||||
head<=
|
||||
<meta name="robots" content="noindex,nofollow" />
|
||||
<?_code return $head; _code?>
|
||||
<=head
|
||||
page?>
|
||||
70
local/htdocs/download/index.bml
Normal file
70
local/htdocs/download/index.bml
Normal file
@@ -0,0 +1,70 @@
|
||||
<?page
|
||||
TITLE=>Клиенты для обновления дневника
|
||||
HEAD<=
|
||||
<=HEAD
|
||||
BODYOPTS<=<?_code
|
||||
# return "onLoad=\""";
|
||||
_code?>
|
||||
<=BODYOPTS
|
||||
BODY<=
|
||||
|
||||
<p>Блог на <a href="http://lj.rossia.org/">lj.rossia.org</a> можно обновлять <a href="http://lj.rossia.org/update.bml">прямо из веб-браузера</a>, но можно также использовать небольшую программу-клиент.</p>
|
||||
|
||||
<p><em>Обратите внимание, что в настройках требуется указать сервер <kbd>http://lj.rossia.org/</kbd>.</em></p>
|
||||
|
||||
<h2>*NIX</h2>
|
||||
|
||||
<ul>
|
||||
<li><a href="http://www.dropline.net/drivel/">Drivel</a>, <a href="http://logjam.danga.com/">LogJam</a> — под <a href="http://www.gtk.org/">GTK</a>.</li>
|
||||
<li><a href="http://kluje.sourceforge.net/">KLuJe</a> — для <a href="http://kde.org/">KDE</a> (в качестве сервера укажите <kbd>http://lj.rossia.org/<strong>interface/flat/</strong></kbd>).</li>
|
||||
<li><a href="http://edward.oconnor.cx/ljupdate/">ljupdate</a> — для <a href="http://www.gnu.org/software/emacs/">EMACS</a>.
|
||||
|
||||
<p>Установите файлы ljupdate, например, в <kbd>~/elisp/ljupdate</kbd>. Требуются библиотеки <kbd>http-cookies.el</kbd>, <kbd>http-get.el</kbd>, <kbd>http-post.el</kbd>; если их нет, то загрузите при помощи <kbd>make fetch</kbd> или <a href="http://savannah.nongnu.org/cgi-bin/viewcvs/http-emacs/http-emacs/">вручную из CVS</a>.</p>
|
||||
|
||||
<p>В <kbd>~/.emacs</kbd> напишите что-то вроде</p>
|
||||
|
||||
<pre>(add-to-list 'load-path "~/elisp")
|
||||
(add-to-list 'load-path "~/elisp/ljupdate")
|
||||
(require 'ljupdate)</pre>
|
||||
|
||||
<p>Настройки можно указать при помощи <kbd>M-x customize-group RET ljupdate RET</kbd>.</p>
|
||||
|
||||
<p>Далее работайте с командами <kbd>lj-...</kbd> (в частности, <kbd>lj-login</kbd>, <kbd>lj-logout</kbd>, <kbd>lj-compose</kbd>).</p>
|
||||
</li>
|
||||
</ul>
|
||||
|
||||
<h2>Windows</h2>
|
||||
|
||||
<ul>
|
||||
<li><a href="http://semagic.sourceforge.net/">Semagic</a>.</li>
|
||||
</ul>
|
||||
|
||||
<h2>Кроссплатформенные</h2>
|
||||
|
||||
<ul>
|
||||
<li><a href="http://ljcharm.sourceforge.net/">CHARM</a> — на <a href="http://python.org/">Python</a>, консольный.
|
||||
|
||||
<p>В <kbd>~/.charmrc</kbd> надо написать</p>
|
||||
|
||||
<pre>login = usr pwd
|
||||
url = http://lj.rossia.org/interface/flat</pre>
|
||||
|
||||
<p>Для редактирования текстов будет использоваться <kbd>$EDITOR</kbd>.</p>
|
||||
</li>
|
||||
|
||||
<li><a href="https://addons.mozilla.org/firefox/addon/1811">Deepest Sender</a> — расширение для <a href="http://www.mozilla.com/firefox/">Mozilla Firefox</a> (в качестве сервера укажите <kbd>http://lj.rossia.org/<strong>interface/flat/</strong></kbd>).</li>
|
||||
|
||||
<li><a href="http://umlautllama.com/projects/perl/#jlj">JLJ</a> — на <a href="http://www.perl.org/">Perl</a>, консольный.
|
||||
|
||||
<p>В <kbd>~/.livejournal.rc</kbd> надо написать</p>
|
||||
|
||||
<pre>server: lj.rossia.org
|
||||
postcgi: /interface/flat
|
||||
user: usr
|
||||
password: pwd</pre>
|
||||
</li>
|
||||
<li><a href="http://www.panteleyev.org/petrus-blogger/">Petrus Blogger</a> — на <a href="http://java.com/">Java</a>, с графическим интерфейсом.</li>
|
||||
</ul>
|
||||
|
||||
<=BODY
|
||||
page?>
|
||||
911
local/htdocs/editinfo.bml
Executable file
911
local/htdocs/editinfo.bml
Executable file
@@ -0,0 +1,911 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
body<=
|
||||
<?_code
|
||||
LJ::set_active_crumb('editinfo');
|
||||
return;
|
||||
_code?>
|
||||
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%POST %GET);
|
||||
|
||||
return LJ::server_down_html() if $LJ::SERVER_DOWN;
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return LJ::bad_input("You must be logged in to edit your info.")
|
||||
unless $remote;
|
||||
|
||||
if ($remote->underage) {
|
||||
return BML::redirect("$LJ::SITEROOT/agecheck/?s=1");
|
||||
}
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $u = LJ::get_authas_user($authas);
|
||||
return LJ::bad_input("You could not be authenticated as the specified user.")
|
||||
unless $u;
|
||||
|
||||
return $LJ::MSG_READONLY_USER if $u->readonly;
|
||||
|
||||
# extra arguments for get requests
|
||||
my $getextra = $authas ne $remote->{'user'} ? "?authas=$authas" : '';
|
||||
|
||||
### user is now authenticated ###
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
my $sth;
|
||||
|
||||
# load user props
|
||||
LJ::load_user_props($u, { use_master => 1 }, "opt_whatemailshow",
|
||||
"country", "state", "city",
|
||||
"zip", "icq", "aolim", "yahoo", "msn", "url",
|
||||
"urlname", "gender", "jabber", "opt_blockrobots",
|
||||
"opt_logcommentips",
|
||||
"howhear", "opt_bdaymail", "opt_hidefriendofs",
|
||||
"sidx_bdate", "sidx_loc", "mailencoding", "opt_nctalklinks",
|
||||
"opt_whoscreened", "journaltitle", "journalsubtitle",
|
||||
"friendspagetitle", "opt_weblogscom", "opt_stylemine",
|
||||
"opt_imagelinks", "opt_getselfemail", "external_foaf_url",
|
||||
"opt_showmutualfriends", "opt_embedplaceholders",
|
||||
);
|
||||
|
||||
# to store values before they undergo normalisation
|
||||
my %saved = ();
|
||||
$saved{'name'} = $u->{'name'};
|
||||
|
||||
# clean userprops
|
||||
foreach (values %$u) { LJ::text_out(\$_); }
|
||||
|
||||
# load and clean bio
|
||||
$u->{'bio'} = LJ::get_bio($u);
|
||||
$saved{'bio'} = $u->{'bio'};
|
||||
LJ::text_out(\$u->{'bio'}, "force");
|
||||
|
||||
# load interests
|
||||
my $uints = LJ::get_interests($u, { forceids => 1 });
|
||||
my %interests = ();
|
||||
foreach (@$uints) {
|
||||
$interests{$_->[1]} = $_->[0]; # $interests{name} = intid
|
||||
}
|
||||
|
||||
# load state and country codes
|
||||
my %countries;
|
||||
my %states;
|
||||
LJ::load_codes({ "country" => \%countries, "state" => \%states });
|
||||
|
||||
|
||||
###
|
||||
### no post, show edit form
|
||||
###
|
||||
|
||||
unless (LJ::did_post()) {
|
||||
|
||||
my $ret;
|
||||
|
||||
# user switcher
|
||||
$ret .= "<form method='get' action='editinfo.bml'>\n";
|
||||
$ret .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} });
|
||||
$ret .= "</form>\n\n";
|
||||
|
||||
$ret .= "<form method='post' action='editinfo.bml$getextra'>\n";
|
||||
$ret .= LJ::form_auth();
|
||||
|
||||
# personal information
|
||||
$ret .= "<?h1 $ML{'.persinfo.header'} h1?><?p $ML{'.persinfo.disclaimer'} p?>\n";
|
||||
|
||||
$ret .= "<table width='100%'>\n";
|
||||
|
||||
# name
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.name.title'}</td>";
|
||||
if (LJ::text_in($saved{'name'})) {
|
||||
$ret .= "<td>" . LJ::html_text({ 'name' => 'name', 'value' => $u->{'name'},
|
||||
'maxlength' => '50' }) . "</td></tr>\n";
|
||||
} else {
|
||||
$ret .= "<td>" . LJ::html_hidden('name_absent', 'yes');
|
||||
$ret .= "<?inerr $ML{'.error.invalidname'} inerr?></td></tr>\n";
|
||||
}
|
||||
|
||||
# birthday
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.bday.title'}</td><td>";
|
||||
my %bdpart;
|
||||
if ($u->{'bdate'} =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) {
|
||||
($bdpart{'year'}, $bdpart{'month'}, $bdpart{'day'}) = ($1, $2, $3);
|
||||
if ($bdpart{'year'} eq "0000") { $bdpart{'year'} = ""; }
|
||||
if ($bdpart{'day'} eq "00") { $bdpart{'day'} = ""; }
|
||||
}
|
||||
$ret .= LJ::html_select({ 'name' => 'month', 'selected' => int($bdpart{'month'}) },
|
||||
'', '', map { $_, $ML{LJ::Lang::month_long_langcode($_)} } (1..12)) . " ";
|
||||
|
||||
$ret .= LJ::html_text({ 'name' => 'day', 'value' => $bdpart{'day'}, 'size' => '3', 'maxlength' => '2' }) . " ";
|
||||
$ret .= LJ::html_text({ 'name' => 'year', 'value' => $bdpart{'year'}, 'size' => '5', 'maxlength' => '4' });
|
||||
$ret .= " ($ML{'.bday.year.opt'})";
|
||||
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# gender
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.gender.title'}</td><td>";
|
||||
$ret .= LJ::html_select({ 'name' => 'gender', 'selected' => $u->{'gender'} },
|
||||
'U' => "(Unspecified)", 'M' => "Male", 'F' => "Female" );
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# email
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.email.title'}</td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'email', 'value' => $u->{'email'}, 'size' => '40', 'maxlength' => '50' });
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# url
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.webpageurl.title'}</td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'url', 'value' => $u->{'url'}, 'size' => '40', 'maxlength' => '255' });
|
||||
$ret .= " ($ML{'.optional'})</td></tr>\n";
|
||||
|
||||
# urlname
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.webpagename.title'}</td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'urlname', 'value' => $u->{'urlname'}, 'size' => '40', 'maxlength' => '255' });
|
||||
$ret .= " ($ML{'.optional'})</td></tr>\n";
|
||||
|
||||
# chat thingies
|
||||
foreach my $p (["aolim", $ML{'.chat.aolim.title'}, 28], ["icq", $ML{'.chat.icquin.title'}, 12],
|
||||
["yahoo", $ML{'.chat.yahooid.title'}, 33], ["msn", $ML{'.chat.msnusername.title'}, 60],
|
||||
["jabber", $ML{'.chat.jabber.title'}, 60])
|
||||
{
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$p->[1]</td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => $p->[0], 'value' => $u->{$p->[0]}, 'size' => '20', 'maxlength' => $p->[2] });
|
||||
$ret .= " ($ML{'.optional'})</td></tr>\n";
|
||||
}
|
||||
|
||||
# country
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.country.title'}</td><td>";
|
||||
$ret .= LJ::html_select({ 'name' => 'country', 'selected' => $u->{'country'} },
|
||||
'', $ML{'.country.choose'},
|
||||
'US', 'United States',
|
||||
map { $_, $countries{$_} } sort { $countries{$a} cmp $countries{$b} } keys %countries );
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# city
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.city.title'}</td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'city', 'value' => $u->{'city'}, 'size' => '20', 'maxlength' => '255' });
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# state
|
||||
$ret .= "<tr valign='top'><td align='right' bgcolor='<?emcolor?>'>$ML{'.state.title'}</td><td>";
|
||||
$ret .= LJ::html_select({ 'name' => 'statedrop', 'selected' => $u->{'state'} },
|
||||
'', "($ML{'.state.us'})",
|
||||
map { $_, $states{$_} } sort { $states{$a} cmp $states{$b} } keys %states );
|
||||
|
||||
# other state?
|
||||
$ret .= "<br />$ML{'.state.other'}: ";
|
||||
$ret .= LJ::html_text({ 'name' => 'stateother', 'size' => '20', 'maxlength' => '50',
|
||||
'value' => defined $states{$u->{'state'}} ? '' : $u->{'state'} });
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# zip
|
||||
$ret .= "<tr><td align='right' bgcolor='<?emcolor?>'>$ML{'.zip.title'}</td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'zip', 'value' => $u->{'zip'}, 'size' => '6', 'maxlength' => '5' });
|
||||
$ret .= " ($ML{'.zip.usonly'})</td></tr>\n";
|
||||
|
||||
# text messaging
|
||||
if (LJ::get_cap($u, "textmessaging"))
|
||||
{
|
||||
$sth = $dbr->prepare("SELECT provider, number, security FROM txtmsg WHERE userid=?");
|
||||
$sth->execute($u->{'userid'});
|
||||
my $tminfo = $sth->fetchrow_hashref;
|
||||
foreach (values %$tminfo) { LJ::text_out(\$_); }
|
||||
|
||||
# text messaging
|
||||
$ret .= "<tr valign='top'><td align='right' bgcolor='<?emcolor?>'>";
|
||||
$ret .= LJ::help_icon('textmessage', "", " ");
|
||||
$ret .= "$ML{'.tm.title'}</td><td>\n<table>\n<tr><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'use_txtmsg', 'id' => 'use_txtmsg',
|
||||
'selected' => $u->{'txtmsg_status'} eq 'on' });
|
||||
|
||||
$ret .= "</td><td colspan='2'><b><label for='use_txtmsg'>$ML{'.tm.sec.about'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td rowspan='3'> </td><td>$ML{'.tm.sec.title'}</td><td>";
|
||||
|
||||
$ret .= LJ::html_select({ 'name' => 'txtmsg_security', 'selected' => $tminfo->{'security'} },
|
||||
"all" => BML::ml(".security.visibility.anybody"),
|
||||
"reg" => BML::ml(".security.visibility.regusers"),
|
||||
"friends" => BML::ml(".security.visibility.friends") );
|
||||
$ret .= "</td></tr>\n";
|
||||
$ret .= "<tr><td>$ML{'.tm.servprov'}</td><td>";
|
||||
{
|
||||
my @opts = ("", "");
|
||||
foreach my $p (LJ::TextMessage::providers()) {
|
||||
my $info = LJ::TextMessage::provider_info($p);
|
||||
push @opts, ($p, $info->{'name'});
|
||||
}
|
||||
$ret .= LJ::html_select({ 'name' => 'txtmsg_provider',
|
||||
'selected' => $tminfo->{'provider'}, },
|
||||
@opts);
|
||||
}
|
||||
|
||||
$ret .= " ($ML{'.tm.details'})</td></tr>\n";
|
||||
$ret .= "<tr><td>$ML{'.tm.phonenum'}</td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'txtmsg_number', 'value' => $tminfo->{'number'},
|
||||
'size' => '15', 'maxlength' => '40' });
|
||||
$ret .= "</td></tr>\n";
|
||||
$ret .= "</table>\n</td></tr>\n";
|
||||
}
|
||||
|
||||
# end personal info
|
||||
$ret .= "</table>\n\n";
|
||||
|
||||
### User bio
|
||||
$ret .= "<?h1 $ML{'.bio.header'} h1?><?p $ML{'.bio.about'} p?>";
|
||||
if (LJ::text_in($saved{'bio'})) {
|
||||
$ret .= "<div style='margin-left: 30px; margin-bottom: 20px'>";
|
||||
$ret .= LJ::html_textarea({ 'name' => 'bio', 'rows' => '10', 'cols' => '50',
|
||||
'wrap' => 'soft', 'value' => $u->{'bio'}, 'style' => "width: 90%", }) . "</div>\n";
|
||||
} else {
|
||||
$ret .= LJ::html_hidden('bio_absent', 'yes');
|
||||
$ret .= "<?p <?inerr $ML{'.error.invalidbio'} inerr?> p?>\n";
|
||||
}
|
||||
|
||||
### How heard Settings
|
||||
unless ($u->{'howhear'}) {
|
||||
$ret .= "<?h1 $ML{'.howhear.header'} h1?>\n";
|
||||
$ret .= "<?p " . BML::ml(".howhear.about", { 'sitename' => $LJ::SITENAME }) . " p?>\n";
|
||||
$ret .= "<div style='margin-left: 30px; margin-bottom: 20px;'>";
|
||||
$ret .= LJ::html_text({ 'name' => 'howhear', 'size' => '60', 'maxlength' => '100' });
|
||||
$ret .= "</div>\n\n";
|
||||
}
|
||||
|
||||
{
|
||||
### Interests
|
||||
$ret .= "<?h1 $ML{'.int.header'} h1?>\n";
|
||||
my @eintsl;
|
||||
foreach (sort keys %interests) {
|
||||
push @eintsl, $_ if LJ::text_in($_);
|
||||
}
|
||||
|
||||
$ret .= "<?p $ML{'.int.about'} p?>";
|
||||
$ret .= "<?p $ML{'.int.ex.good'} p?>";
|
||||
$ret .= "<?p $ML{'.int.ex.bad'} p?>";
|
||||
$ret .= "<div style='margin-left: 30px; margin-bottom: 20px;'>";
|
||||
$ret .= LJ::html_textarea({ 'name' => 'interests', 'value' => join(", ", @eintsl),
|
||||
'rows' => '10', 'cols' => '50', 'wrap' => 'soft' });
|
||||
$ret .= "</div>\n\n";
|
||||
}
|
||||
|
||||
### Picture Settings
|
||||
$ret .= "<?h1 $ML{'.userpic.header'} h1?>\n<?p $ML{'.userpic.about'} p?>\n";
|
||||
$ret .= "<p align='center'>";
|
||||
if ($u->{'defaultpicid'})
|
||||
{
|
||||
my $picid = $u->{'defaultpicid'};
|
||||
my %userpics = ();
|
||||
LJ::load_userpics(\%userpics, [ $u, $picid ]);
|
||||
$ret .= "<a href='editpics.bml$getextra'><img src=\"$LJ::USERPIC_ROOT/$picid/$u->{'userid'}\" width='$userpics{$picid}->{'width'}' height='$userpics{$picid}->{'height'} alt='$u->{'user'}' border='0'></a>";
|
||||
} else
|
||||
{
|
||||
$ret .= "<i>($ML{'.userpic.none'})</i>";
|
||||
}
|
||||
$ret .= "</p><p>$ML{'.userpic.edit'}</p>\n\n";
|
||||
|
||||
|
||||
###
|
||||
### Journal Options
|
||||
###
|
||||
|
||||
$ret .= "<?h1 $ML{'.settings.header'} h1?>\n";
|
||||
|
||||
|
||||
### display options
|
||||
$ret .= "<?p $ML{'.settings.about'} p?>\n";
|
||||
$ret .= "<table style='margin-left: 30px; margin-bottom: 20px'>\n";
|
||||
|
||||
# journaltitle
|
||||
$ret .= "<tr><td><b>$ML{'.settings.journal.title'} </b></td>";
|
||||
$ret .= "<td>" . LJ::html_text({ 'name' => 'journaltitle', 'value' => $u->{'journaltitle'}, 'size' => '30', 'maxlength' => '80' }) . " </td></tr>\n";
|
||||
|
||||
# journalsubtitle
|
||||
$ret .= "<tr><td><b>$ML{'.settings.journal.subtitle'} </b></td>";
|
||||
$ret .= "<td>" . LJ::html_text({ 'name' => 'journalsubtitle', 'value' => $u->{'journalsubtitle'}, 'size' => '30', 'maxlength' => '80' }) . " </td></tr>\n";
|
||||
$ret .= "<tr><td colspan='2'>$ML{'.settings.journal.subtitle.optional'}</td></tr>\n";
|
||||
|
||||
# friendspagetitle
|
||||
$ret .= "<tr><td><b>$ML{'.settings.friendspage.title'} </b></td>";
|
||||
$ret .= "<td>" . LJ::html_text({ 'name' => 'friendspagetitle', 'value' => $u->{'friendspagetitle'}, 'size' => '30', 'maxlength' => '80' }) . "</td></tr>\n";
|
||||
$ret .= "<tr><td colspan='2'>$ML{'.settings.friendspage.title.optional'}</td></tr>\n";
|
||||
$ret .= "</table>\n\n";
|
||||
|
||||
### privacy options
|
||||
$ret .= "<?h2 $ML{'.settings.privacy.header'} h2?><?p $ML{'.settings.privacy.about'} p?>\n";
|
||||
$ret .= "<table style='margin: 10px 0 20px 30px'>\n";
|
||||
|
||||
# allow_contactshow
|
||||
$ret .= "<tr valign=middle><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'allow_contactshow', 'id' => 'allow_contactshow',
|
||||
'selected' => $u->{'allow_contactshow'} ne 'N' });
|
||||
$ret .= "</td><td><b><label for='allow_contactshow'>$ML{'.allowshowcontact.title'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.allowshowcontact.about'}";
|
||||
|
||||
{
|
||||
# contactshow_sec
|
||||
$ret .= "\n<p><b>$ML{'.security.header'}</b> ";
|
||||
$ret .= LJ::html_select({ 'name' => 'contactshow_sec',
|
||||
'selected' => $u->{'allow_contactshow'} },
|
||||
"Y" => BML::ml(".security.visibility.everybody"),
|
||||
"F" => BML::ml(".security.visibility.friends") );
|
||||
$ret .= "</p>\n";
|
||||
|
||||
# opt_whatemailshow
|
||||
$ret .= "<p><b>$ML{'.allowshowcontact.email'}</b>\n";
|
||||
$ret .= "<div style='margin-left: 30px; margin-bottom: 20px;'>";
|
||||
my $cur = $u->{'opt_whatemailshow'} || "N";
|
||||
my @vals = ( ($LJ::USER_EMAIL && LJ::get_cap($u, "useremail"))
|
||||
? ("B" => BML::ml(".allowshowcontact.email.both", { 'domain' => $LJ::USER_DOMAIN}),
|
||||
"A" => BML::ml(".allowshowcontact.email.actual_only"),
|
||||
"L" => BML::ml(".allowshowcontact.email.lj_only"),
|
||||
"N" => BML::ml(".allowshowcontact.email.neither"))
|
||||
: ("A" => BML::ml(".allowshowcontact.email.show"),
|
||||
"N" => BML::ml(".allowshowcontact.email.no_show")));
|
||||
$ret .= LJ::html_select({ 'name' => 'opt_whatemailshow', 'selected' => $cur }, @vals) . "\n";
|
||||
|
||||
$ret .= "<p>" . ($LJ::USER_EMAIL
|
||||
? $ML{'.allowshowcontact.email.withdomainaddr'}
|
||||
: $ML{'.allowshowcontact.email.withoutdomainaddr'}) . "</p>\n</div>\n";
|
||||
|
||||
# opt_mangleemail
|
||||
$ret .= "<table style='margin-bottom: 20px;'>\n<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_mangleemail', 'id' => 'opt_mangleemail',
|
||||
'selected' => $u->{'opt_mangleemail'} eq 'Y' });
|
||||
$ret .= "</td><td><b><label for='opt_mangleemail'>$ML{'.mangleaddress.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.mangleaddress.about'}</td></tr>\n</table>\n";
|
||||
|
||||
}
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# allow_infoshow
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'allow_infoshow', 'id' => 'allow_infoshow',
|
||||
'selected' => $u->{'allow_infoshow'} eq 'Y' });
|
||||
$ret .= "</td><td><b><label for='allow_infoshow'>$ML{'.allowshowinfo.title'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.allowshowinfo.about'}</td></tr>\n";
|
||||
|
||||
# opt_blockrobots
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_blockrobots', 'id' => 'opt_blockrobots',
|
||||
'selected' => $u->{'opt_blockrobots'} });
|
||||
$ret .= "</td><td><b><label for='opt_blockrobots'>$ML{'.blockrobots.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.blockrobots.about'}</td></tr>\n";
|
||||
|
||||
# opt_weblogscom
|
||||
if (LJ::get_cap($u, "weblogscom")) {
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_weblogscom', 'id' => 'opt_weblogscom',
|
||||
'selected' => $u->{'opt_weblogscom'} });
|
||||
$ret .= "</td><td><b><label for='opt_weblogscom'>$ML{'.weblogscom.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.weblogscom.about'}</td></tr>\n";
|
||||
}
|
||||
|
||||
# opt_showmutualfriends
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_showmutualfriends', 'id' => 'opt_showmutualfriends',
|
||||
'selected' => $u->{'opt_showmutualfriends'} });
|
||||
$ret .= "</td><td><b><label for='opt_showmutualfriends'>$ML{'.mutualfriends.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.mutualfriends.about'}</td></tr>\n";
|
||||
|
||||
# opt_hidefriendofs
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_hidefriendofs', 'id' => 'opt_hidefriendofs',
|
||||
'selected' => $u->{'opt_hidefriendofs'} });
|
||||
$ret .= "</td><td><b><label for='opt_hidefriendofs'>$ML{'.hidefriendof.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.hidefriendof.about'}</td></tr>\n";
|
||||
|
||||
|
||||
# allow_getljnews
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'allow_getljnews', 'id' => 'allow_getljnews',
|
||||
'selected' => $u->{'allow_getljnews'} eq 'Y' });
|
||||
$ret .= "</td><td><b><label for='allow_getljnews'>$ML{'.opt_in.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.opt_in.about'}</td></tr>\n";
|
||||
|
||||
# opt_bdaymail
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_bdaymail', 'id' => 'opt_bdaymail',
|
||||
'selected' => $u->{'opt_bdaymail'} });
|
||||
$ret .= "</td><td><b><label for='opt_bdaymail'>$ML{'.bdayreminders.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.bdayreminders.about'}</td></tr>\n";
|
||||
|
||||
# opt_imagelinks
|
||||
my ($maxwidth, $maxheight) = (0, 0);
|
||||
($maxwidth, $maxheight) = ($1, $2)
|
||||
if ($u->{'opt_imagelinks'} =~ m/^(\d+)\|(\d+)$/);
|
||||
my $is_stock = {'320|240' => 1, '640|480' => 1, '0|0' => 1, '' => 1}->{$u->{'opt_imagelinks'}};
|
||||
my $extra = $is_stock ? '' : BML::ml('.imagelinks.size.custom',
|
||||
{'width' => $maxwidth, 'height' => $maxheight});
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_imagelinks_on', 'id' => 'opt_imagelinks_on',
|
||||
'selected' => $u->{'opt_imagelinks'} });
|
||||
$ret .= "</td><td><b><label for='opt_imagelinks_on'>$ML{'.imagelinks.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.imagelinks.about'}</td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>";
|
||||
$ret .= LJ::html_select({'name' => 'opt_imagelinks', 'selected' => $u->{'opt_imagelinks'}},
|
||||
'0|0', BML::ml('.imagelinks.size.all'),
|
||||
'320|240', BML::ml('.imagelinks.size.small', {'width' => 320, 'height' => 240}),
|
||||
'640|480', BML::ml('.imagelinks.size.medium', {'width' => 640, 'height' => 480}),
|
||||
$extra ? ("$maxwidth|$maxheight", $extra) : ());
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# opt_getselfemail
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_getselfemail', 'id' => 'opt_getselfemail',
|
||||
'selected' => $u->{'opt_getselfemail'},
|
||||
'disabled' => !LJ::get_cap($u, 'getselfemail') });
|
||||
$ret .= "</td><td><b><label for='opt_getselfemail'>$ML{'.getselfemails.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.getselfemails.about'}</td></tr>\n";
|
||||
|
||||
# opt_showtalklinks
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_showtalklinks', 'id' => 'opt_showtalklinks',
|
||||
'selected' => $u->{'opt_showtalklinks'} eq 'Y' });
|
||||
$ret .= "</td><td><b><label for='opt_showtalklinks'>$ML{'.enableboards.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.enableboards.about'}";
|
||||
|
||||
{
|
||||
# opt_whocanreply
|
||||
$ret .= "\n<p><b>$ML{'.whoreply.header'}</b> ";
|
||||
$ret .= LJ::html_select({ 'name' => 'opt_whocanreply', 'selected' => $u->{'opt_whocanreply'} },
|
||||
"all" => BML::ml(".security.visibility.anybody"),
|
||||
"reg" => BML::ml(".security.visibility.regusers"),
|
||||
"friends" => BML::ml(".security.visibility.friends"));
|
||||
$ret .= "</p>\n";
|
||||
|
||||
# opt_logcommentips
|
||||
$ret .= "<p><b>$ML{'.logip.header'}</b> ";
|
||||
$ret .= LJ::html_select({ 'name' => 'opt_logcommentips', 'selected' => $u->{'opt_logcommentips'} },
|
||||
"N" => BML::ml(".donotlog"),
|
||||
"S" => BML::ml(".logip.anon_only"),
|
||||
"A" => BML::ml(".logip.always") );
|
||||
$ret .= "</p>\n";
|
||||
|
||||
# opt_whoscreened
|
||||
$ret .= "<p><b>$ML{'.screen.header'}</b> ";
|
||||
$ret .= LJ::html_select({ 'name' => 'opt_whoscreened', 'selected' => $u->{'opt_whoscreened'} },
|
||||
"N" => $ML{'.screen.none'},
|
||||
"R" => $ML{'.screen.anon'},
|
||||
"F" => ($u->{'journaltype'} eq 'C' ? $ML{'.screen.nonmembers'} : $ML{'.screen.nonfriends'}),
|
||||
"A" => $ML{'.screen.all'} );
|
||||
$ret .= "</p>\n";
|
||||
|
||||
$ret .= "<table>\n";
|
||||
|
||||
# opt_nctalklinks
|
||||
# $ret .= "<tr valign='middle'><td>";
|
||||
# $ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_nctalklinks', 'id' => 'opt_nctalklinks',
|
||||
# 'selected' => $u->{'opt_nctalklinks'} });
|
||||
# $ret .= "</td><td><b><label for='opt_nctalklinks'>$ML{'.numcomments.header'}</label></b></td></tr>\n";
|
||||
# $ret .= "<tr><td> </td><td>$ML{'.numcomments.about'}</td></tr>\n";
|
||||
|
||||
# stylemine
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_stylemine', 'id' => 'opt_stylemine',
|
||||
'value' => 1, 'selected' => $u->{'opt_stylemine'} });
|
||||
$ret .= "</td><td><b><label for='opt_stylemine'>$ML{'.stylemine.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.stylemine.about'}</td></tr>\n";
|
||||
|
||||
# opt_gettalkemail
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_gettalkemail', 'id' => 'opt_gettalkemail',
|
||||
'selected' => $u->{'opt_gettalkemail'} eq 'Y' });
|
||||
$ret .= "</td><td><b><label for='opt_gettalkemail'>$ML{'.getreplies.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.getreplies.about'}</td></tr>\n";
|
||||
|
||||
# opt_htmlemail
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_htmlemail', 'id' => 'opt_htmlemail',
|
||||
'selected' => $u->{'opt_htmlemail'} eq 'Y' });
|
||||
$ret .= "</td><td><b><label for='opt_htmlemail'>$ML{'.htmlemail.header'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.htmlemail.about'}</td></tr>\n";
|
||||
|
||||
|
||||
$ret .= "</table>\n";
|
||||
|
||||
}
|
||||
$ret .= "</td></tr>\n";
|
||||
|
||||
# opt_embedplaceholders
|
||||
$ret .= "<tr valign='middle'><td>";
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'opt_embedplaceholders', 'id' => 'opt_embedplaceholders',
|
||||
'selected' => $u->{'opt_embedplaceholders'}});
|
||||
$ret .= "</td><td><b><label for='opt_embedplaceholders'>$ML{'.opt_embedplaceholders'}</label></b></td></tr>\n";
|
||||
$ret .= "<tr><td> </td><td>$ML{'.opt_embedplaceholders.about'}</td></tr>\n";
|
||||
|
||||
$ret .= "</table>\n\n";
|
||||
|
||||
### advanced options
|
||||
$ret .= "<?h1 $ML{'.advanced.title'} h1?><?p $ML{'.advanced.about'} p?>\n";
|
||||
$ret .= "<table style='margin: 10px 0 20px 30px;'>\n";
|
||||
|
||||
# external foaf link
|
||||
$ret .= "<tr><td><b>$ML{'.foafurl.title'}</b></td><td>";
|
||||
$ret .= LJ::html_text({ 'name' => 'external_foaf_url',
|
||||
'value' => $u->{'external_foaf_url'}, 'size' => '40', 'maxlength' => '255' });
|
||||
$ret .= "</td></tr><tr><td colspan='2'>$ML{'.foafurl.about'}</td></tr>";
|
||||
|
||||
# done
|
||||
# $ret .= "</table>\n";
|
||||
|
||||
### unicode options
|
||||
if ($LJ::UNICODE) {
|
||||
my (%old_encnames, %mail_encnames, %encodings);
|
||||
LJ::load_codes({ "encoding" => \%encodings } );
|
||||
LJ::load_codes({ "encname" => \%old_encnames } );
|
||||
%mail_encnames = %old_encnames;
|
||||
|
||||
#
|
||||
# OK, as of 2011 Apr 02, all LJR users with oldenc!=0 converted to utf-8 in db, thanks nit!
|
||||
#
|
||||
# ### oldenc - your messages stored in database in this encoding
|
||||
# ### Default: 0 for utf-8. Only 32 users have oldenc!=0
|
||||
# ### Perhaps we should convert them to utf using utf8convert.bml
|
||||
# ### and hide the option, but not tested - check twice!
|
||||
#
|
||||
#
|
||||
# # which encodings to show? For now, we just delete utf-8 from the old encodings
|
||||
# # list because it doesn't make sense there.
|
||||
# foreach my $id (keys %encodings) {
|
||||
# delete $old_encnames{$id} if lc($encodings{$id}) eq 'utf-8';
|
||||
# }
|
||||
#
|
||||
# $ret .= "<?h2 $ML{'.encoding.header'} h2?><?p $ML{'.encoding.about'} p?>\n";
|
||||
# $ret .= "<table style='margin: 10px 0 20px 30px;'>\n";
|
||||
# $ret .= "<tr><td><b>$ML{'.autotranslate.header'}</b></td>";
|
||||
# $ret .= "<td>" . LJ::html_select({ 'name' => 'oldenc', 'selected' => $u->{'oldenc'}},
|
||||
# map { $_, $old_encnames{$_} } sort keys %old_encnames ) . "</td></tr>\n";
|
||||
# $ret .= "<tr><td colspan='2'>" . $ML{'.autotranslate.about'} . "</td></tr>";
|
||||
|
||||
|
||||
### e-mail encoding:
|
||||
if ($u->{journaltype} eq 'P') {
|
||||
$ret .= "<tr><td><b>$ML{'.translatemailto.header'}</b></td>";
|
||||
my $encoding = $u->{'mailencoding'} ? $u->{'mailencoding'} : 6;
|
||||
# $ret .= "<td>" . LJ::html_select({ 'name' => 'mailencoding', 'selected' => $u->{'mailencoding'}},
|
||||
# map { $_, $mail_encnames{$_} } sort keys %mail_encnames ) . "</td></tr>\n";
|
||||
$ret .= "<td>" . LJ::html_select({ 'name' => 'mailencoding', 'selected' => $encoding},
|
||||
map { $_, $mail_encnames{$_} } sort keys %mail_encnames ) . "</td></tr>\n";
|
||||
|
||||
$ret .= "<tr><td colspan='2'>$ML{'.translatemailto.about'}</td></tr>";
|
||||
}
|
||||
|
||||
$ret .= "</table>\n";
|
||||
}
|
||||
|
||||
### let them un-ban users if they've banned users
|
||||
my $banned = LJ::load_rel_user($u, 'B');
|
||||
if ($banned && @$banned) {
|
||||
my $us = LJ::load_userids(@$banned);
|
||||
|
||||
$ret .= "<?h1 $ML{'.unbanusers.header'} h1?><?p $ML{'.unbanusers.about'} p?>\n";
|
||||
$ret .= "<div style='margin: 10px 0 20px 30px'>\n";
|
||||
foreach (@$banned) {
|
||||
my $bu = $us->{$_};
|
||||
next unless $bu;
|
||||
$ret .= LJ::html_check({ 'type' => 'check', 'name' => 'unban', 'id' => "unban-$bu->{'user'}",
|
||||
'value' => $bu->{'userid'} });
|
||||
$ret .= " <label for='unban-$bu->{'user'}'>$bu->{'user'}</label><br />\n";
|
||||
}
|
||||
$ret .= "</div>\n";
|
||||
}
|
||||
|
||||
# ending submit block
|
||||
$ret .= "<?h1 $ML{'.finished.header'} h1?><?p $ML{'.finished.about'} p?>\n";
|
||||
$ret .= "<?standout " . LJ::html_submit(undef, $ML{'.finished.save_button'}) . " standout?>\n";
|
||||
$ret .= "</form>\n";
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
||||
###
|
||||
### we have a post, process edits
|
||||
###
|
||||
|
||||
if (LJ::did_post()) {
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'error.invalidform'} p?>" unless LJ::check_form_auth();
|
||||
|
||||
$POST{'unban'} =~ s/\0/,/g;
|
||||
return "<?badinput?>" unless LJ::text_in(\%POST);
|
||||
|
||||
my @errors = ();
|
||||
|
||||
# name
|
||||
unless ($POST{'name'} || defined($POST{'name_absent'})) {
|
||||
push @errors, $ML{'.error.noname'};
|
||||
}
|
||||
|
||||
# state and zip
|
||||
my ($zipcity, $zipstate);
|
||||
if ($POST{'country'} eq "US") {
|
||||
$sth = $dbr->prepare("SELECT city, state FROM zip WHERE zip=?");
|
||||
$sth->execute($POST{'zip'});
|
||||
($zipcity, $zipstate) = $sth->fetchrow_array;
|
||||
}
|
||||
|
||||
# country
|
||||
if ($POST{'country'} ne "US" && $POST{'zip'}) {
|
||||
push @errors, $ML{'.error.locale.zip_requires_us'};
|
||||
}
|
||||
|
||||
if ($POST{'country'} eq "US" && $POST{'stateother'}) {
|
||||
push @errors, $ML{'.error.locale.country_ne_state'};
|
||||
} elsif ($POST{'country'} && $POST{'country'} ne "US" && $POST{'statedrop'}) {
|
||||
push @errors, $ML{'.error.locale.state_ne_country'};
|
||||
}
|
||||
|
||||
# zip-code validation stuff
|
||||
if ($POST{'country'} eq "US") {
|
||||
if ($POST{'statedrop'} && $zipstate && $POST{'statedrop'} ne $zipstate) {
|
||||
push @errors, $ML{'.error.locale.zip_ne_state'};
|
||||
}
|
||||
if ($zipcity) {
|
||||
$POST{'statedrop'} = $zipstate;
|
||||
$POST{'city'} = $zipcity;
|
||||
}
|
||||
}
|
||||
|
||||
if ($POST{'country'} && !defined($countries{$POST{'country'}})) {
|
||||
push @errors, $ML{'.error.locale.invalid_country'};
|
||||
}
|
||||
|
||||
# birthday
|
||||
my $this_year = (localtime())[5]+1900;
|
||||
|
||||
if ($POST{'year'} && $POST{'year'} < 100) {
|
||||
push @errors, $ML{'.error.year.notenoughdigits'};
|
||||
}
|
||||
|
||||
if ($POST{'year'} && $POST{'year'} >= 100 && ($POST{'year'} < 1890 || $POST{'year'} > $this_year)) {
|
||||
push @errors, $ML{'.error.year.outofrange'};
|
||||
}
|
||||
|
||||
if ($POST{'month'} && ($POST{'month'} < 1 || $POST{'month'} > 12)) {
|
||||
push @errors, $ML{'.error.month.outofrange'};
|
||||
}
|
||||
|
||||
if ($POST{'day'} && ($POST{'day'} < 1 || $POST{'day'} > 31)) {
|
||||
push @errors, $ML{'.error.day.outofrange'};
|
||||
}
|
||||
|
||||
if (@errors == 0 && $POST{'day'} > LJ::days_in_month($POST{'month'}, $POST{'year'})) {
|
||||
push @errors, $ML{'.error.day.notinmonth'};
|
||||
}
|
||||
|
||||
# email
|
||||
unless ($POST{'email'}) {
|
||||
push @errors, $ML{'.error.email.none'};
|
||||
}
|
||||
|
||||
if ($LJ::USER_EMAIL and $POST{'email'} =~ /\@\Q$LJ::USER_DOMAIN\E$/i) {
|
||||
push @errors, BML::ml(".error.email.lj_domain", { 'user' => $u->{'user'}, 'domain' => $LJ::USER_DOMAIN, });
|
||||
}
|
||||
|
||||
if ($POST{'email'} =~ /\s/) {
|
||||
push @errors, $ML{'.error.email.no_space'};
|
||||
}
|
||||
|
||||
unless (@errors) {
|
||||
LJ::check_email($POST{'email'}, \@errors);
|
||||
}
|
||||
|
||||
# text messaging
|
||||
if ($POST{'use_txtmsg'}) {
|
||||
unless ($POST{'txtmsg_provider'}) {
|
||||
push @errors, $ML{'.error.tm.require_provider'};
|
||||
}
|
||||
unless ($POST{'txtmsg_number'}) {
|
||||
push @errors, $ML{'.error.tm.require.number'};
|
||||
}
|
||||
}
|
||||
|
||||
return LJ::bad_input(@errors) if @errors;
|
||||
|
||||
### no errors
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
my $email_changed = ($u->{'email'} ne $POST{'email'});
|
||||
if ($email_changed) {
|
||||
# record old email address;
|
||||
LJ::infohistory_add($u, 'email', $u->{email}, $u->{status});
|
||||
}
|
||||
|
||||
$POST{'url'} =~ s/\s+$//; $POST{'url'} =~ s/^\s+//;
|
||||
if ($POST{'url'} && $POST{'url'} !~ /^https?:\/\//) {
|
||||
$POST{'url'} =~ s/^http\W*//;
|
||||
$POST{'url'} = "http://$POST{'url'}";
|
||||
}
|
||||
|
||||
my $newname = defined $POST{'name_absent'} ? $saved{'name'} : $POST{'name'};
|
||||
$newname =~ s/[\n\r]//g;
|
||||
$newname = LJ::text_trim($newname, LJ::BMAX_NAME, LJ::CMAX_NAME);
|
||||
|
||||
my $newbio = defined($POST{'bio_absent'}) ? $saved{'bio'} : $POST{'bio'};
|
||||
my $has_bio = ($newbio =~ /\S/) ? "Y" : "N";
|
||||
my $txtmsg_status = $POST{'use_txtmsg'} ? "on" : "off";
|
||||
# setup what we're gonna update in the user table:
|
||||
my %update = (
|
||||
'name' => $newname,
|
||||
'bdate' => sprintf("%04d-%02d-%02d", $POST{'year'}, $POST{'month'}, $POST{'day'}),
|
||||
'email' => $POST{'email'},
|
||||
'status' => ($email_changed && $u->{'status'} eq "A") ? "T" : $u->{'status'},
|
||||
'has_bio' => $has_bio,
|
||||
'allow_infoshow' => $POST{'allow_infoshow'} ? "Y" : "N",
|
||||
'allow_getljnews' => $POST{'allow_getljnews'} ? "Y" : "N",
|
||||
'opt_showtalklinks' => $POST{'opt_showtalklinks'} ? "Y" : "N",
|
||||
'opt_gettalkemail' => $POST{'opt_gettalkemail'} ? "Y" : "N",
|
||||
'opt_htmlemail' => $POST{'opt_htmlemail'} ? "Y" : "N",
|
||||
'opt_mangleemail' => $POST{'opt_mangleemail'} ? "Y" : "N",
|
||||
'opt_whocanreply' => $POST{'opt_whocanreply'},
|
||||
'txtmsg_status' => $txtmsg_status,
|
||||
);
|
||||
|
||||
if ($POST{'allow_contactshow'}) {
|
||||
$update{'allow_contactshow'} = "Y";
|
||||
$update{'allow_contactshow'} = "F" if $POST{'contactshow_sec'} eq "F";
|
||||
} else {
|
||||
$update{'allow_contactshow'} = "N";
|
||||
}
|
||||
|
||||
# if (defined $POST{'oldenc'}) {
|
||||
# $update{'oldenc'} = $POST{'oldenc'};
|
||||
# }
|
||||
|
||||
LJ::update_user($u, \%update);
|
||||
|
||||
### change any of the userprops ?
|
||||
{
|
||||
# journal / friends titles
|
||||
$POST{'journaltitle'} = LJ::text_trim($POST{'journaltitle'}, 0, 80) if $POST{'journaltitle'};
|
||||
$POST{'journalsubtitle'} = LJ::text_trim($POST{'journalsubtitle'}, 0, 80) if $POST{'journalsubtitle'};
|
||||
$POST{'friendspagetitle'} = LJ::text_trim($POST{'friendspagetitle'}, 0, 80) if $POST{'friendspagetitle'};
|
||||
|
||||
# opts
|
||||
$POST{'opt_showmutualfriends'} = $POST{'opt_showmutualfriends'} ? 1 : 0;
|
||||
$POST{'opt_getselfemail'} = $POST{'opt_getselfemail'} ? 1 : 0;
|
||||
$POST{'opt_stylemine'} = $POST{'opt_stylemine'} ? 1 : 0;
|
||||
$POST{'opt_blockrobots'} = $POST{'opt_blockrobots'} ? 1 : 0;
|
||||
$POST{'opt_bdaymail'} = $POST{'opt_bdaymail'} ? 1 : 0;
|
||||
$POST{'opt_hidefriendofs'} = $POST{'opt_hidefriendofs'} ? 1 : 0;
|
||||
$POST{'opt_nctalklinks'} = $POST{'opt_nctalklinks'} ? 1 : 0;
|
||||
$POST{'opt_weblogscom'} = $POST{'opt_weblogscom'} ? 1 : 0;
|
||||
if ($POST{'opt_logcommentips'} ne "N" &&
|
||||
$POST{'opt_logcommentips'} ne "S" &&
|
||||
$POST{'opt_logcommentips'} ne "A") { $POST{'opt_logcommentips'} = "N"; }
|
||||
$POST{'opt_whoscreened'} = "N" unless $POST{'opt_whoscreened'} =~ m/^(N|R|F|A)$/;
|
||||
$POST{'opt_imagelinks'} = 0 unless $POST{'opt_imagelinks_on'} &&
|
||||
$POST{'opt_imagelinks'} =~ m/^(\d+)\|(\d+)$/;
|
||||
$POST{'opt_embedplaceholders'} = $POST{'opt_embedplaceholders'} ? 1 : 0;
|
||||
|
||||
# for the directory.
|
||||
$POST{'sidx_bdate'} = "";
|
||||
$POST{'sidx_loc'} = "";
|
||||
$POST{'state'} = $POST{'statedrop'} || $POST{'stateother'};
|
||||
if ($update{'allow_infoshow'} eq 'Y') {
|
||||
if ($POST{'year'}) {
|
||||
$POST{'sidx_bdate'} = sprintf("%04d-%02d-%02d", map { $POST{$_} }
|
||||
qw(year month day));
|
||||
}
|
||||
|
||||
if ($POST{'country'}) {
|
||||
my $state;
|
||||
if ($POST{'country'} eq "US") {
|
||||
$state = $POST{'statedrop'};
|
||||
} else {
|
||||
$state = $POST{'stateother'};
|
||||
}
|
||||
$POST{'sidx_loc'} = sprintf("%2s-%s-%s",
|
||||
$POST{'country'},
|
||||
$state,
|
||||
$POST{'city'});
|
||||
}
|
||||
}
|
||||
|
||||
my @uprops = (
|
||||
"opt_whatemailshow",
|
||||
"country", "state", "city", "zip", "icq",
|
||||
"aolim", "yahoo", "msn", "url", "urlname",
|
||||
"gender", "jabber", "opt_blockrobots",
|
||||
"opt_logcommentips",
|
||||
"opt_bdaymail", "opt_hidefriendofs",
|
||||
"sidx_bdate", "sidx_loc", "mailencoding", "opt_nctalklinks",
|
||||
"opt_whoscreened", "journaltitle", "journalsubtitle", "friendspagetitle",
|
||||
"opt_stylemine", "opt_imagelinks", "opt_getselfemail",
|
||||
"external_foaf_url", "opt_showmutualfriends", "opt_embedplaceholders",
|
||||
);
|
||||
|
||||
# weblogs.com requires a special cap
|
||||
push @uprops, 'opt_weblogscom' if LJ::get_cap($u, 'weblogscom');
|
||||
|
||||
# this is only done once, then never appears again.
|
||||
push @uprops, 'howhear' if $POST{'howhear'};
|
||||
|
||||
# set userprops
|
||||
foreach my $uprop (@uprops) {
|
||||
my $eff_val = $POST{$uprop}; # effective value, since 0 isn't stored
|
||||
$eff_val = "" unless $eff_val;
|
||||
my $mem_only = $eff_val eq $u->{$uprop};
|
||||
LJ::set_userprop($u, $uprop, $eff_val, $mem_only);
|
||||
}
|
||||
}
|
||||
|
||||
# update their bio text
|
||||
if (($u->{'bio'} ne $POST{'bio'}) && !defined($POST{'bio_absent'})) {
|
||||
if ($has_bio eq "N") {
|
||||
$u->do("DELETE FROM userbio WHERE userid=?", undef, $u->{'userid'});
|
||||
$u->dudata_set('B', 0, 0);
|
||||
} else {
|
||||
$u->do("REPLACE INTO userbio (userid, bio) VALUES (?, ?)",
|
||||
undef, $u->{'userid'}, $POST{'bio'});
|
||||
$u->dudata_set('B', 0, length($POST{'bio'}));
|
||||
}
|
||||
LJ::MemCache::set([$u->{'userid'}, "bio:$u->{'userid'}"], $POST{'bio'});
|
||||
}
|
||||
|
||||
# update their text messaging info
|
||||
if ($txtmsg_status eq "off" && $u->{'txtmsg_status'} eq "on") {
|
||||
$dbh->do("DELETE FROM txtmsg WHERE userid=?", undef, $u->{'userid'});
|
||||
} elsif ($txtmsg_status eq "on") {
|
||||
$dbh->do("REPLACE INTO txtmsg (userid, provider, number, security) VALUES (?, ?, ?, ?)",
|
||||
undef, $u->{'userid'}, $POST{'txtmsg_provider'}, $POST{'txtmsg_number'}, $POST{'txtmsg_security'});
|
||||
}
|
||||
|
||||
# update interests
|
||||
unless ($POST{'interests_absent'}) {
|
||||
$POST{'interests'} =~ s/^\s+//;
|
||||
$POST{'interests'} =~ s/\s+$//;
|
||||
$POST{'interests'} =~ s/\n/,/g;
|
||||
$POST{'interests'} =~ s/\s+/ /g; #Strip duplicate spaces from the interest
|
||||
my @ints = split (/\s*,\s*/, $POST{'interests'});
|
||||
my $intcount = scalar(@ints);
|
||||
if ($intcount > 150) {
|
||||
return LJ::bad_input(BML::ml(".error.excessive_int", {'intcount' => $intcount}));
|
||||
}
|
||||
LJ::set_interests($u, \%interests, \@ints);
|
||||
}
|
||||
|
||||
# now unban users they selected to be unbanned
|
||||
if ($POST{'unban'}) {
|
||||
my $bannedin = join(",", map { $dbh->quote($_); } split(/,/, $POST{'unban'}));
|
||||
$dbh->do("DELETE FROM reluser WHERE userid=? AND type='B' AND targetid IN ($bannedin)", undef, $u->{'userid'});
|
||||
}
|
||||
|
||||
# actions if email changed
|
||||
if ($email_changed) {
|
||||
my $aa = {};
|
||||
$aa = LJ::register_authaction($u->{'userid'},
|
||||
"validateemail", $POST{'email'});
|
||||
|
||||
LJ::send_mail({
|
||||
'to' => $POST{'email'},
|
||||
'from' => $LJ::ADMIN_EMAIL,
|
||||
'charset' => 'utf-8',
|
||||
'subject' => $ML{'.newemail.subject'},
|
||||
'body' => BML::ml('.newemail.body2',
|
||||
{ username => $u->{user},
|
||||
sitename => $LJ::SITENAME,
|
||||
sitelink => $LJ::SITEROOT,
|
||||
conflink => "$LJ::SITEROOT/confirm/$aa->{'aaid'}.$aa->{'authcode'}" }),
|
||||
});
|
||||
}
|
||||
|
||||
# tell the user all is well
|
||||
return "<?h1 $ML{'.success.header'} h1?>\n" .
|
||||
"<?p " . BML::ml(".success.message", { 'user' => $u->{'user'}, }) . " p?>";
|
||||
}
|
||||
|
||||
# should never happen
|
||||
return "<?h1 $ML{'Error'} h1?><?p $ML{'error.unknownmode'} p?>";
|
||||
|
||||
}
|
||||
_code?>
|
||||
|
||||
<=body
|
||||
page?><?_c <LJDEP>
|
||||
lib: LJ::TextMessage, cgi-bin/ljlib.pl, cgi-bin/ljlang.pl
|
||||
link: htdocs/privacy.bml, htdocs/support/faqbrowse.bml, htdocs/tools/textmessage.bml, htdocs/uploadpic.bml
|
||||
link: htdocs/paidaccounts/index.bml, htdocs/users, htdocs/userinfo.bml
|
||||
post: htdocs/editinfo.bml
|
||||
img: htdocs/userpic
|
||||
</LJDEP> _c?>
|
||||
126
local/htdocs/edittags.bml
Executable file
126
local/htdocs/edittags.bml
Executable file
@@ -0,0 +1,126 @@
|
||||
<?page
|
||||
title=><?_code $ML{'.title'} _code?>
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw($GET $POST);
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return "<?needlogin?>" unless $remote;
|
||||
|
||||
my $err = sub { return "<?h1 $ML{'Error'} h1?><?p $_[0] p?>"; };
|
||||
return $err->($ML{'.disabled'})
|
||||
if $LJ::DISABLED{tags};
|
||||
|
||||
my ($ret, $msg);
|
||||
|
||||
return $err->($ML{'.invalid.link'})
|
||||
unless LJ::did_post() || ($GET{journal} && $GET{itemid});
|
||||
|
||||
my $journal = $GET{journal} || $POST{journal};
|
||||
my $u = LJ::load_user($journal);
|
||||
return $err->($ML{'.invalid.journal'}) unless $u;
|
||||
|
||||
my $ditemid = ($GET{itemid} || $POST{itemid})+0;
|
||||
my $anum = $ditemid % 256;
|
||||
my $jitemid = $ditemid >> 8;
|
||||
return $err->($ML{'.invalid.entry'}) unless $jitemid;
|
||||
|
||||
my $logrow = LJ::get_log2_row($u, $jitemid);
|
||||
return $err->($ML{'.invalid.entry'}) unless $logrow;
|
||||
return $err->($ML{'.invalid.entry'}) unless $logrow->{anum} == $anum;
|
||||
return $err->($ML{'.invalid.notauthorized'})
|
||||
unless LJ::can_view($remote, $logrow);
|
||||
|
||||
if (LJ::did_post()) {
|
||||
return $err->($ML{'.invalid.link'})
|
||||
unless LJ::check_form_auth();
|
||||
|
||||
LJ::Tags::update_logtags($u, $jitemid, {
|
||||
set_string => $POST{edittags},
|
||||
remote => $remote,
|
||||
});
|
||||
|
||||
BML::redirect( LJ::journal_base($u) . "/$ditemid.html" );
|
||||
#$msg = "<div class='update_good'>Tags successfully updated.</div>";
|
||||
}
|
||||
|
||||
my $item = LJ::Talk::get_journal_item($u, $jitemid);
|
||||
|
||||
my $subj = $item->{'subject'};
|
||||
my $evt = $item->{'event'};
|
||||
|
||||
LJ::CleanHTML::clean_subject(\$subj);
|
||||
LJ::CleanHTML::clean_event(\$evt);
|
||||
|
||||
## $item->{'props'}->{'tags'} ???
|
||||
my $logtags = LJ::Tags::get_logtags($u, $jitemid);
|
||||
my $usertags = LJ::Tags::get_usertags($u, { remote => $remote }) || {};
|
||||
$logtags = $logtags->{$jitemid} || {};
|
||||
my $logtagstr = join ', ', map { LJ::ejs($_) } sort values %$logtags;
|
||||
|
||||
$ret .= "<?p $ML{'.intro'} p?><br />";
|
||||
$ret .= "<script type='text/javascript'> var cur_taglist = '$logtagstr'; </script>";
|
||||
|
||||
$ret .= '<table class="edittbl" cellpadding="0" cellspacing="0" width="50%">';
|
||||
$ret .= "<tr><td class='l'>$ML{'.subject'}</td><td>$subj</td></tr>" if $subj;
|
||||
$ret .= "<tr><td class='l'>$ML{'.entry'}</td><td>$evt</td></tr>";
|
||||
$ret .= "<tr><td class='l'> </td><td> </td></tr>"; # spacer
|
||||
|
||||
$ret .= "<tr><td class='l'>$ML{'.current'}</td>";
|
||||
$ret .= '<form method="POST" action="/edittags.bml" id="edit_tagform">';
|
||||
$ret .= LJ::form_auth();
|
||||
$ret .= "<td class='sep'>";
|
||||
if ( LJ::Tags::can_add_tags($u, $remote) ) {
|
||||
$ret .= LJ::html_text(
|
||||
{
|
||||
name => 'edittags',
|
||||
value => (join ', ', sort values %$logtags),
|
||||
size => 40,
|
||||
class => 'tagfield',
|
||||
id => 'tagfield',
|
||||
}
|
||||
);
|
||||
$ret .= ' ';
|
||||
$ret .= LJ::html_submit( 'save', $ML{'.button.save'}, { class => 'btn' });
|
||||
$ret .= $msg if $msg;
|
||||
} else {
|
||||
# no widgets
|
||||
$ret .= $ML{'.permissions.none'};
|
||||
}
|
||||
$ret .= "</td></tr>";
|
||||
|
||||
$ret .= "<tr><td class='l'>$ML{'.users'}</td><td class='curtags'>";
|
||||
|
||||
if ( scalar keys %$usertags ) {
|
||||
$ret .= "<select name='tags' multiple='multiple' class='tagbox_nohist' " .
|
||||
"onChange='edit_tagselect(this)'>";
|
||||
foreach (sort { $a->{name} cmp $b->{name} } values %$usertags) {
|
||||
$ret .= "<option value='" . LJ::ehtml($_->{name}) . "'>" . LJ::ehtml($_->{name}) . "</option>";
|
||||
}
|
||||
$ret .= "</select>";
|
||||
} else {
|
||||
$ret .= "none"
|
||||
}
|
||||
|
||||
$ret .= "<br /><br />";
|
||||
$ret .= "$ML{'.permissions.add.yes'}<br />" if LJ::Tags::can_add_tags($u, $remote);
|
||||
$ret .= "$ML{'.permissions.control.yes'}<br />" if LJ::Tags::can_control_tags($u, $remote);
|
||||
$ret .= BML::ml('.view', { aopts => 'href="' . LJ::journal_base($u) . "/$ditemid.html" . '"' });
|
||||
$ret .= "</td></tr>";
|
||||
|
||||
$ret .= '</table>';
|
||||
$ret .= LJ::html_hidden('journal', $journal);
|
||||
$ret .= LJ::html_hidden('itemid', $GET{itemid} || $POST{itemid});
|
||||
$ret .= '</form>';
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
head<=
|
||||
<link rel='stylesheet' type='text/css' href='/styles/tags.css' />
|
||||
<script type="text/javascript" src="/js/tags.js"></script>
|
||||
<=head
|
||||
page?>
|
||||
158
local/htdocs/export_comments.bml
Normal file
158
local/htdocs/export_comments.bml
Normal file
@@ -0,0 +1,158 @@
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET);
|
||||
|
||||
my $req = shift;
|
||||
my $r = $req->{'r'};
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return "<?needlogin?>" unless $remote;
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $u = LJ::get_authas_user($authas);
|
||||
return LJ::bad_input($ML{'error.invalidauth'}) unless $u;
|
||||
|
||||
my @errors = ();
|
||||
|
||||
my $dbcr = LJ::get_cluster_reader($u);
|
||||
push @errors, $ML{'error.nodb'} unless $dbcr;
|
||||
|
||||
# don't let people hit us with silly GET attacks
|
||||
push @errors, "This page can't be viewed except via POST."
|
||||
if BML::get_client_header('Referer') && !LJ::did_post();
|
||||
|
||||
my $mode = $GET{get};
|
||||
push @errors, "Invalid mode."
|
||||
unless $mode =~ m/^comment_(?:meta|body)$/;
|
||||
|
||||
# error stuff
|
||||
return LJ::bad_input(@errors) if @errors;
|
||||
|
||||
# from now on, we manage our own output
|
||||
BML::suppress_headers();
|
||||
BML::suppress_content();
|
||||
|
||||
# print top
|
||||
$r->content_type("text/xml; charset=utf-8");
|
||||
$r->send_http_header();
|
||||
$r->print("<?xml version=\"1.0\" encoding='utf-8'?>\n<livejournal>\n");
|
||||
|
||||
# startid specified?
|
||||
my $gather = $mode eq 'comment_meta' ? 10000 : 1000;
|
||||
my $startid = $GET{startid}+0;
|
||||
my $endid = $startid + $gather;
|
||||
|
||||
# get metadata
|
||||
my $rows = $dbcr->selectall_arrayref('SELECT jtalkid, nodeid, parenttalkid, posterid, state, datepost ' .
|
||||
"FROM talk2 WHERE nodetype = 'L' AND journalid = ? AND " .
|
||||
" jtalkid >= $startid AND jtalkid < $endid",
|
||||
undef, $u->{userid});
|
||||
|
||||
# now let's gather them all together while making a list of posterids
|
||||
my %posterids;
|
||||
my %comments;
|
||||
foreach my $r (@{$rows || []}) {
|
||||
$comments{$r->[0]} = {
|
||||
nodeid => $r->[1],
|
||||
parenttalkid => $r->[2],
|
||||
posterid => $r->[3],
|
||||
state => $r->[4],
|
||||
datepost => $r->[5],
|
||||
};
|
||||
$posterids{$r->[3]} = 1 if $r->[3]; # don't include 0 (anonymous)
|
||||
}
|
||||
|
||||
# now we have two choices: comments themselves or metadata
|
||||
if ($mode eq 'comment_meta') {
|
||||
# meta data is easy :)
|
||||
my $max = $dbcr->selectrow_array('SELECT MAX(jtalkid) FROM talk2 ' .
|
||||
"WHERE journalid = ? AND nodetype = 'L'",
|
||||
undef, $u->{userid});
|
||||
$max += 0;
|
||||
$r->print("<maxid>$max</maxid>\n");
|
||||
|
||||
# load posterids
|
||||
my $us = LJ::load_userids(keys %posterids);
|
||||
|
||||
# now spit out the metadata
|
||||
$r->print("<comments>\n");
|
||||
while (my ($id, $data) = each %comments) {
|
||||
my $ret = "<comment id='$id'";
|
||||
$ret .= " posterid='$data->{posterid}'" if $data->{posterid};
|
||||
$ret .= " state='$data->{state}'" if $data->{state} ne 'A';
|
||||
$ret .= " />\n";
|
||||
$r->print($ret);
|
||||
}
|
||||
$r->print("</comments>\n<usermaps>\n");
|
||||
|
||||
# now spit out usermap
|
||||
my $ret = '';
|
||||
while (my ($id, $user) = each %$us) {
|
||||
$ret .= "<usermap id='$id' user='$user->{user}' />\n";
|
||||
}
|
||||
$r->print($ret);
|
||||
$r->print("</usermaps>\n");
|
||||
|
||||
# comment data also presented in glorious XML:
|
||||
} elsif ($mode eq 'comment_body') {
|
||||
# get real comments from startid to a limit of 10k data, however far that takes us
|
||||
my @ids = sort { $a <=> $b } keys %comments;
|
||||
|
||||
# call a load to get comment text
|
||||
my $texts = LJ::get_talktext2($u, @ids);
|
||||
|
||||
# get props if we need to
|
||||
my $props = {};
|
||||
if ($GET{'props'}) {
|
||||
LJ::load_talk_props2($u, \@ids, $props);
|
||||
}
|
||||
|
||||
# now start spitting out data
|
||||
$r->print("<comments>\n");
|
||||
foreach my $id (@ids) {
|
||||
# get text for this comment
|
||||
my $data = $comments{$id};
|
||||
my $text = $texts->{$id};
|
||||
my ($subject, $body) = @{$text || []};
|
||||
|
||||
# only spit out valid UTF8, and make sure it fits in XML, and uncompress it
|
||||
LJ::text_uncompress(\$body);
|
||||
LJ::text_out(\$subject);
|
||||
LJ::text_out(\$body);
|
||||
$subject = LJ::exml($subject);
|
||||
$body = LJ::exml($body);
|
||||
|
||||
# setup the date to be GMT and formatted per W3C specs
|
||||
my $date = LJ::mysqldate_to_time($data->{datepost});
|
||||
$date = LJ::time_to_w3c($date, 'Z');
|
||||
|
||||
# print the data
|
||||
my $ret = "<comment id='$id' jitemid='$data->{nodeid}'";
|
||||
$ret .= " posterid='$data->{posterid}'" if $data->{posterid};
|
||||
$ret .= " state='$data->{state}'" if $data->{state} ne 'A';
|
||||
$ret .= " parentid='$data->{parenttalkid}'" if $data->{parenttalkid};
|
||||
if ($data->{state} eq 'D') {
|
||||
$ret .= " />\n";
|
||||
} else {
|
||||
$ret .= ">\n";
|
||||
$ret .= "<subject>$subject</subject>\n" if $subject;
|
||||
$ret .= "<body>$body</body>\n" if $body;
|
||||
$ret .= "<date>$date</date>\n";
|
||||
foreach my $propkey (keys %{$props->{$id} || {}}) {
|
||||
$ret .= "<property name='$propkey'>";
|
||||
$ret .= LJ::exml($props->{$id}->{$propkey});
|
||||
$ret .= "</property>\n";
|
||||
}
|
||||
$ret .= "</comment>\n";
|
||||
}
|
||||
$r->print($ret);
|
||||
}
|
||||
$r->print("</comments>\n");
|
||||
}
|
||||
|
||||
# all done
|
||||
$r->print("</livejournal>\n");
|
||||
}
|
||||
_code?><?_c <LJDEP>
|
||||
</LJDEP> _c?>
|
||||
206
local/htdocs/export_do.bml
Executable file
206
local/htdocs/export_do.bml
Executable file
@@ -0,0 +1,206 @@
|
||||
<?_code
|
||||
|
||||
LJ::set_active_crumb('export');
|
||||
|
||||
my $req = shift;
|
||||
my $r = $req->{'r'};
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
return "<?needlogin?>"
|
||||
unless $remote;
|
||||
|
||||
my $authas = $GET{'authas'} || $remote->{'user'};
|
||||
my $u = LJ::get_authas_user($authas);
|
||||
return LJ::bad_input($ML{'error.invalidauth'})
|
||||
unless $u;
|
||||
|
||||
my @errors = ();
|
||||
|
||||
my $year = $POST{'year'}+0;
|
||||
my $month = $POST{'month'}+0;
|
||||
|
||||
my $dbcr = LJ::get_cluster_reader($u);
|
||||
push @errors, $ML{'error.nodb'} unless $dbcr;
|
||||
|
||||
my $encoding;
|
||||
|
||||
if ($POST{'encid'}) {
|
||||
my %encodings;
|
||||
LJ::load_codes({ "encoding" => \%encodings } );
|
||||
$encoding = $encodings{$POST{'encid'}};
|
||||
}
|
||||
|
||||
$encoding ||= $POST{'encoding'};
|
||||
$encoding ||= $LJ::UNICODE ? 'utf-8' : 'iso-8859-1';
|
||||
|
||||
if ($LJ::UNICODE && lc($encoding) ne "utf-8" &&
|
||||
! Unicode::MapUTF8::utf8_supported_charset($encoding)) {
|
||||
push @errors, $ML{'.error.encoding'};
|
||||
}
|
||||
|
||||
if (@errors) {
|
||||
return LJ::bad_input(@errors);
|
||||
}
|
||||
|
||||
# from now on, we manage our own output
|
||||
BML::suppress_headers();
|
||||
BML::suppress_content();
|
||||
|
||||
my $opts = {}; # information needed by printing routines
|
||||
|
||||
##### figure out what fields we're exporting
|
||||
|
||||
my @fields;
|
||||
foreach my $f (qw(itemid eventtime logtime subject event security allowmask)) {
|
||||
if ($POST{"field_${f}"}) {
|
||||
push @fields, $f;
|
||||
}
|
||||
}
|
||||
|
||||
if ($POST{'field_currents'}) {
|
||||
push @fields, ("current_music", "current_mood");
|
||||
$opts->{'currents'} = 1;
|
||||
}
|
||||
|
||||
#### do file-format specific initialization
|
||||
|
||||
if ($POST{'format'} eq "csv") {
|
||||
$opts->{'format'} = "csv";
|
||||
$r->content_type("text/plain");
|
||||
$r->send_http_header();
|
||||
if ($POST{'header'}) {
|
||||
$r->print(join(",",@fields) . "\n");
|
||||
}
|
||||
}
|
||||
if ($POST{'format'} eq "xml") {
|
||||
$opts->{'format'} = "xml";
|
||||
my $lenc = lc($encoding);
|
||||
$r->content_type("text/xml; charset=$lenc");
|
||||
$r->send_http_header();
|
||||
$r->print("<?xml version=\"1.0\" encoding='$lenc'?>\n");
|
||||
$r->print("<livejournal>\n");
|
||||
}
|
||||
|
||||
$opts->{'fields'} = \@fields;
|
||||
$opts->{'encoding'} = $encoding;
|
||||
$opts->{'notranslation'} = 1
|
||||
if $POST{'notranslation'};
|
||||
|
||||
$sth = $dbcr->prepare("SELECT jitemid, anum, eventtime, logtime, security, allowmask FROM log2 ".
|
||||
"WHERE journalid=$u->{'userid'} AND year=$year AND month=$month");
|
||||
$sth->execute;
|
||||
if ($dbcr->err) { $r->print($dbcr->errstr); return; }
|
||||
my @buffer;
|
||||
while ($_ = $sth->fetchrow_hashref) {
|
||||
$_->{'ritemid'} = $_->{'jitemid'} || $_->{'itemid'};
|
||||
$_->{'itemid'} = $_->{'jitemid'} * 256 + $_->{'anum'} if $_->{'jitemid'};
|
||||
push @buffer, $_;
|
||||
if (@buffer == 20) {
|
||||
load_and_dump_buffer($u, \@buffer, $opts);
|
||||
@buffer = ();
|
||||
}
|
||||
|
||||
}
|
||||
load_and_dump_buffer($u, \@buffer, $opts);
|
||||
|
||||
if ($opts->{'format'} eq "xml") {
|
||||
$r->print("</livejournal>\n");
|
||||
}
|
||||
return;
|
||||
|
||||
sub load_and_dump_buffer
|
||||
{
|
||||
my ($u, $buf, $opts) = @_;
|
||||
my $lt;
|
||||
my %props;
|
||||
my @ids = map { $_->{'ritemid'} } @{$buf};
|
||||
|
||||
# TODO: use fill_items_with_text_props($buf, $u);
|
||||
# this need valid $buf->{'itemid'}, but no extra fields in dump_entry($e) ...
|
||||
|
||||
$lt = LJ::get_logtext2($u, @ids);
|
||||
LJ::load_log_props2($dbcr, $u->{'userid'}, \@ids, \%props);
|
||||
|
||||
foreach my $e (@{$buf}) {
|
||||
$e->{'subject'} = $lt->{$e->{'ritemid'}}->[0];
|
||||
$e->{'event'} = $lt->{$e->{'ritemid'}}->[1];
|
||||
|
||||
my $eprops = $props{$e->{'ritemid'}};
|
||||
|
||||
# convert to UTF-8 if necessary
|
||||
if ($LJ::UNICODE && $eprops->{'unknown8bit'} && !$opts->{'notranslation'}) {
|
||||
my $error;
|
||||
$e->{'subject'} = LJ::text_convert($e->{'subject'}, $u, \$error);
|
||||
$e->{'event'} = LJ::text_convert($e->{'event'}, $u, \$error);
|
||||
foreach (keys %{$eprops}) {
|
||||
$eprops->{$_} = LJ::text_convert($eprops->{$_}, $u, \$error);
|
||||
}
|
||||
}
|
||||
|
||||
if ($opts->{'currents'}) {
|
||||
$e->{'current_music'} = $eprops->{'current_music'};
|
||||
$e->{'current_mood'} = $eprops->{'current_mood'};
|
||||
if ($eprops->{'current_moodid'}) {
|
||||
my $mood = LJ::mood_name($eprops->{'current_moodid'})
|
||||
if $eprops->{'current_moodid'};
|
||||
$e->{'current_mood'} = $mood if $mood;
|
||||
}
|
||||
}
|
||||
|
||||
my $entry = dump_entry($e, $opts);
|
||||
|
||||
# now translate this to the chosen encoding but only if this is a
|
||||
# Unicode environment. In a pre-Unicode environment the chosen encoding
|
||||
# is merely a label.
|
||||
|
||||
if ($LJ::UNICODE && lc($opts->{'encoding'}) ne 'utf-8' && !$opts->{'notranslation'}) {
|
||||
$entry = Unicode::MapUTF8::from_utf8({-string=>$entry,
|
||||
-charset=>$opts->{'encoding'}});
|
||||
}
|
||||
|
||||
$r->print($entry);
|
||||
}
|
||||
}
|
||||
|
||||
sub dump_entry
|
||||
{
|
||||
my $e = shift;
|
||||
my $opts = shift;
|
||||
my $format = $opts->{'format'};
|
||||
my $entry = "";
|
||||
|
||||
my @vals = ();
|
||||
if ($format eq "xml") {
|
||||
$entry .= "<entry>\n";
|
||||
}
|
||||
|
||||
foreach my $f (@{$opts->{'fields'}})
|
||||
{
|
||||
my $v = $e->{$f};
|
||||
if ($format eq "csv") {
|
||||
if ($v =~ /[\"\n\,]/) {
|
||||
$v =~ s/\"/\"\"/g;
|
||||
$v = "\"$v\"";
|
||||
}
|
||||
}
|
||||
if ($format eq "xml") {
|
||||
$v = LJ::exml($v);
|
||||
}
|
||||
push @vals, $v;
|
||||
}
|
||||
if ($format eq "csv") {
|
||||
$entry .= join(",", @vals) . "\n";
|
||||
}
|
||||
if ($format eq "xml") {
|
||||
foreach my $f (@{$opts->{'fields'}}) {
|
||||
my $v = shift @vals;
|
||||
$entry .= "<$f>" . $v . "</$f>\n";
|
||||
}
|
||||
$entry .= "</entry>\n";
|
||||
}
|
||||
return $entry;
|
||||
}
|
||||
|
||||
|
||||
_code?><?_c <LJDEP>
|
||||
</LJDEP> _c?>
|
||||
BIN
local/htdocs/favicon-misha.ico
Executable file
BIN
local/htdocs/favicon-misha.ico
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
BIN
local/htdocs/favicon-petya.ico
Executable file
BIN
local/htdocs/favicon-petya.ico
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 5.1 KiB |
BIN
local/htdocs/favicon.ico
Executable file
BIN
local/htdocs/favicon.ico
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
65
local/htdocs/friends/pipiskomer.bml
Executable file
65
local/htdocs/friends/pipiskomer.bml
Executable file
@@ -0,0 +1,65 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET);
|
||||
|
||||
my @users; # users
|
||||
|
||||
my $fr = LJ::get_friends(20); # all friends of lj_fif
|
||||
return "Error fetching your friends" unless $fr;
|
||||
|
||||
my $LIMIT = 5000;
|
||||
my @ids = keys %$fr;
|
||||
splice(@ids, 0, $LIMIT) if @ids > $LIMIT;
|
||||
|
||||
my $fus = LJ::load_userids(@ids);
|
||||
@ids = grep { $fus->{$_}{journaltype} eq "P" } @ids;
|
||||
|
||||
my %count;
|
||||
|
||||
my $MAX_DELAY = 4;
|
||||
|
||||
my $start = time();
|
||||
while (@ids && time() < $start + $MAX_DELAY) {
|
||||
my $fid = shift @ids;
|
||||
my $fr = LJ::get_friends($fid);
|
||||
next unless $fr;
|
||||
$count{$_}++ foreach (keys %$fr);
|
||||
}
|
||||
|
||||
my @pop = sort { $count{$b} <=> $count{$a} } keys %count;
|
||||
|
||||
my $ret = "";
|
||||
|
||||
my $rows;
|
||||
my $MAX_DISPLAY = 150;
|
||||
my $shown;
|
||||
foreach my $popid (@pop) {
|
||||
last if ++$shown > $MAX_DISPLAY;
|
||||
my $u = LJ::load_userid($popid);
|
||||
my $count = $count{$popid};
|
||||
$rows .= "<tr><td>" . LJ::ljuser($u) . " - "
|
||||
. LJ::ehtml($u->{name}) .
|
||||
"</td><td align='right'>$count</td></tr>\n";
|
||||
}
|
||||
|
||||
if ($rows) {
|
||||
$ret .= "<table cellpadding='3'>\n";
|
||||
$ret .=
|
||||
"<tr><td><b>$ML{'.user'}</b></td><td><b>$ML{'.count'}</b></td></tr>\n";
|
||||
$ret .= $rows;
|
||||
$ret .= "</table>\n";
|
||||
|
||||
$ret .= $GET{'own'} ? "<?p $ML{'.exclude_own'} p?>" : "<?p
|
||||
$ML{'.include_own'} p?>";
|
||||
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
|
||||
96
local/htdocs/friends/popwithfriends.bml
Executable file
96
local/htdocs/friends/popwithfriends.bml
Executable file
@@ -0,0 +1,96 @@
|
||||
<?page
|
||||
title=><?_ml .title _ml?>
|
||||
body<=
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%GET);
|
||||
|
||||
# GET{own} = bool: include your own friends in the list
|
||||
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
unless ($remote) {
|
||||
# return $ML{'error.noremote'};
|
||||
}
|
||||
|
||||
# $remote=20;
|
||||
|
||||
if ($LJ::DISABLED{'friendspopwithfriends'}) {
|
||||
# FIXME: memcache this page. (memcache friendof)
|
||||
# return "This feature is disabled.";
|
||||
}
|
||||
|
||||
unless (LJ::get_cap($remote, "friendspopwithfriends")) {
|
||||
# return $ML{'.account_type'};
|
||||
}
|
||||
|
||||
# load remote's friends
|
||||
my @friends;
|
||||
my %type;
|
||||
|
||||
# TAG:fr:bml_friends_popwith:get_friends
|
||||
my $fr = LJ::get_friends($remote);
|
||||
return "Error fetching your friends" unless $fr;
|
||||
|
||||
my $LIMIT = 500;
|
||||
my @ids = keys %$fr;
|
||||
splice(@ids, 0, $LIMIT) if @ids > $LIMIT;
|
||||
|
||||
my $fus = LJ::load_userids(@ids);
|
||||
@ids = grep { $fus->{$_}{journaltype} eq "P" } @ids;
|
||||
|
||||
my %count;
|
||||
|
||||
my $MAX_DELAY = 4;
|
||||
|
||||
my $start = time();
|
||||
while (@ids && time() < $start + $MAX_DELAY) {
|
||||
my $fid = shift @ids;
|
||||
|
||||
my $fr = LJ::get_friends($fid);
|
||||
next unless $fr;
|
||||
$count{$_}++ foreach (keys %$fr);
|
||||
}
|
||||
|
||||
my @pop = sort { $count{$b} <=> $count{$a} } keys %count;
|
||||
|
||||
my $ret = $GET{'own'} ? "<?p $ML{'.intro_own'} p?>" : "<?p
|
||||
$ML{'.intro'} p?>";
|
||||
|
||||
my $rows;
|
||||
my $MAX_DISPLAY = 50;
|
||||
my $shown;
|
||||
foreach my $popid (@pop) {
|
||||
next if $fr->{$popid} && ! $GET{'own'};
|
||||
last if ++$shown > $MAX_DISPLAY;
|
||||
my $u = LJ::load_userid($popid);
|
||||
my $count = $count{$popid};
|
||||
$rows .= "<tr><td>" . LJ::ljuser($u) . " - "
|
||||
. LJ::ehtml($u->{name}) .
|
||||
"</td><td align='right'>$count</td></tr>\n";
|
||||
}
|
||||
|
||||
if ($rows) {
|
||||
$ret .= "<table cellpadding='3'>\n";
|
||||
$ret .=
|
||||
"<tr><td><b>$ML{'.user'}</b></td><td><b>$ML{'.count'}</b></td></tr>\n";
|
||||
$ret .= $rows;
|
||||
$ret .= "</table>\n";
|
||||
|
||||
$ret .= $GET{'own'} ? "<?p $ML{'.exclude_own'} p?>" : "<?p
|
||||
$ML{'.include_own'} p?>";
|
||||
|
||||
} else {
|
||||
$ret .= "<div style='margin-left:
|
||||
30px;'><i>$ML{'.no_users'}</i></div>\n";
|
||||
|
||||
$ret .= "<?p $ML{'.include_own'} p?>" unless $GET{'own'};
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
_code?>
|
||||
<=body
|
||||
page?>
|
||||
|
||||
67
local/htdocs/go.bml
Executable file
67
local/htdocs/go.bml
Executable file
@@ -0,0 +1,67 @@
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw($title $body %GET %POST);
|
||||
|
||||
$title = "";
|
||||
$body = "";
|
||||
|
||||
|
||||
# S2 Redirector, for Calendar view
|
||||
|
||||
if ($POST{'redir_type'} eq "monthview") {
|
||||
my $user = LJ::canonical_username($POST{'redir_user'});
|
||||
my $vhost;
|
||||
$vhost = $POST{'redir_vhost'} if $POST{'redir_vhost'}=~/users|tilde|community|front|other/;
|
||||
if ($vhost eq "other") {
|
||||
# FIXME: lookup their domain alias, and make vhost be "other:domain.com";
|
||||
}
|
||||
my $base = LJ::journal_base($user, $vhost);
|
||||
return $ML{'.error.redirkey'} unless $POST{'redir_key'} =~/^(\d\d\d\d)(\d\d)$/;
|
||||
my ($year, $month) = ($1, $2);
|
||||
return BML::redirect("$base/$year/$month/");
|
||||
}
|
||||
|
||||
|
||||
# prev/next talkread links
|
||||
|
||||
my $journal = $GET{'journal'};
|
||||
my $itemid = $GET{'itemid'}+0;
|
||||
my $dir= $GET{'dir'};
|
||||
|
||||
if ($journal && $itemid && $dir)
|
||||
{
|
||||
my $u = LJ::load_user($journal);
|
||||
|
||||
# sanity check
|
||||
unless ($u) {
|
||||
$body = $ML{'.error.usernotfound'};
|
||||
return;
|
||||
}
|
||||
|
||||
my $jumpid = LJ::get_itemid_near2($u, $itemid, $dir);
|
||||
|
||||
if ($jumpid) {
|
||||
return BML::redirect(LJ::journal_base($u) . "/$jumpid.html");
|
||||
|
||||
} else {
|
||||
$title = $ML{'.error.noentrytitle'};
|
||||
|
||||
if ($dir eq "next") {
|
||||
$body = $ML{'.error.noentry.next'};
|
||||
} elsif ($dir eq "prev") {
|
||||
$body = $ML{'.error.noentry.prev'};
|
||||
}
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
$title = $ML{'.defaulttitle'};
|
||||
$body = $ML{'.defaultbody'};
|
||||
|
||||
return;
|
||||
}
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?>
|
||||
97
local/htdocs/guidelines.html
Executable file
97
local/htdocs/guidelines.html
Executable file
@@ -0,0 +1,97 @@
|
||||
<title> Guidelines </title>
|
||||
<META content="text/html; charset=koi8-r" http-equiv=Content-Type>
|
||||
|
||||
<center>
|
||||
<table bgcolor="#9999BB"> <tr align="right"><td>
|
||||
<font color="#B00040"><small> <A HREF="tos.html">Правила</a> | <A
|
||||
HREF="ustav.html"> Устав</a> | Руководящие Принципы
|
||||
</small>
|
||||
</font>
|
||||
</td></tr> </table>
|
||||
</center>
|
||||
<h1> Руководящие принципы LJR (lj.rossia.org). </h1>
|
||||
|
||||
<h3> Декларация намерений </h3>
|
||||
|
||||
|
||||
<ul>
|
||||
<li> LJR - некоммерческий проект, созданный для поддержки
|
||||
свободы слова, развития гражданского общества и поощрения
|
||||
свободного обмена мнениями. <p>
|
||||
|
||||
<li> LJR - пространство, свободное от цензуры.
|
||||
Политическая, эстетическая и какая-либо другая
|
||||
цензура не допускается. Пользовательский дневник -
|
||||
личное веб-пространство пользователя, ограничивать
|
||||
его в высказывании своих мыслей в дневнике так же
|
||||
глупо (и гадко), как ограничивать кухонные
|
||||
разговоры, анекдоты и личную переписку. Если
|
||||
вам не нравится, что пишет такой-то пользователь,
|
||||
не читайте его.<p>
|
||||
|
||||
|
||||
<li> LJR - пространство, свободное от меритократии.
|
||||
Не предоставляется никаких административных
|
||||
преимуществ заслуженному блоггеру в сравнении
|
||||
с новичком. Заслуженному блоггеру достаточно
|
||||
преимуществ, предоставленных заслуженностью.<p>
|
||||
|
||||
|
||||
<li> LJR
|
||||
тотально подотчетен публике. Все жалобы начальству,
|
||||
равно как и решения по приостановке тех или иных журналов
|
||||
должны быть обязательно опубликованы.<p>
|
||||
|
||||
|
||||
<li> Основным содержанием сервера является
|
||||
контент, созданный пользователями. Баннерная реклама,
|
||||
продажа пользовательских е-мэйлов, навязывание
|
||||
коммерческих услуг абсолютно недопустимы в LJR.<p>
|
||||
|
||||
|
||||
<li> Бесплатный пользователь имеет столько же прав,
|
||||
сколько платный; основные функциональные возможности
|
||||
сервиса доступны им в равной степени.
|
||||
<p>
|
||||
|
||||
|
||||
<li> Закрытие дневников - крайняя мера, и без
|
||||
крайней необходимости к ней прибегать не будут.
|
||||
Любому пользователю (в том числе и закрытому) будет
|
||||
по первому требованию выдан архив его сообщений,
|
||||
в максимально удобочитаемом виде. Пользователь
|
||||
имеет право апелляции
|
||||
к <A HREF="http://lj.rossia.org/userinfo.bml?user=ljr_popechiteli"> Попечительскому Совету</a>,
|
||||
в соответствии с <A
|
||||
HREF="ustav.html">Уставом.</a><p>
|
||||
|
||||
|
||||
<li> Мы (администрация LJR)
|
||||
обязуемся сохранять частный характер
|
||||
частной (закрытой) информации, выложенной на сервер
|
||||
(кроме случаев, предусмотренных законом РФ и страны
|
||||
проживания пользователя). Также мы обязуемся
|
||||
любой ценой (и несмотря на убыточность проекта)
|
||||
поддерживать сервер в рабочем состоянии.<p>
|
||||
|
||||
<li> LJR - проект, построенный на принципах
|
||||
свободного программирования. Все разработки,
|
||||
ведущиеся в рамках LJR, опубликованы под свободной
|
||||
лицензией (GPL и ее аналогами) и доступны для
|
||||
использования.<p>
|
||||
|
||||
<li> В случае злостного нарушения администрацией изложенных
|
||||
принципов, Попечительский Совет вправе в любой момент
|
||||
забрать базу данных и все программное обеспечение LJR
|
||||
и поднять LJR на новом сервере.
|
||||
|
||||
|
||||
</ul>
|
||||
<center>
|
||||
<table bgcolor="#9999BB"> <tr align="right"><td>
|
||||
<font color="#B00040"><small>Правила</a> | <A
|
||||
HREF="ustav.html"> Устав</a> | Руководящие Принципы
|
||||
</small>
|
||||
</font>
|
||||
</td></tr> </table>
|
||||
</center>
|
||||
BIN
local/htdocs/img/blue_check.gif
Executable file
BIN
local/htdocs/img/blue_check.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 160 B |
BIN
local/htdocs/img/btn_addfriend.gif
Executable file
BIN
local/htdocs/img/btn_addfriend.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 288 B |
BIN
local/htdocs/img/btn_edit.gif
Executable file
BIN
local/htdocs/img/btn_edit.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 444 B |
BIN
local/htdocs/img/community-lj.gif
Executable file
BIN
local/htdocs/img/community-lj.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 163 B |
BIN
local/htdocs/img/community-npj.gif
Executable file
BIN
local/htdocs/img/community-npj.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 305 B |
BIN
local/htdocs/img/community.gif
Executable file
BIN
local/htdocs/img/community.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 271 B |
BIN
local/htdocs/img/imported-profile.gif
Executable file
BIN
local/htdocs/img/imported-profile.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 955 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/accomplished.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/accomplished.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 108 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/amused.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/amused.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 102 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/angry.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/angry.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 107 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/anxious.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/anxious.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 109 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/apathetic.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/apathetic.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 92 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/artistic.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/artistic.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 129 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/awake.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/awake.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 107 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/bitchy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/bitchy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 115 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/blank.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/blank.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 89 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/bouncy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/bouncy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 113 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/busy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/busy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 109 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/calm.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/calm.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 104 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/cold.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/cold.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 107 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/complacent.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/complacent.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 116 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/confused.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/confused.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 109 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/crazy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/crazy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 104 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/crushed.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/crushed.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 98 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/curious.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/curious.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 102 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/cynical.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/cynical.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 114 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/determined.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/determined.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 107 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/devious.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/devious.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 98 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/disappointed.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/disappointed.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 97 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/drained.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/drained.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 95 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/drunk.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/drunk.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 108 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/embarrassed.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/embarrassed.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 104 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/envious.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/envious.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 109 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/exanimate.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/exanimate.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 91 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/flirty.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/flirty.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 99 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/full.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/full.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 112 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/geeky.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/geeky.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 104 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/giddy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/giddy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 110 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/gloomy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/gloomy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 107 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/good.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/good.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 108 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/groggy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/groggy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 113 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/grumpy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/grumpy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 112 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/happy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/happy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 93 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/horny.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/horny.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 108 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/hot.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/hot.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 98 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/hungry.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/hungry.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 101 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/indescribable.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/indescribable.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 100 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/loved.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/loved.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 105 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/predatory.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/predatory.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 109 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/restless.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/restless.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 112 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/sad.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/sad.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 95 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/shocked.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/shocked.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 110 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/sick.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/sick.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 101 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/sleepy.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/sleepy.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 123 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/sore.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/sore.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 110 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/thoughtful.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/thoughtful.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 102 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/tired.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/tired.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 100 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/working.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/working.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 130 B |
BIN
local/htdocs/img/mood/bitospud/courier/black/worried.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/black/worried.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 96 B |
BIN
local/htdocs/img/mood/bitospud/courier/red/accomplished.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/red/accomplished.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 951 B |
BIN
local/htdocs/img/mood/bitospud/courier/red/amused.gif
Executable file
BIN
local/htdocs/img/mood/bitospud/courier/red/amused.gif
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 951 B |
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user