init
This commit is contained in:
1458
local/cgi-bin/LJR/Distributed.pm
Executable file
1458
local/cgi-bin/LJR/Distributed.pm
Executable file
File diff suppressed because it is too large
Load Diff
51
local/cgi-bin/LJR/GD.pm
Normal file
51
local/cgi-bin/LJR/GD.pm
Normal file
@@ -0,0 +1,51 @@
|
||||
use strict;
|
||||
use GD::Simple;
|
||||
|
||||
package LJR::GD;
|
||||
|
||||
sub generate_number {
|
||||
my ($num, $fontname, $fontcolor, $stuff) = @_;
|
||||
|
||||
$num =~ s/^(\ +)//g;
|
||||
$num =~ s/(\ +)$//g;
|
||||
|
||||
my $font;
|
||||
if ($fontname eq "gdTinyFont") {
|
||||
$font = GD::Font->Tiny();
|
||||
}
|
||||
elsif ($fontname eq "gdSmallFont") {
|
||||
$font = GD::Font->Small();
|
||||
}
|
||||
elsif ($fontname eq "gdLargeFont") {
|
||||
$font = GD::Font->Large();
|
||||
}
|
||||
elsif ($fontname eq "gdMediumBoldFont") {
|
||||
$font = GD::Font->MediumBold();
|
||||
}
|
||||
elsif ($fontname eq "gdGiantFont") {
|
||||
$font = GD::Font->Giant();
|
||||
}
|
||||
else {
|
||||
$font = GD::Font->Small();
|
||||
}
|
||||
|
||||
my $cell_width = $font->width;
|
||||
my $cell_height = $font->height;
|
||||
my $cols = length($stuff) > length($num) ? length($stuff) : length($num);
|
||||
my $width = int($cols * $cell_width + $cell_width / 3);
|
||||
my $height = $cell_height + 1;
|
||||
my $img = GD::Simple->new($width,$height);
|
||||
$img->font($font);
|
||||
$img->moveTo(1,$font->height + 1);
|
||||
$img->transparent("white");
|
||||
$img->bgcolor("white");
|
||||
$img->fgcolor($fontcolor);
|
||||
|
||||
my $str = (length($num) < length($stuff) ?
|
||||
substr($stuff, 0, length($stuff) - length($num)) :
|
||||
"") . $num;
|
||||
$img->string($str);
|
||||
return $img;
|
||||
}
|
||||
|
||||
return 1;
|
||||
234
local/cgi-bin/LJR/Gate.pm
Normal file
234
local/cgi-bin/LJR/Gate.pm
Normal file
@@ -0,0 +1,234 @@
|
||||
use strict;
|
||||
|
||||
use XMLRPC::Lite;
|
||||
use Digest::MD5;
|
||||
use Time::Local;
|
||||
|
||||
use LJR::Distributed;
|
||||
use LJR::xmlrpc;
|
||||
use LJR::Viewuserstandalone;
|
||||
|
||||
require "$ENV{'LJHOME'}/cgi-bin/ljpoll.pl";
|
||||
|
||||
package LJR::Gate;
|
||||
|
||||
$LJR::Gate::clientver = 'LJR::Gate/0.02';
|
||||
|
||||
sub Authenticate {
|
||||
my ($server, $user, $pass) = @_;
|
||||
|
||||
my $xmlrpc = new XMLRPC::Lite;
|
||||
$xmlrpc->proxy("http://" . $server . "/interface/xmlrpc", timeout => 60);
|
||||
|
||||
my $xmlrpc_ret = LJR::xmlrpc::xmlrpc_call($xmlrpc, "LJ.XMLRPC.getchallenge");
|
||||
return $xmlrpc_ret if $xmlrpc_ret->{"err_text"};
|
||||
|
||||
my $challenge = $xmlrpc_ret->{'result'}->{'challenge'};
|
||||
my $response = Digest::MD5::md5_hex($challenge . Digest::MD5::md5_hex($pass));
|
||||
|
||||
my $xmlrpc_req = {
|
||||
'username' => $user,
|
||||
'auth_method' => 'challenge',
|
||||
'auth_challenge' => $challenge,
|
||||
'auth_response' => $response,
|
||||
'ver' => 1,
|
||||
'clientver' => $LJR::Gate::clientver,
|
||||
};
|
||||
|
||||
$xmlrpc_ret = LJR::xmlrpc::xmlrpc_call($xmlrpc, "LJ.XMLRPC.login", $xmlrpc_req);
|
||||
return $xmlrpc_ret if $xmlrpc_ret->{"err_text"};
|
||||
|
||||
return $xmlrpc;
|
||||
}
|
||||
|
||||
sub ExportEntry {
|
||||
my ($u, $req, $security, $jitemid, $anum) = @_;
|
||||
|
||||
return "User [" . $u->{'user'} . "] is not gated." unless LJR::Distributed::is_gated_local($u->{'user'});
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
return "Can't get database reader!" unless $dbr;
|
||||
|
||||
my $r;
|
||||
$r = $dbr->selectrow_hashref (
|
||||
"SELECT * FROM ljr_export_settings WHERE user=?",
|
||||
undef, $u->{'user'});
|
||||
|
||||
my $ru;
|
||||
$ru = LJR::Distributed::get_cached_user({ 'ru_id' => $r->{'ru_id'}});
|
||||
$ru = LJR::Distributed::get_remote_server_byid($ru);
|
||||
|
||||
my $xmlrpc = new XMLRPC::Lite;
|
||||
$xmlrpc->proxy($ru->{'servername'} . "/interface/xmlrpc", timeout => 60);
|
||||
|
||||
my $xmlrpc_ret;
|
||||
my $xmlrpc_req;
|
||||
my $challenge;
|
||||
my $response;
|
||||
|
||||
my $real_event;
|
||||
my $real_subject;
|
||||
|
||||
my $last_status;
|
||||
|
||||
if ($req->{'event'} !~ /\S/) {
|
||||
$last_status = "removed entry.";
|
||||
|
||||
$real_event = $req->{'event'};
|
||||
$real_subject = $req->{'subject'};
|
||||
}
|
||||
else {
|
||||
my $item_url = LJ::item_link($u, $jitemid, $anum);
|
||||
$last_status = "exported <a href=$item_url>entry</a>";
|
||||
|
||||
$real_event = LJR::Viewuserstandalone::expand_ljuser_tags($req->{'event'});
|
||||
$real_subject = LJR::Viewuserstandalone::expand_ljuser_tags($req->{'subject'});
|
||||
|
||||
my $i=0;
|
||||
while ($real_event =~ /lj-cut/ig) { $i++ };
|
||||
while ($real_event =~ /\/lj-cut/ig) { $i-- };
|
||||
if ($i gt 0) {
|
||||
$real_event .= "</lj-cut>";
|
||||
}
|
||||
LJ::Poll::replace_polls_with_links(\$real_event);
|
||||
LJ::EmbedModule->expand_entry($u, \$real_event, ('content_only' => 1));
|
||||
|
||||
unless ($req->{'props'}->{'opt_nocomments'}) {
|
||||
LJR::Distributed::sign_exported_gate_entry($u, $jitemid, $anum, \$real_event);
|
||||
}
|
||||
}
|
||||
|
||||
$security = $req->{'sequrity'} if !$security && $req->{'security'};
|
||||
$security = "public" unless $security;
|
||||
|
||||
$xmlrpc_req = {
|
||||
'username' => $ru->{'username'},
|
||||
'auth_method' => 'challenge',
|
||||
'ver' => 1,
|
||||
'clientver' => $LJR::Gate::clientver,
|
||||
'subject' => $real_subject,
|
||||
'event' => $real_event,
|
||||
'year' => $req->{'year'},
|
||||
'mon' => $req->{'mon'},
|
||||
'day' => $req->{'day'},
|
||||
'hour' => $req->{'hour'},
|
||||
'min' => $req->{'min'},
|
||||
'security' => $security,
|
||||
'allowmask' => $req->{'allowmask'},
|
||||
'props' => {
|
||||
'current_moodid' => $req->{'props'}->{'current_moodid'},
|
||||
'current_mood' => $req->{'props'}->{'current_mood'},
|
||||
'current_music' => $req->{'props'}->{'current_music'},
|
||||
'picture_keyword' => $req->{'props'}->{'picture_keyword'},
|
||||
'taglist' => $req->{'props'}->{'taglist'},
|
||||
'opt_backdated' => $req->{'props'}->{'opt_backdated'},
|
||||
'opt_preformatted' => $req->{'props'}->{'opt_preformatted'},
|
||||
'opt_nocomments' => 1,
|
||||
},
|
||||
};
|
||||
|
||||
my $is_invalid_remote_journal = sub {
|
||||
my ($error_message) = @_;
|
||||
if (
|
||||
$error_message =~ /Invalid password/ ||
|
||||
$error_message =~ /Selected journal no longer exists/ ||
|
||||
$error_message =~ /account is suspended/ ||
|
||||
$error_message =~ /Invalid username/
|
||||
) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
};
|
||||
|
||||
my $is_invalid_remote_entry = sub {
|
||||
my ($error_message) = @_;
|
||||
if ($error_message =~ /Can\'t edit post from requested journal/) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
};
|
||||
|
||||
my $post_new_event = sub {
|
||||
$xmlrpc_ret = LJR::xmlrpc::xmlrpc_call($xmlrpc, "LJ.XMLRPC.getchallenge");
|
||||
return $xmlrpc_ret->{"err_text"} if $xmlrpc_ret->{"err_text"};
|
||||
$challenge = $xmlrpc_ret->{'result'}->{'challenge'};
|
||||
$response = Digest::MD5::md5_hex($challenge . Digest::MD5::md5_hex($r->{'remote_password'}));
|
||||
$xmlrpc_req->{'auth_challenge'} = $challenge;
|
||||
$xmlrpc_req->{'auth_response'} = $response;
|
||||
|
||||
my $item_time = Time::Local::timelocal(0, $req->{'min'}, $req->{'hour'},
|
||||
$req->{'day'}, $req->{'mon'} - 1, $req->{'year'});
|
||||
|
||||
if ((time - $item_time) > 60*60*24) {
|
||||
$xmlrpc_req->{'props'}->{'opt_backdated'} = 1;
|
||||
}
|
||||
|
||||
$xmlrpc_ret = LJR::xmlrpc::xmlrpc_call($xmlrpc, "LJ.XMLRPC.postevent", $xmlrpc_req);
|
||||
if ($xmlrpc_ret->{'err_text'}) {
|
||||
if ($is_invalid_remote_journal->($xmlrpc_ret->{'err_text'})) {
|
||||
$r = LJR::Distributed::update_export_status($u->{'user'}, 0, "ERROR: " . $xmlrpc_ret->{'err_text'});
|
||||
}
|
||||
else {
|
||||
$r = LJR::Distributed::update_export_status($u->{'user'}, 1, "ERROR: " . $xmlrpc_ret->{'err_text'});
|
||||
}
|
||||
return $xmlrpc_ret->{"err_text"} . " " . ($r->{'err'} ? $r->{'errtext'} : "");
|
||||
}
|
||||
|
||||
my $rhtml_id = $xmlrpc_ret->{'result'}->{'itemid'} * 256 +
|
||||
$xmlrpc_ret->{'result'}->{'anum'};
|
||||
|
||||
$r = LJR::Distributed::store_remote_itemid(
|
||||
$u,
|
||||
$jitemid,
|
||||
$ru->{'ru_id'},
|
||||
$xmlrpc_ret->{'result'}->{'itemid'},
|
||||
$rhtml_id,
|
||||
"E"
|
||||
);
|
||||
return
|
||||
"store_remote_itemid: " . $u->{'user'} . "," .
|
||||
$jitemid . "," . $ru->{'ru_id'} . "," .
|
||||
$xmlrpc_ret->{'result'}->{'itemid'} . "," . $rhtml_id . ": " .
|
||||
$r->{"errtext"} if $r->{"err"};
|
||||
};
|
||||
|
||||
my $ritem = LJR::Distributed::get_remote_itemid($u->{'userid'}, $jitemid, "E");
|
||||
if ($ritem && ($req->{'props'}->{'revnum'} || $req->{'event'} !~ /\S/)) {
|
||||
$xmlrpc_ret = LJR::xmlrpc::xmlrpc_call($xmlrpc, "LJ.XMLRPC.getchallenge");
|
||||
return $xmlrpc_ret->{"err_text"} if $xmlrpc_ret->{"err_text"};
|
||||
$challenge = $xmlrpc_ret->{'result'}->{'challenge'};
|
||||
$response = Digest::MD5::md5_hex($challenge . Digest::MD5::md5_hex($r->{'remote_password'}));
|
||||
$xmlrpc_req->{'auth_challenge'} = $challenge;
|
||||
$xmlrpc_req->{'auth_response'} = $response;
|
||||
|
||||
$xmlrpc_req->{'itemid'} = $ritem->{'ritemid'};
|
||||
|
||||
$xmlrpc_ret = LJR::xmlrpc::xmlrpc_call($xmlrpc, "LJ.XMLRPC.editevent", $xmlrpc_req);
|
||||
if ($xmlrpc_ret->{'err_text'}) {
|
||||
if ($is_invalid_remote_entry->($xmlrpc_ret->{'err_text'})) {
|
||||
LJR::Distributed::remove_remote_itemid($u, $jitemid, $ru->{'ru_id'}, $ritem->{'ritemid'}, "E");
|
||||
my $errmsg = $post_new_event->();
|
||||
return $errmsg if $errmsg;
|
||||
}
|
||||
elsif ($is_invalid_remote_journal->($xmlrpc_ret->{'err_text'})) {
|
||||
$r = LJR::Distributed::update_export_status($u->{'user'}, 0, "ERROR: " . $xmlrpc_ret->{'err_text'});
|
||||
return $xmlrpc_ret->{"err_text"} . " " . ($r->{'err'} ? $r->{'errtext'} : "");
|
||||
}
|
||||
$r = LJR::Distributed::update_export_status($u->{'user'}, 1, "ERROR: " . $xmlrpc_ret->{'err_text'});
|
||||
return $xmlrpc_ret->{"err_text"} . " " . ($r->{'err'} ? $r->{'errtext'} : "");
|
||||
}
|
||||
if ($req->{'event'} !~ /\S/) {
|
||||
LJR::Distributed::remove_remote_itemid($u, $jitemid, $ru->{'ru_id'}, $ritem->{'ritemid'}, "E");
|
||||
}
|
||||
|
||||
}
|
||||
else {
|
||||
my $errmsg = $post_new_event->();
|
||||
return $errmsg if $errmsg;
|
||||
}
|
||||
|
||||
$r = LJR::Distributed::update_export_status($u->{'user'}, 1, "OK: $last_status");
|
||||
return $r->{'errtext'} if $r->{'err'};
|
||||
|
||||
return;
|
||||
}
|
||||
241
local/cgi-bin/LJR/Viewuser.pm
Executable file
241
local/cgi-bin/LJR/Viewuser.pm
Executable file
@@ -0,0 +1,241 @@
|
||||
package LJR::Viewuser;
|
||||
|
||||
use strict;
|
||||
use Carp;
|
||||
use lib "$ENV{'LJHOME'}/cgi-bin";
|
||||
use DBI;
|
||||
use DBI::Role;
|
||||
use DBIx::StateKeeper;
|
||||
|
||||
# A function to canonicalize sitename: take one of the possible
|
||||
# abbreviations for a given known site, and returns the siteid
|
||||
# from the list. Otherwise, assume that abbreivation is actually the
|
||||
# full URL, and return it "as is", without the possible leading http://.
|
||||
#
|
||||
# We check the known servers database for "site=servername" or "site
|
||||
# contains serverurl without the leading www"; make additional
|
||||
# explicit matchings if necessary (presently none are necessary), et
|
||||
# voila.
|
||||
#
|
||||
|
||||
sub canonical_sitenum {
|
||||
my ($site)=@_;
|
||||
|
||||
# Cut away leading http://
|
||||
$site =~ s|http://(.*)|$1|;
|
||||
|
||||
my $dbh = LJ::get_db_reader();
|
||||
my $sth = $dbh->prepare(
|
||||
"SELECT serverid FROM alienservers WHERE servername=?"
|
||||
);
|
||||
|
||||
$sth->execute($site);
|
||||
return LJ::error($dbh) if $dbh->err;
|
||||
#
|
||||
# Match $site=servername (e.g. "LJ")
|
||||
#
|
||||
if ($sth->rows) {
|
||||
my ($guu) = $sth->fetchrow_array;
|
||||
return $guu;
|
||||
}
|
||||
$sth->finish;
|
||||
|
||||
$sth = $dbh->prepare(
|
||||
"SELECT serverid, REPLACE(serverurl, 'www.', '') FROM alienservers"
|
||||
);
|
||||
$sth->execute;
|
||||
return LJ::error($dbh) if $dbh->err;
|
||||
#
|
||||
# Scan all known servers and match "serverurl without www is
|
||||
# contained in $site"
|
||||
#
|
||||
while (my ($hale, $guu) = $sth->fetchrow_array) {
|
||||
if (index ($site, $guu) !=-1) {
|
||||
return $hale;
|
||||
}
|
||||
}
|
||||
|
||||
if ( (lc($site) eq "ljr") || ($site =~ m/.*${LJ::DOMAIN}.*/) )
|
||||
#
|
||||
# 0 means ourselves
|
||||
#
|
||||
{return 0;}
|
||||
# elsif ( ($site eq "LJ") || ($site =~ m/.*livejournal\.com.*/) )
|
||||
# {return 1;}
|
||||
# elsif ( ($site eq "GJ") || ($site =~ m/.*greatestjournal\.com.*/) )
|
||||
# {return 2;}
|
||||
# elsif ( ($site eq "NPJ") || ($site =~ m/.*npj\.ru.*/) )
|
||||
# {return 3;}
|
||||
else {return $site};
|
||||
|
||||
}
|
||||
|
||||
#
|
||||
# Provides a representation of a user.
|
||||
#
|
||||
# Format: we receive a username and a site, where site is either a
|
||||
# number or a string. If a non-zero number, this is a known site; we take
|
||||
# information about it from the alianservers table in the db. If
|
||||
# zero, site is ourselves. If a string, we do not know anything about
|
||||
# the site and treat it as an OpenID guest; we assume site is the URL.
|
||||
#
|
||||
# We return the HTML code.
|
||||
#
|
||||
# <lj user="username" site="sitename"> should be expand to
|
||||
# ljuser( $username, {'site'=> canonical_sitenum($sitename),
|
||||
# 'type'=>'P'} )
|
||||
#
|
||||
# For lj comm, replace 'P' with 'C'
|
||||
#
|
||||
|
||||
sub ljuser {
|
||||
# we assume $opts->{'site'} to be a siteid of a known site or a full
|
||||
# URL of a site we do not have in db
|
||||
my $user = shift;
|
||||
my $opts = shift;
|
||||
my $u;
|
||||
my $native=0;
|
||||
my $known=0;
|
||||
|
||||
my $name="";
|
||||
my $url;
|
||||
my $uicon;
|
||||
my $cicon;
|
||||
my $commdir;
|
||||
my $udir;
|
||||
my $lj_type;
|
||||
|
||||
# If site is not given, assume native (siteid=0)
|
||||
unless ($opts->{'site'}) {$opts->{'site'}=0;}
|
||||
|
||||
# Check if site is a number
|
||||
if($opts->{'site'} =~ m/(\d+)/)
|
||||
{ $known=1; }
|
||||
|
||||
if($known) {
|
||||
|
||||
# Site a number (known site)
|
||||
|
||||
$opts->{'site'} = $opts->{'site'}+0;
|
||||
|
||||
# now we've got default - $LJ::DOMAIN
|
||||
|
||||
if ($opts->{'site'}==0){
|
||||
|
||||
# local
|
||||
$url=$LJ::DOMAIN;
|
||||
$cicon='community.gif'; # default local commicon
|
||||
$uicon='userinfo.gif'; # default local usericon
|
||||
$commdir='community/';
|
||||
$udir='users/';
|
||||
$lj_type='Y';
|
||||
|
||||
$native=1;
|
||||
} else {
|
||||
|
||||
# alien but known --
|
||||
# go to db to get $name
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $sth = $dbh->prepare("SELECT serverurl, servername, udir, uicon, cdir, cicon, ljtype FROM alienservers WHERE serverid=?");
|
||||
$sth->execute($opts->{'site'});
|
||||
($url, $name, $udir, $uicon, $commdir, $cicon, $lj_type) = $sth->fetchrow_array;
|
||||
$native=0;
|
||||
}
|
||||
} else {
|
||||
|
||||
# site is not a number -- unknown alien site
|
||||
|
||||
$name=$opts->{'site'};
|
||||
$url=$opts->{'site'};
|
||||
$uicon='openid-profile.gif'; # default unknown alien usericon
|
||||
$cicon='openid-profile.gif'; # default unknown alien commicon
|
||||
$commdir='';
|
||||
$udir='';
|
||||
$lj_type='N';
|
||||
$native=0;
|
||||
|
||||
}
|
||||
|
||||
if ($native){
|
||||
|
||||
# If the user is local, we do some processing: check validity, check
|
||||
# whether user or community, etc.
|
||||
|
||||
# my $do_dynamic = $LJ::DYNAMIC_LJUSER || ($user =~ /^ext_/);
|
||||
# if ($do_dynamic && ! isu($user) && ! $opts->{'type'}) {
|
||||
# Try to automatically pick the user type, but still
|
||||
# make something if we can't (user doesn't exist?)
|
||||
$user = LJ::load_user($user) || $user;
|
||||
|
||||
my $hops = 0;
|
||||
|
||||
# Traverse the renames to the final journal
|
||||
while (ref $user and $user->{'journaltype'} eq 'R'
|
||||
and ! $opts->{'no_follow'} && $hops++ < 5) {
|
||||
|
||||
LJ::load_user_props($user, 'renamedto');
|
||||
last unless length $user->{'renamedto'};
|
||||
$user = LJ::load_user($user->{'renamedto'});
|
||||
|
||||
}
|
||||
# }
|
||||
|
||||
if (LJ::isu($user)) {
|
||||
$u = $user;
|
||||
$opts->{'type'} = $user->{'journaltype'};
|
||||
# Mark accounts as deleted that aren't visible, memorial, or locked
|
||||
$opts->{'del'} = $user->{'statusvis'} ne 'V' &&
|
||||
$user->{'statusvis'} ne 'M' &&
|
||||
$user->{'statusvis'} ne 'L';
|
||||
$user = $user->{'user'};
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# End of local-specific part
|
||||
|
||||
my $andfull = $opts->{'full'} ? "&mode=full" : "";
|
||||
my $img = $opts->{'imgroot'} || $LJ::IMGPREFIX;
|
||||
my $strike = $opts->{'del'} ? ' text-decoration: line-through;' : '';
|
||||
my $make_tag = sub {
|
||||
my ($s, $n, $fil, $dir) = @_;
|
||||
$n = lc ($n);
|
||||
|
||||
if ($n eq ""){
|
||||
return "<span class='ljruser' style='white-space: nowrap;$strike'><a href='http://$s/userinfo.bml?user=$user$andfull'><img src='$img/$fil' alt='[info]' style='vertical-align: bottom; border: 0;' /></a><a href='http://$s/$dir$user/'><b>$user</b></a></span>";
|
||||
} else {
|
||||
if ($lj_type eq 'Y') {
|
||||
|
||||
# If the site is known and has an lj-type engine, then we now how to
|
||||
# refer to userinfo; make the info icon link to this
|
||||
|
||||
return "<span class='ljruser' style='white-space: nowrap;$strike'><a href='http://$s/userinfo.bml?user=$user$andfull'><img src='$img/$fil' alt='[info]' style='vertical-align: bottom; border: 0;' /></a><a href='http://$s/$dir$user/'><b>$user\@$n</b></a></span>";
|
||||
} elsif ($known) {
|
||||
|
||||
# If not lj-type, but known, let the info icon link to the user journal
|
||||
|
||||
return "<span class='ljruser' style='white-space: nowrap;$strike'><a href='http://$s/$dir$user/'><img src='$img/$fil' alt='[info]' style='vertical-align: bottom; border: 0;' /></a><a href='http://$s/$dir$user/'><b>$user\@$n</b></a></span>";
|
||||
} else {
|
||||
|
||||
# Unknown site. Treat as openid
|
||||
|
||||
return "<span class='ljruser' style='white-space: nowrap;$strike'><a href='http://$s/$dir$user/'><img src='$img/$fil' alt='[info]' style='vertical-align: bottom; border: 0;' /></a><a href='http://$s/$dir$user/'><b>$user</b> [$n]</a></span>";
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
if ($opts->{'type'} eq 'C') {
|
||||
return $make_tag->( $url, $name, $cicon, $commdir);
|
||||
} elsif ($opts->{'type'} eq 'Y') {
|
||||
return $make_tag->( $url, $name, 'syndicated.gif', 'users/');
|
||||
} elsif ($opts->{'type'} eq 'N') {
|
||||
return $make_tag->( $url, $name, 'newsinfo.gif', 'users/');
|
||||
} elsif ($opts->{'type'} eq 'I') {
|
||||
return $u->ljuser_display($opts);
|
||||
} else {
|
||||
return $make_tag->( $url, $name, $uicon, $udir);
|
||||
}
|
||||
};
|
||||
|
||||
1;
|
||||
210
local/cgi-bin/LJR/Viewuserstandalone.pm
Executable file
210
local/cgi-bin/LJR/Viewuserstandalone.pm
Executable file
@@ -0,0 +1,210 @@
|
||||
package LJR::Viewuserstandalone;
|
||||
|
||||
use strict;
|
||||
|
||||
# A function to canonicalize sitename: take one of the possible
|
||||
# abbreviations for a given known site, and returns the siteid
|
||||
# from the list. Otherwise, assume that abbreivation is actually the
|
||||
# full URL, and return it "as is", without the possible leading http://.
|
||||
# Right now we work case-by-case, since the number of known
|
||||
# abbreviations is small.
|
||||
#
|
||||
#
|
||||
# Known sites:
|
||||
#
|
||||
# 0 -- local
|
||||
# 1 -- www.livejournal.com
|
||||
# 2 -- greatestjournal.com
|
||||
# 3 -- npj.ru
|
||||
# 4 -- dreamwidth.org
|
||||
# TODO: add third level domains
|
||||
|
||||
sub canonical_sitenum {
|
||||
my ($site)=@_;
|
||||
|
||||
if ( ($site eq "LJR") || ($site =~ m/.*lj\.rossia\.org.*/) )
|
||||
{return 0;}
|
||||
elsif ( ($site eq "LJ") || ($site =~ m/.*livejournal\.com.*/) )
|
||||
{return 1;}
|
||||
elsif ( ($site eq "GJ") || ($site =~ m/.*greatestjournal\.com.*/) )
|
||||
{return 2;}
|
||||
elsif ( ($site eq "NPJ") || ($site =~ m/.*npj\.ru.*/) )
|
||||
{return 3;}
|
||||
elsif ( ($site eq "DW") || ($site eq "dw") || ($site =~ m/.*dreamwidth\.org.*/) )
|
||||
{return 4;}
|
||||
else {return $site;}
|
||||
}
|
||||
|
||||
#
|
||||
# Provides a representation of a user.
|
||||
#
|
||||
# Format: we receive a username and a site, where site is either a
|
||||
# number or a string. If a non-zero number, this is a known site; we take
|
||||
# information about it from the alianservers table in the db. If
|
||||
# zero, site is ourselves. If a string, we do not know anything about
|
||||
# the site and treat it as an OpenID guest; we assume site is the URL.
|
||||
#
|
||||
# We return the HTML code.
|
||||
#
|
||||
# <lj user="username" site="sitename"> should be expand to
|
||||
# ljuser( $username, {'site'=> canonical_sitenum($sitename),
|
||||
# 'type'=>'P','imgroot'=>''} )
|
||||
#
|
||||
# For lj comm, replace 'P' with 'C'; 'imgroot' should be equal to the
|
||||
# current value of $LJ::IMGPREFIX -- right now it is differs
|
||||
# between test and production!!
|
||||
#
|
||||
|
||||
sub ljuser {
|
||||
# we assume $opts->{'site'} to be a siteid of a known site or a full
|
||||
# URL of a site we do not have in db
|
||||
my $user = shift;
|
||||
my $opts = shift;
|
||||
my $u;
|
||||
|
||||
my $name="";
|
||||
my $url;
|
||||
my $uicon;
|
||||
my $cicon;
|
||||
my $commdir;
|
||||
my $udir;
|
||||
my $lj_type;
|
||||
|
||||
# If site is not given, assume native (siteid=0)
|
||||
unless ($opts->{'site'}) {$opts->{'site'}=0;}
|
||||
|
||||
# Check if site is a number
|
||||
if($opts->{'site'} =~ m/(\d+)/) {
|
||||
|
||||
# Site a number (known site)
|
||||
|
||||
$opts->{'site'} = $opts->{'site'}+0;
|
||||
|
||||
# now we've got default - $LJ::DOMAIN
|
||||
|
||||
if ($opts->{'site'}==0){
|
||||
|
||||
# local
|
||||
$url='lj.rossia.org';
|
||||
$cicon='community.gif'; # default local commicon
|
||||
$uicon='userinfo.gif'; # default local usericon
|
||||
$commdir='community/';
|
||||
$udir='users/';
|
||||
$lj_type='Y';
|
||||
} elsif ($opts->{'site'}==1) {
|
||||
# LJ
|
||||
$name="LJ";
|
||||
$url='www.livejournal.com';
|
||||
$cicon='community-lj.gif';
|
||||
$uicon='userinfo-lj.gif';
|
||||
$commdir='community/';
|
||||
$udir='users/';
|
||||
$lj_type='Y';
|
||||
} elsif ($opts->{'site'}==2) {
|
||||
# GJ
|
||||
$name="GJ";
|
||||
$url='www.greatestjournal.com';
|
||||
$cicon='community-lj.gif';
|
||||
$uicon='userinfo-lj.gif';
|
||||
$commdir='community/';
|
||||
$udir='users/';
|
||||
$lj_type='Y';
|
||||
} elsif ($opts->{'site'}==3) {
|
||||
# LJ
|
||||
$name="NPJ";
|
||||
$url='www.npj.ru';
|
||||
$cicon='community-npj.gif';
|
||||
$uicon='userinfo-npj.gif';
|
||||
$commdir='';
|
||||
$udir='';
|
||||
$lj_type='N';
|
||||
} elsif ($opts->{'site'}==4) {
|
||||
# DW
|
||||
$name="DW";
|
||||
$url='www.dreamwidth.org';
|
||||
$cicon='community-dw.gif';
|
||||
$uicon='userinfo-dw.gif';
|
||||
$commdir='community/';
|
||||
$udir='users/';
|
||||
$lj_type='Y';
|
||||
} else { return "[Unknown LJ user tag]"; }
|
||||
|
||||
} else {
|
||||
|
||||
# site is not a number -- unknown alien site
|
||||
|
||||
$name=$opts->{'site'};
|
||||
$url=$opts->{'site'};
|
||||
$uicon=''; # default unknown alien usericon
|
||||
$cicon=''; # default unknown alien commicon
|
||||
$commdir='community';
|
||||
$udir='users';
|
||||
$lj_type='N';
|
||||
}
|
||||
|
||||
|
||||
my $andfull = $opts->{'full'} ? "&mode=full" : "";
|
||||
|
||||
my $img = $opts->{'imgroot'};
|
||||
my $make_tag = sub {
|
||||
my ($s, $n, $fil, $dir) = @_;
|
||||
if ($n eq ""){
|
||||
return "<span class='ljruser' style='white-space: nowrap;'><a href='http://$s/userinfo.bml?user=$user$andfull'><img src='$img/$fil' alt='[info]' style='vertical-align: bottom; border: 0;' /></a><a href='http://$s/$dir$user/'><b>$user</b></a></span>";
|
||||
} else {
|
||||
if ($lj_type eq 'Y') {
|
||||
|
||||
# If the site is known and has an lj-type engine, then we now how to
|
||||
# refer to userinfo; make the info icon link to this
|
||||
|
||||
return "<span class='ljruser' style='white-space: nowrap;'><a href='http://$s/userinfo.bml?user=$user$andfull'><img src='$img/$fil' alt='[info]' style='vertical-align: bottom; border: 0;' /></a><a href='http://$s/$dir$user/'><b>$user</b> [$n]</a></span>";
|
||||
} else {
|
||||
|
||||
# If not lj-type, let the info icon link to the user journal
|
||||
|
||||
return "<span class='ljruser' style='white-space: nowrap;'><a href='http://$s/$dir$user/'><img src='$img/$fil' alt='[info]' style='vertical-align: bottom; border: 0;' /></a><a href='http://$s/$dir$user/'><b>$user</b> [$n]</a></span>";
|
||||
}
|
||||
}
|
||||
};
|
||||
if ($opts->{'type'} eq 'C') {
|
||||
return $make_tag->( $url, $name, $cicon, $commdir);
|
||||
} else {
|
||||
return $make_tag->( $url, $name, $uicon, $udir);
|
||||
}
|
||||
}
|
||||
|
||||
sub expand_ljuser_tags {
|
||||
|
||||
my ($string)=@_;
|
||||
|
||||
return "" unless $string;
|
||||
|
||||
my $imgroot='http://lj.rossia.org/img';
|
||||
|
||||
$string=~ s/<lj\s+user=\"?(\w+)\"?\s+site=\"?([^"]+)\"?\s*\/?>/
|
||||
ljuser($1,{
|
||||
'site'=>canonical_sitenum($2),
|
||||
'type'=>'P','imgroot'=>$imgroot,
|
||||
})
|
||||
/egxi;
|
||||
$string=~ s/<lj\s+comm=\"?(\w+)\"?\s+site=\"?([^"]+)\"?\s*\/?>/
|
||||
ljuser($1,{
|
||||
'site'=>canonical_sitenum($2),
|
||||
'type'=>'C','imgroot'=>$imgroot,
|
||||
})
|
||||
/egxi;
|
||||
$string=~ s/<ljr\s+user=\"?(\w+)\"?\s*\/?>/
|
||||
ljuser($1,{
|
||||
'site'=>0,
|
||||
'type'=>'P','imgroot'=>$imgroot,
|
||||
})
|
||||
/egxi;
|
||||
$string=~ s/<ljr\s+comm=\"?(\w+)\"?\s*\/?>/
|
||||
ljuser($1,{
|
||||
'site'=>0,
|
||||
'type'=>'C','imgroot'=>$imgroot,
|
||||
})
|
||||
/egxi;
|
||||
return $string;
|
||||
}
|
||||
|
||||
1;
|
||||
25
local/cgi-bin/LJR/ljpoll-local.pl
Normal file
25
local/cgi-bin/LJR/ljpoll-local.pl
Normal file
@@ -0,0 +1,25 @@
|
||||
package LJ::Poll;
|
||||
|
||||
use strict;
|
||||
|
||||
sub replace_polls_with_links {
|
||||
my ($event) = @_;
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
|
||||
while ($$event =~ /<lj-poll-(\d+)>/g) {
|
||||
my $pollid = $1;
|
||||
my $name = $dbr->selectrow_array("SELECT name FROM poll WHERE pollid=?",
|
||||
undef, $pollid);
|
||||
|
||||
if ($name) {
|
||||
LJ::Poll::clean_poll(\$name);
|
||||
} else {
|
||||
$name = "#$pollid";
|
||||
}
|
||||
|
||||
$$event =~ s!<lj-poll-$pollid>!<div><a href="$LJ::SITEROOT/poll/?id=$pollid">View Poll: $name</a></div>!g;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
53
local/cgi-bin/LJR/unicode.pm
Normal file
53
local/cgi-bin/LJR/unicode.pm
Normal file
@@ -0,0 +1,53 @@
|
||||
use strict;
|
||||
|
||||
package LJR::unicode;
|
||||
|
||||
use XML::Parser;
|
||||
use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
|
||||
|
||||
|
||||
sub utf8ize {
|
||||
my $text_in = shift;
|
||||
$$text_in = pack("C*", unpack("C*", $$text_in)) if $$text_in;
|
||||
}
|
||||
|
||||
|
||||
sub force_utf8 {
|
||||
my $xdata = shift;
|
||||
my %error_lines;
|
||||
my $finished = 0;
|
||||
my @xlines;
|
||||
my $orig_xdata = $$xdata;
|
||||
|
||||
my $p1 = new XML::Parser ();
|
||||
|
||||
while (!$finished) {
|
||||
eval { $p1->parse($$xdata); };
|
||||
|
||||
if ($@ && $@ =~ /not\ well\-formed\ \(invalid\ token\)\ at\ line\ (\d+)\,/) {
|
||||
my $error_line = $1;
|
||||
$error_lines{$error_line} ++;
|
||||
|
||||
if ($error_lines{$error_line} > 1) {
|
||||
$$xdata = $orig_xdata;
|
||||
$finished = 1;
|
||||
}
|
||||
else {
|
||||
@xlines = split(/\n/, $$xdata);
|
||||
my $output = to_utf8({ -string => $xlines[$error_line - 1], -charset => 'latin1' });
|
||||
$xlines[$error_line - 1] = $output;
|
||||
$$xdata = join("\n", @xlines);
|
||||
}
|
||||
}
|
||||
# unknown error or no error, doesn't matter
|
||||
elsif ($@) {
|
||||
$$xdata = $orig_xdata;
|
||||
$finished = 1;
|
||||
}
|
||||
else {
|
||||
$finished = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
28
local/cgi-bin/LJR/xmlrpc.pm
Normal file
28
local/cgi-bin/LJR/xmlrpc.pm
Normal file
@@ -0,0 +1,28 @@
|
||||
use strict;
|
||||
|
||||
package LJR::xmlrpc;
|
||||
|
||||
sub xmlrpc_call {
|
||||
my ($xmlrpc, $method, $request) = @_;
|
||||
my $res;
|
||||
|
||||
if ($xmlrpc) {
|
||||
$res = $xmlrpc->call ($method, $request);
|
||||
|
||||
if ($res && $res->fault) {
|
||||
$res->{"err_text"} = $method . ": " . "XML-RPC Error [" . $res->faultcode . "]: " . $res->faultstring;
|
||||
}
|
||||
elsif (!$res) {
|
||||
$res->{"err_text"} = $method . ": " . "Unknown XML-RPC Error.";
|
||||
}
|
||||
|
||||
$res->{"result"} = $res->result;
|
||||
}
|
||||
else {
|
||||
$res->{"err_text"} = "Invalid xmlrpc object";
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
return 1;
|
||||
Reference in New Issue
Block a user