zlax/ljr
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

init

Browse Source
This commit is contained in:
ivan
2019-02-06 00:49:12 +03:00
commit 8dbb1bb605
4796 changed files with 506072 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

116
livejournal/htdocs/tools/emailmanage.bml Executable file
View File

@@ -0,0 +1,116 @@
<?page
title=><?_ml .title _ml?>
body<=
<?_code
{
use strict;
use vars qw(%GET %POST);
LJ::set_active_crumb('emailmanage');
my $dbh = LJ::get_db_writer();
my $remote = LJ::get_remote();
return LJ::bad_input($ML{'error.noremote'})
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 $firstdate = $dbh->selectrow_array(qq{
SELECT MIN(timechange) FROM infohistory
WHERE userid=? AND what='email'
AND oldvalue=?
}, undef, $u->{'userid'}, $u->{'email'});
my @deleted;
if (LJ::did_post() && $u->{'status'} eq 'A') {
my $sth = $dbh->prepare("SELECT timechange, oldvalue " .
"FROM infohistory WHERE userid=? " .
"AND what='email' ORDER BY timechange");
$sth->execute($u->{'userid'});
while (my ($time, $email) = $sth->fetchrow_array)
{
my $can_del = defined $firstdate && $time gt $firstdate;
if ($can_del && $POST{"$email-$time"}) {
push @deleted, BML::ml('.log.deleted',
{ 'email' => $email,
'time' => $time });
$dbh->do("UPDATE infohistory SET what='emaildeleted' WHERE what='email' " .
"AND userid=? AND timechange=? AND oldvalue=?",
undef, $u->{'userid'}, $time, $email);
}
}
}
my $ret;
# authas switcher form
$ret .= "<form method='get' action='emailmanage.bml'>\n";
$ret .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} }) . "\n";
$ret .= "</form>\n\n";
# some explanatory text
$ret .= "<?h1 $ML{'.desc.title'} h1?>\n";
$ret .= "<?p $ML{'.desc.text'} p?>\n";
$ret .= "<?p $ML{'.desc.notfirst'} p?>\n";
$ret .= "<?hr?>\n";
unless ($u->{'status'} eq "A") {
$ret .= "<?h1 $ML{'.notvalidated.title'} h1?>\n";
$ret .= "<?p " . BML::ml('.notvalidated.text',
{ 'email' => $u->{'email'} }) . " p?>";
return $ret;
}
# current address
$ret .= "<?h1 $ML{'.address.current.title'} h1?>\n";
$ret .= "<div style='margin: 20px 0 20px 30px;'><b>";
$ret .= "$u->{'email'}</b></div>\n";
# old addresses
$ret .= "<?h1 $ML{'.address.old.title'} h1?>\n";
$ret .= "<?p $ML{'.address.old.text'} p?>";
my $sth = $dbh->prepare("SELECT timechange, oldvalue FROM infohistory " .
"WHERE userid=? AND what='email' " .
"ORDER BY timechange");
$sth->execute($u->{'userid'});
my $rows;
while (my ($time, $email) = $sth->fetchrow_array)
{
my $can_del = defined $firstdate && $time gt $firstdate;
$rows .= "<tr><td>" . LJ::html_check({ 'type' => 'check', 'name' => "$email-$time",
'disabled' => ! $can_del } ) . "</td>";
$rows .= "<td>$email</td><td>$time</td></tr>\n";
}
if ($rows) {
my $getextra = $authas ne $remote->{'user'} ? "?authas=$authas" : '';
$ret .= "<form method='post' action='emailmanage.bml$getextra'>";
$ret .= "<table border='1' cellpadding='2' style='margin-bottom: 3px;'>\n";
$ret .= $rows;
$ret .= "</table>\n";
$ret .= LJ::html_submit(undef, $ML{'.delete_selected'});
$ret .= "</form>";
} else {
$ret .= "<div style='margin-left: 30px; margin-top: 10px'><i>$ML{'.address.old.none'}</i></div>\n";
}
if (@deleted) {
$ret .= "<?h1 $ML{'.log.deleted.title'} h1?>\n";
$ret .= "<ul>";
$ret .= "<li>$_</li>\n" foreach @deleted;
$ret .= "</ul>";
}
return $ret;
}
_code?>
<=body
page?>

0
livejournal/htdocs/tools/index.bml Executable file
View File

335
livejournal/htdocs/tools/memadd.bml Executable file
View File

@@ -0,0 +1,335 @@
<?_code
use strict;
use vars qw(%GET %POST $title $body);
my $dbr = LJ::get_db_reader();
$title = $ML{'.title'};
$body = "";
my $err = sub {
$title = "Error";
$body = LJ::bad_input(@_);
return;
};
$POST{'oldkeywords'} = [ split('\0', $POST{'oldkeywords'}) ];
unless (LJ::text_in(\%POST)) {
return $err->("Invalid UTF-8 Input");
}
my $remote = LJ::get_remote();
return $err->($ML{'error.noremote'})
unless $remote;
my $authas = $GET{'authas'} || $remote->{'user'};
my $memoryu = LJ::get_authas_user($authas);
return $err->($ML{'error.invalidauth'})
unless $memoryu;
my %secopts = ( 'public' => $ML{'label.security.public'},
'friends' => $ML{'label.security.friends'},
'private' => $ML{'label.security.private'}, );
if ($memoryu->{'journaltype'} eq "C") {
$secopts{'private'} = $ML{'label.security.maintainers'};
$secopts{'friends'} = $ML{'label.security.members'};
}
my $sth;
my $journal = $GET{'journal'};
my $ditemid = $GET{'itemid'}+0;
# OK. the memories schema is weird and stores *display* itemids in the database.
# additionally, we distinguish precluster itemids because they're stored without a userid.
# it's too late to fix it in the db, so we just work around it--
# all new memories still get userid+ditemid because we can't change the ditemid/itemid problem,
# but old-style itemids get fixed up to userid+ditemid.
# *however*, when editing old itemids we need to keep around
# the old-style ditemid so we can still edit it.
# to keep this all sorted out, we fixup variables like this:
# - itemid -- real, new-style itemid
# - ditemid -- display itemid (with anum)
# - dbitemid -- itemid that is in the database;
# usually same as ditemid, but different for old-style itemids.
my $dbitemid = $ditemid;
my $itemid;
my $oldstyle = 0;
my $ju;
my $jid;
my $anum;
if ($journal) {
$ju = LJ::load_user($journal);
$jid = $ju->{'userid'};
$anum = $ditemid % 256;
$itemid = int($ditemid / 256);
} else {
# old-style item url?
my $newids = LJ::get_newids('L', $ditemid);
if ($newids) {
($jid, $itemid) = @$newids;
$ju = LJ::load_userid($jid);
$oldstyle = 1;
}
}
unless ($ju && $itemid) {
$title = $ML{'Error'};
$body = $ML{'error.nojournal'};
return;
}
my $dbcr = LJ::get_cluster_reader($ju);
my $log = LJ::get_log2_row($ju, $itemid);
unless ($log) {
$title = $ML{'Error'};
$body = "Error retrieving data to add a memory.";
return;
}
my $subject = LJ::get_logtext2($ju, $itemid)->{$log->{jitemid}}[0];
# if the entry is pre-UTF-8 conversion, the
# subject may need conversion into UTF-8
if ($LJ::UNICODE) {
my %props = ();
LJ::load_log_props2($dbcr, $log->{'journalid'}, [ $itemid ], \%props);
if ($props{$itemid}->{'unknown8bit'}) {
my $u = LJ::load_userid($log->{'journalid'});
my ($error, $subj);
$subj = LJ::text_convert($subject, $u, \$error);
$subject = $subj unless $error;
}
LJ::text_out(\$subject);
}
# check to see if it already is memorable (thus we're editing, not adding);
my $memory = LJ::Memories::get_by_ditemid($memoryu, $oldstyle ? 0 : $jid, $ditemid);
if ($oldstyle) {
# ditemid was an old-style itemid, so we update it to the new style.
$anum = $log->{anum};
$ditemid = $itemid<<8 + $anum;
}
# get keywords user has used
my $exist_kw = LJ::Memories::get_keywords($memoryu);
unless ($exist_kw) {
$title = $ML{'Error'};
$body = "Error fetching existing keywords.";
return;
}
if ($POST{'mode'} eq "")
{
my ($des, $keywords);
my @all_keywords;
my %selected_keyword;
@all_keywords = sort values %$exist_kw;
if (defined $memory) {
$title = $ML{'.title.edit_memory'};
$des = $memory->{'des'};
my $kwids = LJ::Memories::get_keywordids($memoryu, $memory->{memid}) || [];
foreach my $kwid (@$kwids) {
my $kw = $exist_kw->{$kwid};
next if ($kw eq "*");
if ($keywords) { $keywords .= ", "; }
$keywords .= $kw;
$selected_keyword{$kw} = 1;
}
if (!$log || ($jid && $log->{'anum'} != $anum))
{
LJ::Memories::delete_by_id($memoryu, $memory->{memid});
LJ::Memories::updated_keywords($memoryu);
$title = $ML{'Error'};
$body = $ML{'.error.entry_deleted'};
return;
}
}
elsif (!$log || ($jid && $log->{'anum'} != $anum))
{
$title = $ML{'Error'};
$body = $ML{'error.noentry'};
return;
}
else
{
$title = $ML{'.title.add_memory'};
# this is a new memory.
my $user = LJ::get_username($log->{'journalid'});
my $dt = substr($log->{'eventtime'}, 0, 10);
$des = "$dt: $user: $subject";
}
# it'd be nice to only show the authas form when adding an entry and not
# when editing one, but if user u is logged in and has post p as a memory
# already then wants to add it to community c, when u clicks the "add memory"
# link on p, u gets the "edit entry" page and they need to be able to switch
# to c.
$body .= "<form method='get' action='memadd.bml'>\n";
$body .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} }) . "\n";
$body .= LJ::html_hidden(journal => $GET{journal}) if $GET{journal};
$body .= LJ::html_hidden(itemid => $GET{itemid});
$body .= "</form>\n\n";
LJ::text_out(\$des);
LJ::text_out(\$keywords);
$body .= $ML{'.add_previous'};
my $getextra = "?itemid=$dbitemid";
$getextra .= "&amp;authas=$authas" if $authas ne $remote->{'user'};
# we still need to pass the dbitemid and not the itemid to ourself.
$getextra .= "&amp;journal=$journal" unless $oldstyle;
$body .= "<form method='post' action='memadd.bml$getextra'>";
$body .= LJ::html_hidden(mode => "save");
$body .= "<table cellpadding='4'>";
$body .= "<tr><th align='right' valign='top'>$ML{'.description'}</th><td>";
$body .= LJ::html_text({name => 'des', value => $des, maxlength => LJ::CMAX_MEMORY, size => 40});
$body .= "<br /><small>$ML{'.description.text'}</small></td></tr>";
$body .= "<tr><th align='right' valign='top'>$ML{'.keywords'}</th><td>";
$body .= LJ::html_text({name => 'keywords', maxlength => LJ::CMAX_KEYWORD, size => 40, value => $keywords});
$body .= "<br /><small>$ML{'.keywords.text'}</small><br />";
if (@all_keywords) {
my $size = scalar(@all_keywords);
$size = 15 if $size > 15;
$body .= "<small>$ML{'.keywords.select'}</small><div style='margin-left: 30px;'>";
$body .= LJ::html_select( { name => 'oldkeywords', size => $size, multiple => 1,
selected => [ keys %selected_keyword ], noescape => 1 },
map { (LJ::ehtml($_), LJ::ehtml($_)) } @all_keywords);
$body .= "</div><small>$ML{'.multiple_selections'}</small>";
} else {
$body .= "<small>$ML{'.keywords.example'}</small>";
}
$body .= "</td></tr>\n";
$body .= "<tr><th align='right' valign='top'>$ML{'.security'}</th><td>";
$body .= LJ::html_select({name => 'security', selected => defined $memory ? $memory->{'security'} : undef},
map { ($_, $secopts{$_}) } qw(public friends private));
if ($memoryu->{'journaltype'} eq "C") {
$body .= "<br /><small>$ML{'.whocansee.comm'}</small></td></tr><tr><th></th><td>\n";
} else {
$body .= "<br /><small>$ML{'.whocansee'}</small></td></tr><tr><th></th><td>\n";
}
$body .= LJ::html_submit(undef, $ML{'.form.submit'});
$body .= LJ::html_submit(undef, $ML{'.form.reset'}, {type => 'reset'}) if defined $memory;
$body .= "</td></tr></table></form>";
return;
}
if ($POST{'mode'} eq "save")
{
my $dbh = LJ::get_db_writer();
if (! $POST{'des'}) {
# then we're deleting.
if (defined $memory) {
LJ::Memories::delete_by_id($memoryu, $memory->{memid});
LJ::Memories::updated_keywords($memoryu);
$title = $ML{'.title.deleted'};
$body = "<?h1 $ML{'.error.deleted.title'} h1?><?p " .
BML::ml(".error.deleted.body", { 'desc' => $memory->{'des'} }) .
"p?>";
return;
} else {
$title = $ML{'Error'};
$body = "<?h1 $ML{'.error.nodescription.title'} h1?><?p ";
$body .= BML::ml('.error.nodescription.body');
$body .= " p?>";
return;
}
}
#### we're inserting/replacing now into memories
my @keywords;
{
my %kws;
foreach (split(/\s*,\s*/, $POST{'keywords'})) { $kws{$_} = 1; }
# oldkeywords were split at the beginning
foreach (@{$POST{'oldkeywords'}}) { $kws{$_} = 1; }
@keywords = keys %kws;
}
if (scalar(@keywords) > 5) {
$title = $ML{'Error'};
$body = "<?h1 $ML{'Error'} h1?><?p $ML{'.error.fivekeywords'} p?>";
return;
}
@keywords = grep { $_ } map { s/\s\s+/ /g; LJ::trim($_); } @keywords;
push @keywords, "*" unless (@keywords);
my @kwid;
my $needflush = 0;
foreach my $kw (@keywords) {
if (length($kw) > 40) {
$title = $ML{'Error'};
$body = "<?h1 $ML{'Error'} h1?><?p " .
BML::ml(".error.maxsize", { 'keyword' => LJ::ehtml($kw) }) . "p?>";
return;
}
my $kwid = LJ::get_keyword_id($memoryu, $kw);
$needflush = 1 unless defined $exist_kw->{$kwid};
push @kwid, $kwid;
}
unless (exists $secopts{$POST{'security'}}) {
$title = $ML{'Error'};
$body = $ML{'.error.invalid_security'};
return;
}
my $des = LJ::text_trim($POST{'des'}, LJ::BMAX_MEMORY, LJ::CMAX_MEMORY);
my $sec = $POST{'security'};
# handle edits by deleting the old memory and recreating
LJ::Memories::delete_by_id($memoryu, $memory->{memid})
if defined $memory;
LJ::Memories::create($memoryu, {
journalid => $jid,
ditemid => $ditemid,
des => $des,
security => $sec,
}, \@kwid);
LJ::Memories::updated_keywords($memoryu) if $needflush;
$title = $ML{'.title.added'};
$body = "<?h1 $ML{'.body.added.header'} h1?><?p ";
my $backlink = LJ::item_link($ju->{user}, $itemid, $anum);
$body .= BML::ml('.body.added.body2', {'aopts' => "href='$backlink'"});
$body .= " p?>";
return;
}
$title = $ML{'Error'};
$body = $ML{'error.unknownmode'};
return;
_code?>
<?page
title=><?_code return $title; _code?>
body=> <?_code return $body; _code?>
page?>
<?_c <LJDEP>
link: htdocs/login.bml
post: htdocs/tools/memadd.bml
</LJDEP> _c?>

291
livejournal/htdocs/tools/memories.bml Executable file
View File

@@ -0,0 +1,291 @@
<?_code
use strict;
use vars qw(%POST %GET $head $title $body);
LJ::set_active_crumb('memories');
my $dbr = LJ::get_db_reader();
my $remote = LJ::get_remote();
my $sth;
$title = "";
$head = "";
$body = "";
my $dberr = sub {
$title = $ML{'Error'};
$body = $ML{'error.nodb'};
return undef;
};
# Find out if a 'user' argument is specified in the URL.
my $user = LJ::canonical_username($GET{'user'});
if ($GET{'user'} && ! $user) {
$body = $ML{'error.malformeduser'};
return;
}
# Find out if an 'authas' argument is specified in the URL.
# If not, try to authenticate as 'user'. If still no success, use $remote.
my $authasu = LJ::get_authas_user(LJ::canonical_username($GET{'authas'}) || $user);
my $authasarg;
my $authasarge;
unless (LJ::did_post()) {
if ($authasu) {
$body .= "<form method='get' action='memories.bml'>\n";
$body .= LJ::make_authas_select($remote, { 'authas' => $authasu->{user} }) . "\n";
$body .= LJ::html_hidden(keyword => $GET{keyword}) if $GET{keyword};
$body .= "</form>\n\n";
$user ||= $authasu->{user};
$authasarg = "&authas=$authasu->{user}";
$authasarge = "&amp;authas=$authasu->{user}";
} else {
$authasu = $remote;
}
}
# Now, whose memories page do we actually want to see?
# - if 'user' is specified, we want to see theirs
# (in this case, $user has already been set to that)
# - if no 'user', but 'authas' is specified, we want to see authas's
# (in this case, $user has been set to $authasu->{user} above
# - if neither is specified, we want to see remote's:
if ($user eq "" && defined $remote) {
$user = $remote->{'user'};
}
my $u = LJ::load_user($user);
unless ($u) {
# There is no 'authas' OR $remote.
# If there's a 'user', that user doesn't exist.
# Otherwise, complain about the absence of 'user' / suggest logging in.
$title = $ML{'Error'};
$body = $user eq "" ? BML::ml('.login', { 'aopts' => 'href="/login.bml?ret=1"' })
: $ML{'error.username_notfound'};
return;
}
# owner if you've authed as them or you administrate them
my $is_owner = $authasu && $user eq $authasu->{user} ||
LJ::can_manage_other($remote, $u);
my $userid = $u->{'userid'};
if ($u->{'journaltype'} eq "R") {
LJ::load_user_props($u, "renamedto");
return BML::redirect("/tools/memories.bml?user=$u->{'renamedto'}$authasarg");
}
LJ::load_user_props($u, "opt_blockrobots") if $u->{'statusvis'} eq 'V';
unless ($u->{'statusvis'} eq 'V' && ! $u->{'opt_blockrobots'}) {
$head = LJ::robot_meta_tags();
}
if ($u->{'statusvis'} eq "S") {
$title = $ML{'error.suspended.title'};
$body = "<?h1 $ML{'error.suspended.name'} h1?><?p " . BML::ml('error.suspended.text',{'sitename'=>$LJ::SITENAME,'user'=>$user}) . " p?>";
return;
}
if ($u->{'statusvis'} eq "D") {
$title = $ML{'error.deleted.title'};
$body = "<?h1 $ML{'error.deleted.name'} h1?><?p " . BML::ml('error.deleted.text',{'user'=>$user}) . " p?>";
return;
}
if ($u->{'statusvis'} eq "X") {
$title = $ML{'error.purged.title'};
$body = "<?h1 $ML{'error.purged.name'} h1?><?p $ML{'error.purged.text'} p?>";
return;
}
if (LJ::did_post()) {
unless ($is_owner) {
$title = $ML{'Error'};
$body = "<?p $ML{'error.invalidauth'} p?>\n";
return;
}
my @to_delete = ();
foreach (keys %POST) {
push @to_delete, $1 if /^select_mem_(\d+)$/;
}
unless (@to_delete) {
$title = $ML{'Error'};
$body = "<?p $ML{'.delete.error.noneselected'} p?>";
return;
}
# delete them!
LJ::Memories::delete_by_id($authasu, \@to_delete);
$title = $ML{'.delete.deleted.title'};
$body = "<?h1 $ML{'.delete.deleted.head'} h1?><?p ";
$body .= BML::ml('.delete.deleted.text', { aopts => "href='./memories.bml?user=$authasu->{user}'" }) . " p?>";
return;
}
my %filters = ("all" => $ML{'.filter.all'},
"own" => BML::ml(".filter.own", { 'user' => $user }),
"other" => $ML{'.filter.other'});
my $filter = $GET{'filter'} || "all";
unless (defined $filters{$filter}) { $filter = "all"; }
my %sorts = ('memid' => $ML{'.sort.orderadded'},
'des' => $ML{'.sort.description'},
'user' => $ML{'.sort.journal'});
my $sort = ($GET{'sortby'} || 'memid');
unless (defined $sorts{$sort}) { $sort = 'memid'; }
# keys must be the same as those of %sorts
my %sortfunc = ('memid' => sub {
sort { $a->{'memid'} <=> $b->{'memid'} } @_;
},
'des' => sub {
sort { $a->{'des'} cmp $b->{'des'} } @_;
},
'user' => sub {
sort { $a->{'user'} cmp $b->{'user'} ||
$a->{'des'} cmp $b->{'des'} } @_;
});
my $securities = ['public'];
if ($authasu) {
if ($is_owner) {
$securities = [];
} elsif ($authasu->{'journaltype'} eq 'P' and LJ::is_friend($userid, $authasu->{'userid'})) {
$securities = ['public', 'friends'];
}
}
my $kwmap = LJ::Memories::get_keywords($u);
return $dberr->() unless defined $kwmap;
if ($GET{'keyword'})
{
if ($GET{'keyword'} eq "*") {
$title = $ML{'.title.memorable'};
$body .= "<?h1 $ML{'.title.memorable'} h1?><?p " . BML::ml(".body.memorable", { 'user' => $user }) . " p?>";
} else {
my $ekw = LJ::ehtml($GET{'keyword'});
$title = BML::ml(".title.keyword", { 'keyword' => $ekw, 'user' => $user });
$body .= BML::ml(".body.keyword", { 'keyword' => $ekw, 'user' => $user });
}
$body .= "<form method='get' action='memories.bml'>";
$body .= LJ::html_hidden(keyword => $GET{keyword}) if $GET{keyword};
$body .= LJ::html_hidden(user => $GET{user}) if $GET{user};
$body .= LJ::html_hidden(authas => $GET{user}) if $GET{authas};
$body .= "$ML{'.form.sort'} <select name='sortby'>";
foreach my $sorttype (qw(memid des user)) {
my $sel = $sort eq $sorttype ? 'selected="selected"' : '';
$body .= "<option id='$sorttype' value='$sorttype' $sel>$sorts{$sorttype}</option>\n";
}
$body .= "</select> <input type='submit' value='$ML{'.form.switch'}' />";
$body .= "</form>\n";
$body .= "<a href=\"/tools/memories.bml?user=$user$authasarge\">&lt;&lt; $ML{'.back'}</a>";
my $key_id;
foreach (keys %$kwmap) {
$key_id = $_ if $kwmap->{$_} eq $GET{keyword};
}
my $memoryhash = LJ::Memories::get_by_keyword($u, $key_id,
{ security => $securities, filter => $filter });
return $dberr->() unless defined $memoryhash;
my @jids = map { $_->{journalid} } values %$memoryhash;
my $us = LJ::load_userids(@jids);
my @memories = $sortfunc{$sort}->( values %$memoryhash );
$body .= "<form method='post' action='./memories.bml?user=$user$authasarge'>\n"
if $is_owner && $GET{multidelete};
$body .= "<ul>\n";
foreach my $mem (@memories) {
my $user = $us->{$mem->{journalid}}{user};
my $eh_des = LJ::ehtml($mem->{'des'});
LJ::text_out(\$eh_des);
my ($entrylink, $editlink);
if ($user) {
my $itemid = int($mem->{'ditemid'} / 256);
my $anum = $mem->{'ditemid'} % 256;
$entrylink = LJ::item_link($user, $itemid, $anum);
$editlink = "/tools/memadd.bml?journal=$user&amp;itemid=$mem->{ditemid}$authasarge";
} else {
$entrylink = "/talkread.bml?itemid=$mem->{ditemid}";
$editlink = "/tools/memadd.bml?itemid=$mem->{ditemid}$authasarge";
}
my $edit = "";
my $delete = "";
if ($is_owner) {
$edit = " [<a href=\"$editlink\">$ML{'.edit'}</a>]";
$delete = LJ::html_check({ type => 'check', name => "select_mem_$mem->{memid}", value => 1 })
if $GET{multidelete};
}
my %icons = (
'friends' => "<?securityprotected?>",
'private' => "<?securityprivate?>",
);
$body .= "<p><li>$delete <a href=\"$entrylink\"><b>$eh_des</b></a> $edit $icons{$mem->{security}}<br /><font size='-1'><b>$user</b></font></li>";
}
$body .= "</ul>";
if ($is_owner && $GET{multidelete}) {
$body .= LJ::html_submit(undef, $ML{'.delete'},
{ onclick => "return confirm('" . LJ::ejs($ML{'.delete.confirm'}) . "')" });
$body .= "</form>\n";
}
return;
}
$title = $ML{'.title.memorable'};
$body .= BML::ml(".body.list_categories", { 'user' => $user });
my $rows = LJ::Memories::get_keyword_counts($u, { security => $securities, filter => $filter });
return $dberr->() unless defined $rows;
my @sortedrows;
push @sortedrows, { keyword => $kwmap->{$_}, count => $rows->{$_} }
foreach keys %{$rows || {}};
@sortedrows = sort { $a->{'keyword'} cmp $b->{'keyword'} } @sortedrows;
$body .= "<form method='get' action='memories.bml'>";
$body .= "<input type='hidden' name='user' value=\"$user\" />";
$body .= "$ML{'.form.filter'} <select name=\"filter\">";
foreach my $filt ("all", "own", "other") {
my $sel = $filter eq $filt ? "selected='selected'" : "";
$body .= "<option value=\"$filt\" $sel>$filters{$filt}</option>\n";
}
$body .= "</select> <input type='submit' value=\"$ML{'.form.switch'}\" />";
$body .= "</form>";
unless (@sortedrows) {
$body .= "<?h1 $ML{'.error.noentries.title'} h1?><?p $ML{'.error.noentries.body'} p?>";
} else {
$body .= "<ul>";
foreach my $row (@sortedrows) {
my $noun = BML::ml(".plur_entry", {'num' => $row->{'count'}});
my $ue_keyword = LJ::eurl($row->{'keyword'});
my $keyword = $row->{'keyword'};
LJ::text_out(\$keyword);
if ($keyword eq "*") { $keyword = $ML{'.uncategorized'}; }
else { $keyword = LJ::ehtml($keyword); }
$body .= "<li><b><a href=\"/tools/memories.bml?user=$user&amp;keyword=$ue_keyword&amp;filter=$filter\">$keyword</a></b>: $noun\n</li>";
}
$body .= "</ul>";
}
return;
_code?><?page
title=><?_code return $title; _code?>
head=><?_code return $head; _code?>
body<=
<?_code return $body; _code?>
<=body
page?><?_c <LJDEP>
link: htdocs/tools/memories.bml, htdocs/tools/memadd.bml, htdocs/talkread.bml
form: htdocs/tools/memories.bml
</LJDEP> _c?>

266
livejournal/htdocs/tools/recent_comments.bml Executable file
View File

@@ -0,0 +1,266 @@
<?page
title=>Recent Comments
head<=
<script src='/js/commentmanage.js'></script>
<=head
body<=
<?_code
{
use strict;
use vars qw(%GET %POST);
my $ret;
my %LJ_cmtinfo;
my $remote = LJ::get_remote();
return LJ::bad_input($ML{'error.noremote'})
unless $remote;
$LJ_cmtinfo{'canAdmin'} = 1;
$LJ_cmtinfo{'remote'} = $remote->{user};
$LJ_cmtinfo{'journal'} = $remote->{user};
my $authas = $GET{'authas'} || $remote->{'user'};
my $u = LJ::get_authas_user($authas);
return LJ::bad_input($ML{'error.invalidauth'})
unless $u;
my $user = $u->{'user'};
my $dbcr = LJ::get_cluster_reader($u);
return "Error: can't get DB for user" unless $dbcr;
my $count = LJ::get_cap($u, "tools_recent_comments_display");
# authas switcher form
$ret .= "<form method='get' action='/tools/recent_comments.bml'>\n";
$ret .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'} }) . "\n";
$ret .= "</form>\n\n";
my (@recv, @posted, %talkids);
my %need_userid;
my %logrow; # "jid nodeid" -> $logrow
my %need_logids; # hash of "journalid jitemid" => [journalid, jitemid]
my $now = time();
my $sth;
my $jargent ="journal=$u->{'user'}&amp;";
# Retrieve received
{
my $max = $dbcr->selectrow_array("SELECT MAX(jtalkid) FROM talk2 WHERE journalid=?",
undef, $u->{userid});
$sth = $dbcr->prepare("SELECT jtalkid, nodetype, nodeid, parenttalkid, ".
" posterid, UNIX_TIMESTAMP(datepost) as 'datepostunix', state ".
"FROM talk2 ".
"WHERE journalid=? AND jtalkid > ?");
$sth->execute($u->{userid}, $max - $count);
die $dbcr->errstr if $dbcr->err;
while (my $r = $sth->fetchrow_hashref) {
$need_userid{$r->{posterid}} = 1 if $r->{posterid};
push @recv, $r;
$talkids{$r->{jtalkid}} = 1;
$need_logids{"$u->{userid} $r->{nodeid}"} = [$u->{userid}, $r->{nodeid}]
if $r->{nodetype} eq "L";
}
}
# Retrieve posted
if ($u->{journaltype} eq "P") {
$sth = $dbcr->prepare("SELECT posttime, journalid, nodetype, nodeid, jtalkid, publicitem ".
"FROM talkleft ".
"WHERE userid=? ORDER BY posttime DESC LIMIT $count");
$sth->execute($u->{'userid'});
my %jcount; # jid -> ct
$ret .= "<table style='width: 50%'>";
while (my $r = $sth->fetchrow_hashref) {
push @posted, $r;
$need_logids{"$r->{journalid} $r->{nodeid}"} = [$r->{journalid}, $r->{nodeid}]
if $r->{nodetype} eq "L";
$need_userid{$r->{journalid}} = 1;
}
}
$ret .= "<div style='text-align: center'><a name='received'></a>" .
BML::ml('ActionLink', { 'link' => "Latest Received"}) . " " .
BML::ml('Actionlink', { 'link'=>"<a href='#posted'>Latest Posted</a>"}) . "</div>" if $u->{journaltype} eq "P";
$ret .= "<?h1 Latest Received h1?>";
$ret .= "<?p " . (%talkids ? "Last $count comments posted in " : "No comments have been posted in ") . LJ::ljuser($u) . " p?>";
@recv = sort { $b->{datepostunix} <=> $a->{datepostunix} } @recv;
my @recv_talkids = map { $_->{'jtalkid'} } @recv;
my %props;
LJ::load_talk_props2($u->{'userid'}, \@recv_talkids, \%props);
my $us = LJ::load_userids(keys %need_userid);
# setup the parameter to get_logtext2multi
my $need_logtext = {};
foreach my $need (values %need_logids) {
my $ju = $us->{$need->[0]};
next unless $ju;
push @{$need_logtext->{$ju->{clusterid}} ||= []}, $need;
}
my $comment_text = LJ::get_talktext2($u, keys %talkids);
my $log_text = LJ::get_logtext2multi($need_logtext);
my $root = LJ::journal_base($u);
$ret .= "<table style='width: 100%' cellpadding='5' cellspacing='0'>";
foreach my $r ( @recv) {
next unless $r->{nodetype} eq "L";
next if $r->{state} eq "D";
my $pu = $us->{$r->{posterid}};
next if $pu->{statusvis} =~ /[XS]/;
$r->{'props'} = $props{$r->{'jtalkid'}};
my $lrow = $logrow{"$u->{userid} $r->{nodeid}"} ||= LJ::get_log2_row($u, $r->{'nodeid'});
my $talkid = ($r->{'jtalkid'} << 8) + $lrow->{'anum'};
my $ditemid = "$root/$lrow->{ditemid}.html";
my $talkurl = "$root/$lrow->{ditemid}.html?thread=$talkid\#t$talkid";
my $bgcolor = "transparent";
my $state = "";
if ($r->{state} eq "S") {
$bgcolor = BML::fill_template("screenedbarcolor");
$state = "Screened";
} elsif ($r->{state} eq "D") {
$state = "Deleted";
} elsif ($r->{state} eq "F") {
$state = "Frozen";
}
my $ljcmt = $LJ_cmtinfo{$talkid} = {};
$ljcmt->{u} = $pu ? $pu->{user} : "";
$ret .= "<tr valign='top' id='ljcmtbar$talkid'><td style='width: 150px; line-height: 1.5em; border-top: 1px solid #999; background-color: $bgcolor' id='cmtbar$talkid'>";
$ret .= ($pu ? LJ::ljuser($pu) : "Anonymous") . "<br />";
$ret .= LJ::ago_text($now - $r->{datepostunix}) . "<br />";
$ret .= "<div id='state$talkid'>$state</div>" if $r->{state} ne "D";
unless ($r->{state} eq "D")
{
$ret .= "<a href='/delcomment.bml?${jargent}id=$talkid'>" . LJ::img("btn_del", "", { 'align' => 'absmiddle', 'hspace' => 2, 'vspace' => }) . "</a>";
if ($r->{'state'} ne 'F') {
$ret .= "<a href='/talkscreen.bml?mode=freeze&amp;${jargent}talkid=$talkid'>" . LJ::img("btn_freeze", "", { align => 'absmiddle', hspace => 2, vspace => }) . "</a>";
}
if ($r->{'state'} eq 'F') {
$ret .= "<a href='/talkscreen.bml?mode=unfreeze&amp;${jargent}talkid=$talkid'>" . LJ::img("btn_unfreeze", "", { align => 'absmiddle', hspace => 2, vspace => }) . "</a>";
}
if ($r->{'state'} ne 'S') {
$ret .= "<a href='/talkscreen.bml?mode=screen&amp;${jargent}talkid=$talkid'>" . LJ::img("btn_scr", "", { 'align' => 'absmiddle', 'hspace' => 2, 'vspace' => }) . "</a>";
}
if ($r->{'state'} eq 'S') {
$ret .= "<a href='/talkscreen.bml?mode=unscreen&amp;${jargent}talkid=$talkid'>" . LJ::img("btn_unscr", "", { 'align' => 'absmiddle', 'hspace' => 2, 'vspace' => }) . "</a>";
}
}
# FIXME: (David?) We'll have to make talk_multi.bml understand jtalkids in multiple posts
#$ret .= " <nobr><input type='checkbox' name='selected_$r->{jtalkid}' id='s$r->{jtalkid}' />";
#$ret .= " <label for='s$r->{jtalkid}'>$ML{'/talkread.bml.select'}</label></nobr>";
$ret .= "</td><td id='ljcmt$talkid' style='text-align: left; border-top: 1px solid #999; border-left: 1px solid #999'>";
my $subject = $log_text->{"$u->{userid} $r->{nodeid}"}[0];
LJ::CleanHTML::clean_subject(\$subject) if $subject ne "";
$ret .= "<strong style='float: left; text-decoration: underline'>$subject</strong> " if $subject ne "";
$ret .= "<strong style='float: right'>(<a href='$ditemid'>Entry Link</a>)</strong>" unless $lrow->{ditemid} == undef;
$ret .= "<br /><br />";
my $subject = $comment_text->{$r->{jtalkid}}[0];
LJ::CleanHTML::clean_subject(\$subject);
if ($subject && $subject !~ /^Re:\s*$/) {
$ret .= "<cite>$subject</cite><br />";
}
my $comment = $comment_text->{$r->{jtalkid}}[1];
LJ::CleanHTML::clean_comment(\$comment, { 'preformatted' => $r->{'props'}->{'opt_preformatted'},
'anon_comment' => !$pu });
$ret .= "$comment<br /><br />";
$ret .= "(<a href='$talkurl'>Comment Link</a>) " unless $r->{state} eq "D" || $lrow->{ditemid} == undef;
my $stylemine = 0;
my $replyurl = LJ::Talk::talkargs($ditemid, "replyto=$talkid", $stylemine);
if ($lrow->{ditemid} == undef) {
$ret .= "<strong>(Post Deleted)</strong>";
} elsif ($r->{'state'} eq 'F') {
$ret .= "($ML{'talk.frozen'}) ";
} elsif ($r->{'state'} eq "D") {
$ret .= "<strong>(Comment Deleted)</strong>";
} else {
$ret .= "(<a href='$replyurl'>$ML{'talk.replytothis'}</a>) ";
}
$ret .= "</td></tr>";
}
$ret .= "</table>";
$ret .= "<?p " . BML::ml('/tools/recent_comments.bml.maxnotshown',
{ 'current' => $count, 'max' => $LJ::TOOLS_RECENT_COMMENTS_MAX }).
" p?>" unless $count == $LJ::TOOLS_RECENT_COMMENTS_MAX;
if ($u->{journaltype} eq "P") {
$ret .= "<div style='text-align: center; margin-top: 1em'><a name='posted'></a>" .
BML::ml('Actionlink', { 'link'=>"<a href='#received'>Latest Received</a>"}) .
BML::ml('ActionLink', { 'link' => "Latest Posted"}) . " " .
"</div>";
$ret .= "<?h1 Latest Posted h1?><?p Last $count comments " . LJ::ljuser($u) . " has posted. p?>";
my %jcount; # jid -> ct
$ret .= "<table style='text-align: left'>";
$ret .= "<tr><th>Time</th><th>Location</th></tr>";
foreach my $r (@posted) {
$jcount{$r->{'journalid'}}++;
next unless $r->{'nodetype'} eq "L"; # log2 comment
my $ju = $us->{$r->{journalid}};
my $lrow = $logrow{"$ju->{userid} $r->{nodeid}"} ||= LJ::get_log2_row($ju, $r->{'nodeid'});
my $talkid = ($r->{'jtalkid'} << 8) + $lrow->{'anum'};
my $logurl = "$LJ::SITEROOT/users/$ju->{user}/$lrow->{ditemid}.html";
my $talkurl = "$logurl?thread=$talkid\#t$talkid";
my $hr_ago = LJ::ago_text($now - $r->{'posttime'});
my $subject;
if (defined $lrow->{ditemid}) {
$hr_ago = "<a href='$talkurl'>$hr_ago</a>";
$subject = $log_text->{"$r->{journalid} $r->{nodeid}"}[0] || "$lrow->{ditemid}.html";
LJ::CleanHTML::clean_subject(\$subject);
$subject = "<a href='$logurl'>$subject</a>";
} else {
$subject = "Post Deleted";
}
my $links = "[<a href='$talkurl'>Comment</a>] [<a href='$logurl'>Entry</a>]\n";
$ret .= "<tr><td>$hr_ago</td><td>" . LJ::ljuser($ju->{user}) . ": $subject</td></tr>";
}
$ret .= "</table>";
}
my $js_screen_color = "\"" . LJ::ejs(BML::get_template_def("screenedbarcolor")) . "\"";
$ret .= "<script>var LJ_cmtinfo = " . LJ::js_dumper(\%LJ_cmtinfo) . ";\n" .
"function userhook_screen_comment_ARG (talkid) { setStyle('cmtbar'+talkid, 'background', $js_screen_color); setInner('state'+talkid, 'Screened'); }\n".
"function userhook_unscreen_comment_ARG (talkid) { setStyle('cmtbar'+talkid, 'background', 'transparent'); setInner('state'+talkid, ''); }\n".
"function userhook_delete_comment_ARG (talkid) { hideElement('ljcmtbar'+talkid); }\n".
"var LJVAR; if (!LJVAR) LJVAR = new Object(); LJVAR.imgprefix = \"$LJ::IMGPREFIX\";\n".
"</script>";
return $@ || $ret;
}
_code?>
<=body
page?>

67
livejournal/htdocs/tools/search.bml Executable file
View File

@@ -0,0 +1,67 @@
<?page
title=>Search a Journal
body<=
<?_code
{
use strict;
use vars qw(%GET %ML);
LJ::set_active_crumb('feedstersearch');
if ($LJ::DISABLED{'feedster_search'}) {
return LJ::bad_input('Feedster search is currently disabled');
}
my $u = defined $GET{'journal'} ? LJ::load_user($GET{'journal'}) : LJ::get_remote();
return LJ::bad_input($ML{'error.nojournal'}) unless $u;
my $ljuser = LJ::ljuser($u);
my $ret;
$ret .= qq{
<?h1 Feedster Search h1?>
<?p
<b>Note:</b> This search is provided by an independent company, <a href='http://www.feedster.com/'>Feedster.com</a>, and is provided solely as a convenience. We are not responsible for the resulting content or search results.
p?>
<?standout
<form action='http://www.feedster.com/search.php' method='get' style='display:inline'>
};
my $rss_feed = LJ::journal_base($u) . '/data/rss';
$ret .= LJ::html_hidden('hl' => 'en', 'ie' => 'UTF-8', 'inrss' => $rss_feed);
$ret .= qq{
<table cellpadding='3'>
<tr>
<td align='left'>Searching in:</td>
<td align='left'>$ljuser</td>
</tr>
<tr>
<td align='left'>Search for:</td>
<td align='left'><input maxlength='256' size='45' name='q' value='' /></td>
</tr>
<tr>
<td align='left'>Sort by:</td>
<td align='left'>
<div>
<input type='radio' value='date' name='sort' id='date' checked='checked' /><label for='date'>Date</label>
<input type='radio' value='' name='sort' id='relevance' /><label for='relevance'>Relevance</label>
<input type='radio' value='blogrank' name='sort' id='blogrank' /><label for='blogrank'>Blogrank</label><br/>
</div>
</td>
</tr>
<tr>
<td>&nbsp;</td>
<td align='left'><input type='submit' value='Search' name='btnG' /></td>
</tr>
</table>
</form>
standout?>
};
return $ret;
}
_code?>
<=body
page?>

45
livejournal/htdocs/tools/sixdegrees.bml Executable file
View File

@@ -0,0 +1,45 @@
<?page
title=>Six Degrees
body<=
<?h1 Find a path between users h1?>
<?p
This is for beta-testers.
p?>
<?_code
{
use strict;
use vars qw(%GET);
use LJ::SixDegrees;
my $remote = LJ::get_remote();
my $from_user = LJ::canonical_username($GET{'from'} || ($remote ? $remote->{user} : ""));
my $to_user = LJ::canonical_username($GET{'to'});
my $ret;
$ret .= qq{<form method='get'>
From user: <input name='from' value='$from_user' size='15' />
To user: <input name='to' value='$to_user' size='15' />
<input type='submit' value='Find path' />
</form>};
if ($from_user ne "" && $to_user ne "") {
my $fu = LJ::load_user($from_user);
my $tu = LJ::load_user($to_user);
my @path = LJ::SixDegrees::find_path($fu, $tu, 3);
$ret .= "<b>Path:</b>";
if (@path) {
$ret .= join(" &gt; ", map { LJ::ljuser($_) } @path);
} else {
$ret .= "<i>(none found)</i>";
}
}
return $ret;
}
_code?>
<=body
page?>

157
livejournal/htdocs/tools/tellafriend.bml Executable file
View File

@@ -0,0 +1,157 @@
<?_code
use strict;
use vars qw(%FORM $title $body);
LJ::set_active_crumb('tellfriend');
$title = "Tell a Friend!";
$body = "";
my $remote = LJ::get_remote();
my $sth;
if ($LJ::DISABLED{'tellafriend'}) {
$body .= "This feature is disabled.";
return;
}
unless ($remote) {
$body .= "<?h1 Sorry... h1?><?p To use the \"Tell a Friend\" feature, you must first <a href=\"/login.bml?ret=1\">login</a>. p?><?p If we didn't require you to login for this, we'd be essentially providing an anonymous email gateway and there'd be tons of people abusing it and harassing each other. (We tried this on another website once...) p?>";
return;
}
my $u = LJ::load_userid($remote->{'userid'});
$u->{'emailpref'} = $u->{'email'};
if ($LJ::USER_EMAIL && LJ::get_cap($u, "useremail")) {
$u->{'emailpref'} = $u->{'user'} . '@' . $LJ::USER_DOMAIN;
}
unless ($u->{'status'} eq "A") {
$body .= "<?h1 Sorry... h1?><?p Your current email address ($u->{'email'}) isn't validated, so we can't let you use the \"Tell a Friend\" feature. To validate your email address, have the confirmation email resent at the <a href=\"/lostinfo.bml\">lost information</a> page, and then follow the instructions in it when you get it. p?>";
return;
}
my $err = sub {
$title = "Error";
$body = "<?h1 Error h1?><?p $_[0] p?>";
return;
};
if ($FORM{'mode'} eq "mail")
{
my $email = $FORM{'toemail'};
my @errors;
LJ::check_email($email, \@errors);
push @errors, "<?requirepost?>" unless LJ::did_post();
if (@errors) {
$title = "Error";
$body = LJ::bad_input(@errors);
return;
}
LJ::send_mail({
'to' => $FORM{'toemail'},
'toname' => $FORM{'toname'},
'from' => $u->{'emailpref'},
'fromname' => $FORM{'fromname'},
'charset' => 'utf-8',
'subject' => $FORM{'subject'},
'body' => $FORM{'body'},
});
$body .= "<?h1 Sent! h1?><?p $FORM{'toemail'} has been mailed. p?>";
return;
}
$body .= "<form method='post' action='tellafriend.bml'><input type=hidden name=mode value=mail>";
$body .= "<table cellpadding=3 border=0>";
$body .= "<tr><td align=right nowrap><b>From:</b></td><td><input name=fromname size=30 value=\"" . LJ::ehtml($u->{'name'} || "$LJ::SITENAME User") . "\"></td></tr>\n";
$body .= "<tr><td align=right nowrap><b>&nbsp;</b></td><td>$u->{'emailpref'}</td></tr>\n";
$body .= "<tr><td align=right nowrap><b>To (Name):</b></td><td><input name=toname size=30></td></tr>\n";
$body .= "<tr><td align=right nowrap><b>To (Email):</b></td><td><input name=toemail size=30></td></tr>\n";
my ($subject, $msg);
$subject = "Check this out...";
if ($FORM{'itemid'} =~ /^\d+$/)
{
my $journal = $FORM{'journal'};
my $itemid = $FORM{'itemid'}+0;
my $ditemid = $itemid;
my $uj;
$itemid = int($itemid / 256);
$uj = LJ::load_user($journal);
return $err->("Unknown journal") unless $uj;
my $dbcr = LJ::get_cluster_reader($uj);
my ($posterid, $subject) = $dbcr->selectrow_array("SELECT l.posterid, ls.subject ".
"FROM log2 l, logtext2 ls ".
"WHERE l.journalid=? AND ls.journalid=l.journalid ".
"AND l.jitemid=? AND ls.jitemid=l.jitemid",
undef, $uj->{'userid'}, $itemid);
my $up;
LJ::load_userids_multiple([ $posterid => \$up ], [ $uj, $u ]);
my $base = LJ::journal_base($uj);
my $url = "$base/$ditemid.html";
if ($up->{'user'} eq $u->{'user'}) {
$msg .= "Hey,\n\nCheck out this journal entry of mine:\n\n";
} else {
$msg .= "Hey,\n\nCheck this out... I saw this journal entry while reading " . $up->{'user'} . "'s journal:\n\n";
}
$msg .= " $subject\n" if $subject;
$msg .= " $url\n\n";
$msg .= "I thought you might be interested.\n\n";
}
if ($FORM{'user'} =~ /^\w{1,15}$/) {
my $user = $FORM{'user'};
my $uj = LJ::load_user($user);
my $url;
if (LJ::get_cap($uj, "userdomain")) {
my $sub = $user;
$sub =~ s/_/-/g;
$url .= "http://$sub.$LJ::USER_DOMAIN/";
} else {
$url .= "$LJ::SITEROOT/users/$user/";
}
if ($user eq $u->{'user'}) {
$msg .= "Hey,\n\nCheck out my journal that I'm keeping online:\n\n";
$msg .= " $url\n\n";
my $name = $u->{'name'};
$name =~ s/\s.+//;
$msg .= "- $name\n";
} else {
$msg .= "Hey,\n\nCheck out my friend's journal online:\n\n";
$msg .= " $url\n\n";
my $name = $u->{'name'};
$name =~ s/\s.+//;
$msg .= "- $name\n";
}
}
my $subject = "Check it out...";
$body .= "<tr><td align=right nowrap><b>Subject:</b></td><td><input name=subject size=40 maxlength=60 value=\"" . LJ::ehtml($subject) . "\"></td></tr>\n";
$body .= "<tr><td align=right nowrap valign=top><b>Body:</b></td><td><textarea name=body rows=15 cols=67 wrap=soft>" . LJ::ehtml($msg) . "</textarea></td></tr>\n";
$body .= "<tr><td>&nbsp;</td><td><input type=submit value=\"Send email\"></td></tr>\n";
$body .= "</table>";
$body .= "</form>";
return;
_code?><?page
title=><?_code return $title; _code?>
body=><?_code return $body; _code?>
page?><?_c <LJDEP>
lib: cgi-bin/emailcheck.pl
link: htdocs/login.bml, htdocs/lostinfo.bml, htdocs/users, htdocs/talkread.bml
form: htdocs/tools/tellafriend.bml
</LJDEP> _c?>

143
livejournal/htdocs/tools/textmessage.bml Executable file
View File

@@ -0,0 +1,143 @@
<?page
title=>Send a Text Message
body<=
<?_code
{
use strict;
use vars qw(%FORM);
LJ::set_active_crumb('textmessage');
my $ret;
my $user = $FORM{'user'};
if ($FORM{'mode'} eq "details")
{
$ret .= "<?h1 Service Providers h1?><?p The following text messaging service providers are supported. p?>";
$ret .= "<UL>";
foreach my $p (LJ::TextMessage::providers()) {
my $info = LJ::TextMessage::provider_info($p);
$ret .= "<P><B>$info->{'name'}</B> (from: $info->{'fromlimit'}, msg: $info->{'msglimit'}, total: $info->{'totlimit'})<BR>$info->{'notes'}";
}
$ret .= "</UL>";
&add_footer();
return $ret;
}
unless ($user) {
$ret .= "<?h1 Enter user h1?><?p Enter the LiveJournal username of the person you'd like to send a text message to: <div style='margin-left: 40px'><form method='get' action='textmessage.bml'>Username: <input type='text' size='15' maxlength='15' name='user' /> <input type='submit' value=\"Proceed...\" /></form></div> p?>";
&add_footer();
return $ret;
}
my $u = LJ::load_user($user);
my $tminfo;
if ($u->{'txtmsg_status'} eq "on") {
my $dbr = LJ::get_db_reader();
$tminfo = $dbr->selectrow_hashref("SELECT provider, number, security ".
"FROM txtmsg WHERE userid=$u->{'userid'}")
}
unless (LJ::get_cap($u, "textmessaging")) {
$ret .= "<?h1 Unavailable h1?><?p This user's account type does not permit text messaging. p?>";
&add_footer();
return $ret;
}
unless ($tminfo) {
$ret .= "<?h1 Unavailable h1?><?p This user has not setup their text messaging ".
"information at LiveJournal or they've turned it off. p?>";
&add_footer();
return $ret;
}
my $remote;
if ($tminfo->{'security'} ne "all") {
$remote = LJ::get_remote();
my $andbefriend;
if ($tminfo->{'security'} eq "friends") {
$andbefriend = " and be listed as their friend";
}
unless ($remote) {
$ret .= "<?h1 Not logged in h1?><?p To send a text message to this user, you must be <A HREF=\"/login.bml?ret=1\">logged in</A>$andbefriend. p?>";
&add_footer();
return $ret;
}
if ($tminfo->{'security'} eq "friends" && $u->{'userid'} != $remote->{'userid'}) {
unless (LJ::is_friend($u->{'userid'}, $remote->{'userid'})) {
$ret .= "<?h1 Unauthorized h1?><?p User <B>$u->{'user'}</B> has selected \"friends only\" as the security level required to send text messages to them. p?>";
&add_footer();
return $ret;
}
}
}
###### authorized.
if ($FORM{'message'}) {
my $message = $FORM{'message'};
my $from = $tminfo->{'security'} eq "all" ? $FORM{'from'} : $remote->{'user'};
my $phone = new LJ::TextMessage { 'provider' => $tminfo->{'provider'},
'number' => $tminfo->{'number'},
'mailcommand' => $LJ::SENDMAIL,
'smtp' => $LJ::SMTP_SERVER,
};
my @errors;
$phone->send({ 'from' => $from,
'message' => $message, },
\@errors);
# strip numbers from error messages
s/(\d{3,})/'x'x length $1/eg foreach @errors;
return LJ::bad_input(@errors) if @errors;
$ret .= "<?h1 Success h1?><?p Your text message was sent. p?>";
&add_footer();
return $ret;
}
my $pinfo = LJ::TextMessage::provider_info($tminfo->{'provider'});
$ret .= "<?h1 Send a message h1?><?p Fill out this form to send a text message to <B>$u->{'user'}</B>. p?>";
$ret .= "<ul>";
$ret .= "<form name='frmMsg' method='post' action='textmessage.bml'><input type='hidden' name='user' value=\"$u->{'user'}\" />";
$ret .= "<b>From: </b> ";
my $maxlen = $pinfo->{'totlimit'};
if ($tminfo->{'security'} eq "all") {
$ret .= "<INPUT NAME=from MAXLENGTH=15 SIZE=15 VALUE=\"$remote->{'user'}\">\n";
$maxlen -= 15;
} else {
$ret .= "<INPUT NAME=from TYPE=HIDDEN VALUE=\"$remote->{'user'}\">\n";
$ret .= "<TT>$remote->{'user'}</TT>";
$maxlen -= length($remote->{'user'});
}
if ($pinfo->{'msglimit'} < $maxlen) { $maxlen = $pinfo->{'msglimit'}; }
$ret .= "<P><B>Message:</B> (max <TT>$maxlen</TT> characters ... type until it stops you)<BR>";
$ret .= "<input name='message' size='50' maxlength='$maxlen' />\n";
$ret .= "<p><input type='submit' value=\"Send Message!\" /></p>";
$ret .= "</form></ul>";
&add_footer();
return $ret;
sub add_footer
{
my $howwork = $LJ::HELP_URL{'textmessaging_about'} ? "How does this feature work? <a href=\"$LJ::HELP_URL{'textmessaging_about'}\">Read this</a>.<br />" : "";
$ret .= "<p><hr /><font size='-1'>$howwork<B>Disclaimer:</B> The reliability of text messaging should not be trusted in dealing with emergencies.</font>";
}
}
_code?>
<=body
page?><?_c <LJDEP>
lib: LJ::TextMessage
link: htdocs/login.bml, htdocs/support/faqbrowse.bml
form: htdocs/tools/textmessage.bml
post: htdocs/tools/textmessage.bml
</LJDEP> _c?>