wisest owl (wisest_owl) wrote in changelog,
wisest owl
wisest_owl
changelog

[livejournal] r16098: Initial commit for refactoring to Apache...

Committer: gprochaev
Initial commit for refactoring to Apache2

U   branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/AtomAPI.pm
U   branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/FotoBilder.pm
U   branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/S2.pm
U   branches/modernize2/cgi-bin/Apache/LiveJournal/PalImg.pm
U   branches/modernize2/cgi-bin/Apache/LiveJournal.pm
U   branches/modernize2/cgi-bin/LJ/AccessLogRecord.pm
U   branches/modernize2/cgi-bin/LJ/Config.pm
U   branches/modernize2/cgi-bin/LJ/EmbedModule.pm
U   branches/modernize2/cgi-bin/LJ/Error.pm
U   branches/modernize2/cgi-bin/LJ/PageStats.pm
U   branches/modernize2/cgi-bin/LJ/S2/FriendsPage.pm
U   branches/modernize2/cgi-bin/LJ/S2/ReplyPage.pm
U   branches/modernize2/cgi-bin/LJ/S2.pm
U   branches/modernize2/cgi-bin/LJ/Session.pm
U   branches/modernize2/cgi-bin/LJ/UniqCookie.pm
U   branches/modernize2/cgi-bin/LJ/User.pm
U   branches/modernize2/cgi-bin/LJ/Widget/CreateAccount.pm
U   branches/modernize2/cgi-bin/LJ/Widget/Login.pm
U   branches/modernize2/cgi-bin/LJ/Widget/SettingProdDisplay.pm
U   branches/modernize2/cgi-bin/LJ/Widget/VerticalEntries.pm
U   branches/modernize2/cgi-bin/cleanhtml.pl
U   branches/modernize2/cgi-bin/lj-bml-init.pl
U   branches/modernize2/cgi-bin/ljfeed.pl
U   branches/modernize2/cgi-bin/ljlib.pl
U   branches/modernize2/cgi-bin/ljprotocol.pl
U   branches/modernize2/cgi-bin/ljviews.pl
U   branches/modernize2/cgi-bin/modperl.pl
U   branches/modernize2/cgi-bin/modperl_subs.pl
U   branches/modernize2/cgi-bin/talklib.pl
U   branches/modernize2/cgi-bin/weblib.pl
Modified: branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/AtomAPI.pm
===================================================================
--- branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/AtomAPI.pm	2010-01-18 10:06:34 UTC (rev 16097)
+++ branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/AtomAPI.pm	2010-01-18 10:10:23 UTC (rev 16098)
@@ -15,8 +15,7 @@
 sub load { 1 }
 
 # check allowed Atom upload filetypes
-sub check_mime
-{
+sub check_mime {
     my $mime = shift;
     return unless $mime;
 
@@ -33,7 +32,7 @@
 }
 
 sub respond {
-    my ($r, $status, $body, $type) = @_;
+    my ($status, $body, $type) = @_;
 
     my %msgs = (
         200 => 'OK',
@@ -67,16 +66,16 @@
     }
 
     $type = $mime{$type} || 'text/html';
-    $r->status_line("$status $msgs{$status}");
-    $r->content_type($type);
-    $r->send_http_header();
-    $r->print($out);
+    LJ::Request->status_line("$status $msgs{$status}");
+    LJ::Request->content_type($type);
+    LJ::Request->send_http_header();
+    LJ::Request->print($out);
     return OK;
 };
 
 sub handle_upload
 {
-    my ($r, $remote, $u, $opts, $entry) = @_;
+    my ($remote, $u, $opts, $entry) = @_;
 
     # entry could already be populated from a standalone
     # service.post posting.
@@ -85,24 +84,24 @@
         my $buff;
 
         # Check length
-        my $len = $r->header_in("Content-length");
-        return respond($r, 400, "Content is too long")
+        my $len = LJ::Request->header_in("Content-length");
+        return respond(400, "Content is too long")
             if $len > $LJ::MAX_ATOM_UPLOAD;
 
-        $r->read($buff, $len);
+        LJ::Request->read($buff, $len);
 
         eval { $entry = XML::Atom::Entry->new( \$buff ); };
-        return respond($r, 400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
+        return respond(400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
             if $@;
     }
 
     my $mime = $entry->content()->type();
     my $mime_area = check_mime( $mime );
-    return respond($r, 400, "Unsupported MIME type: $mime") unless $mime_area;
+    return respond(400, "Unsupported MIME type: $mime") unless $mime_area;
 
     if ($mime_area eq 'image') {
 
-        return respond($r, 400, "Unable to upload media. Your account doesn't have the required access.")
+        return respond(400, "Unable to upload media. Your account doesn't have the required access.")
             unless LJ::get_cap($u, 'fb_can_upload') && $LJ::FB_SITEROOT;
 
         my $err;
@@ -124,12 +123,12 @@
             }
         );
 
-        return respond($r, 500, "There was an error uploading the media: $err")
+        return respond(500, "There was an error uploading the media: $err")
             if $err || ! $fb;
 
         if (ref $fb && $fb->{Error}->{code}) {
             my $errstr = $fb->{Error}->{content};
-            return respond($r, 500, "There was an error uploading the media: $errstr");
+            return respond(500, "There was an error uploading the media: $errstr");
         }
 
         my $atom_reply = XML::Atom::Entry->new();
@@ -151,30 +150,30 @@
         $link->href( $fb->{URL} );
         $atom_reply->add_link($link);
 
-        $r->header_out("Location", $fb->{URL});
-        return respond($r, 201, \$atom_reply->as_xml(), 'atom');
+        LJ::Request->header_out("Location", $fb->{URL});
+        return respond(201, \$atom_reply->as_xml(), 'atom');
     }
 }
 
 sub handle_post {
-    my ($r, $remote, $u, $opts) = @_;
+    my ($remote, $u, $opts) = @_;
     my ($buff, $entry);
 
     # Check length
-    my $len = $r->header_in("Content-length");
-    return respond($r, 400, "Content is too long")
+    my $len = LJ::Request->header_in("Content-length");
+    return respond(400, "Content is too long")
         if $len > $LJ::MAX_ATOM_UPLOAD;
 
     # read the content
-    $r->read($buff, $len);
+    LJ::Request->read($buff, $len);
 
     # try parsing it
     eval { $entry = XML::Atom::Entry->new( \$buff ); };
-    return respond($r, 400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
+    return respond(400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
         if $@;
 
     # on post, the entry must NOT include an id
-    return respond($r, 400, "Must not include an <b>&lt;id&gt;</b> field in a new entry.")
+    return respond(400, "Must not include an <b>&lt;id&gt;</b> field in a new entry.")
         if $entry->id;
 
     # detect 'standalone' media posts
@@ -290,7 +289,7 @@
 
     if ($err) {
         my $errstr = LJ::Protocol::error_message($err);
-        return respond($r, 500, "Unable to post new entry. Protocol error: <b>$errstr</b>.");
+        return respond(500, "Unable to post new entry. Protocol error: <b>$errstr</b>.");
     }
 
     my $atom_reply = XML::Atom::Entry->new();
@@ -341,12 +340,12 @@
     $link->title( $entry->title() );
     $atom_reply->add_link($link);
 
-    $r->header_out("Location", $edit_url);
-    return respond($r, 201, \$atom_reply->as_xml(), 'atom');
+    LJ::Request->header_out("Location", $edit_url);
+    return respond(201, \$atom_reply->as_xml(), 'atom');
 }
 
 sub handle_edit {
-    my ($r, $remote, $u, $opts) = @_;
+    my ($remote, $u, $opts) = @_;
 
     my $method = $opts->{'method'};
 
@@ -367,7 +366,7 @@
 
     if ($err) {
         my $errstr = LJ::Protocol::error_message($err);
-        return respond($r, 404, "Unable to retrieve the item requested for editing. Protocol error: <b>$errstr</b>.");
+        return respond(404, "Unable to retrieve the item requested for editing. Protocol error: <b>$errstr</b>.");
     }
     $olditem = $olditem->{'events'}->[0];
 
@@ -378,7 +377,7 @@
 
         # get the log2 row (need logtime for createtime)
         my $row = LJ::get_log2_row($u, $jitemid) ||
-            return respond($r, 404, "Could not load the original entry.");
+            return respond(404, "Could not load the original entry.");
 
         # we need to put into $item: itemid, ditemid, subject, event,
         # createtime, eventtime, modtime
@@ -409,23 +408,23 @@
             [$item]
         );
 
-        return respond($r, 200, \$ret, 'xml');
+        return respond(200, \$ret, 'xml');
     }
 
     if ($method eq "PUT") {
         # Check length
-        my $len = $r->header_in("Content-length");
-        return respond($r, 400, "Content is too long")
+        my $len = LJ::Request->header_in("Content-length");
+        return respond(400, "Content is too long")
             if $len > $LJ::MAX_ATOM_UPLOAD;
 
         # read the content
         my $buff;
-        $r->read($buff, $len);
+        LJ::Request->read($buff, $len);
 
         # try parsing it
         my $entry;
         eval { $entry = XML::Atom::Entry->new( \$buff ); };
-        return respond($r, 400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
+        return respond(400, "Could not parse the entry due to invalid markup.<br /><pre>$@</pre>")
             if $@;
 
         # remove the SvUTF8 flag. See same code in synsuck.pl for
@@ -438,7 +437,7 @@
         # on GET
         unless ($entry->id() =~ m#atom1:$u->{'user'}:(\d+)$# &&
                 $1 == $olditem->{'itemid'}*256 + $olditem->{'anum'}) {
-            return respond($r, 400, "Incorrect <b>&lt;id&gt;</b> field in this request.");
+            return respond(400, "Incorrect <b>&lt;id&gt;</b> field in this request.");
         }
 
         # build an edit event request. Preserve fields that aren't being
@@ -464,10 +463,10 @@
 
         if ($err) {
             my $errstr = LJ::Protocol::error_message($err);
-            return respond($r, 500, "Unable to update entry. Protocol error: <b>$errstr</b>.");
+            return respond(500, "Unable to update entry. Protocol error: <b>$errstr</b>.");
         }
 
-        return respond($r, 200, "The entry was successfully updated.");
+        return respond(200, "The entry was successfully updated.");
     }
 
     if ($method eq "DELETE") {
@@ -490,10 +489,10 @@
 
         if ($err) {
             my $errstr = LJ::Protocol::error_message($err);
-            return respond($r, 500, "Unable to delete entry. Protocol error: <b>$errstr</b>.");
+            return respond(500, "Unable to delete entry. Protocol error: <b>$errstr</b>.");
         }
 
-        return respond($r, 200, "Entry successfully deleted.");
+        return respond(200, "Entry successfully deleted.");
     }
 
 }
@@ -501,7 +500,7 @@
 # fetch lj tags, display as categories
 sub handle_categories
 {
-    my ($r, $remote, $u, $opts) = @_;
+    my ($remote, $u, $opts) = @_;
     my $ret = '<?xml version="1.0"?>';
     $ret .= '<categories xmlns="http://sixapart.com/atom/category#">';
 
@@ -511,11 +510,11 @@
     }
     $ret .= '</categories>';
 
-    return respond($r, 200, \$ret, 'xml');
+    return respond(200, \$ret, 'xml');
 }
 
 sub handle_feed {
-    my ($r, $remote, $u, $opts) = @_;
+    my ($remote, $u, $opts) = @_;
 
     # simulate a call to the S1 data view creator, with appropriate
     # options
@@ -523,7 +522,7 @@
     my %op = ('pathextra' => "/atom",
               'apilinks'  => 1,
               );
-    my $ret = LJ::Feed::make_feed($r, $u, $remote, \%op);
+    my $ret = LJ::Feed::make_feed($u, $remote, \%op);
 
     unless (defined $ret) {
         if ($op{'redir'}) {
@@ -531,19 +530,19 @@
             # the redir URL is wrong because ljfeed.pl is too
             # dataview-specific. Since this is an admin interface, we can
             # just fail.
-            return respond ($r, 404, "The account <b>$u->{'user'} </b> is of a wrong type and does not allow AtomAPI administration.");
+            return respond(404, "The account <b>$u->{'user'} </b> is of a wrong type and does not allow AtomAPI administration.");
         }
         if ($op{'handler_return'}) {
             # this could be a conditional GET shortcut, honor it
-            $r->status($op{'handler_return'});
+            LJ::Request->status($op{'handler_return'});
             return OK;
         }
         # should never get here
-        return respond ($r, 404, "Unknown error.");
+        return respond(404, "Unknown error.");
     }
 
     # everything's fine, return the XML body with the correct content type
-    return respond($r, 200, \$ret, 'xml');
+    return respond(200, \$ret, 'xml');
 
 }
 
@@ -551,7 +550,6 @@
 # authentication, calls the appropriate method handler, and
 # prints the response.
 sub handle {
-    my $r = shift;
 
     my $have_xmlatom = eval {
         require XML::Atom;
@@ -561,12 +559,12 @@
         XML::Atom->VERSION < 0.09 ? 0 : 1
     };
 
-    return respond($r, 404, "This server does not support the Atom API.")
+    return respond(404, "This server does not support the Atom API.")
         unless $have_xmlatom;
 
     # break the uri down: /interface/atom/<verb>[/<number>]
     # or old format:      /interface/atomapi/<username>/<verb>[/<number>]
-    my $uri = $r->uri;
+    my $uri = LJ::Request->uri;
 
     # convert old format to new format:
     my $username;   # old
@@ -574,7 +572,7 @@
         $username = $1;
     }
 
-    $uri =~ s!^/interface/atom/?!! or return respond($r, 404, "Bogus URL");
+    $uri =~ s!^/interface/atom/?!! or return respond(404, "Bogus URL");
     my ($action, $param) = split(m!/!, $uri);
 
     my $valid_actions = qr{feed|edit|post|upload|categories};
@@ -583,18 +581,18 @@
     #
     # if wsse information is supplied, use it.
     # if not, fall back to digest.
-    my $wsse = $r->header_in('X-WSSE');
+    my $wsse = LJ::Request->header_in('X-WSSE');
     my $nonce_dup;
-    my $u = $wsse ? auth_wsse($wsse, \$nonce_dup) : LJ::auth_digest($r);
-    return respond( $r, 401, "Authentication failed for this AtomAPI request.")
+    my $u = $wsse ? auth_wsse($wsse, \$nonce_dup) : LJ::auth_digest(LJ::Request->r);
+    return respond(401, "Authentication failed for this AtomAPI request.")
         unless $u;
 
-    return respond( $r, 401, "Authentication failed for this AtomAPI request.")
+    return respond(401, "Authentication failed for this AtomAPI request.")
         if $nonce_dup && $action && $action ne 'post';
 
     # service autodiscovery
     # TODO: Add communities?
-    my $method = $r->method;
+    my $method = LJ::Request->method;
     if ( $method eq 'GET' && ! $action ) {
         LJ::load_user_props( $u, 'journaltitle' );
         my $title = $u->{journaltitle} || $u->{user};
@@ -623,11 +621,11 @@
         $link->href( LJ::journal_base($u) );
         $feed->add_link($link);
 
-        return respond($r, 200, \$feed->as_xml(), 'atom');
+        return respond(200, \$feed->as_xml(), 'atom');
     }
 
     $action =~ /^$valid_actions$/
-      or return respond($r, 400, "Unknown URI scheme: /interface/atom/<b>" . LJ::ehtml($action) . "</b>");
+      or return respond(400, "Unknown URI scheme: /interface/atom/<b>" . LJ::ehtml($action) . "</b>");
 
     unless (($action eq 'feed' and $method eq 'GET')  or
             ($action eq 'categories' and $method eq 'GET') or
@@ -635,19 +633,19 @@
             ($action eq 'upload' and $method eq 'POST') or
             ($action eq 'edit' and
              {'GET'=>1,'PUT'=>1,'DELETE'=>1}->{$method})) {
-        return respond($r, 400, "URI scheme /interface/atom/<b>" . LJ::ehtml($action) . "</b> is incompatible with request method <b>$method</b>.");
+        return respond(400, "URI scheme /interface/atom/<b>" . LJ::ehtml($action) . "</b> is incompatible with request method <b>$method</b>.");
     }
 
     if (($action ne 'edit' && $param) or
         ($action eq 'edit' && $param !~ m#^\d+$#)) {
-        return respond($r, 400, "Either the URI lacks a required parameter, or its format is improper.");
+        return respond(400, "Either the URI lacks a required parameter, or its format is improper.");
     }
 
     # we've authenticated successfully and remote is set. But can remote
     # manage the requested account?
     my $remote = LJ::get_remote();
     unless (LJ::can_manage($remote, $u)) {
-        return respond($r, 403, "User <b>$remote->{'user'}</b> has no administrative access to account <b>$u->{user}</b>.");
+        return respond(403, "User <b>$remote->{'user'}</b> has no administrative access to account <b>$u->{user}</b>.");
     }
 
     # handle the requested action
@@ -663,7 +661,7 @@
         'edit'       => \&handle_edit,
         'upload'     => \&handle_upload,
         'categories' => \&handle_categories,
-    }->{$action}->( $r, $remote, $u, $opts );
+    }->{$action}->($remote, $u, $opts);
 
     return OK;
 }

Modified: branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/FotoBilder.pm
===================================================================
--- branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/FotoBilder.pm	2010-01-18 10:06:34 UTC (rev 16097)
+++ branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/FotoBilder.pm	2010-01-18 10:10:23 UTC (rev 16098)
@@ -28,23 +28,22 @@
 
 sub handler
 {
-    my $r = shift;
-    my $uri = $r->uri;
+    my $uri = LJ::Request->uri;
     return 404 unless $uri =~ m#^/interface/fotobilder(?:/(\w+))?$#;
     my $cmd = $1;
 
-    return BAD_REQUEST unless $r->method eq "POST";
+    return BAD_REQUEST unless LJ::Request->method eq "POST";
 
-    $r->content_type("text/plain");
-    $r->send_http_header();
+    LJ::Request->content_type("text/plain");
+    LJ::Request->send_http_header();
 
-    my %POST = $r->content;
+    my %POST = LJ::Request->post_params;
     my $res = run_method($cmd, \%POST)
         or return BAD_REQUEST;
 
     $res->{"fotobilder-interface-version"} = 1;
 
-    $r->print(join("", map { "$_: $res->{$_}\n" } keys %$res));
+    LJ::Request->print(join("", map { "$_: $res->{$_}\n" } keys %$res));
 
     return OK;
 }

Modified: branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/S2.pm
===================================================================
--- branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/S2.pm	2010-01-18 10:06:34 UTC (rev 16097)
+++ branches/modernize2/cgi-bin/Apache/LiveJournal/Interface/S2.pm	2010-01-18 10:10:23 UTC (rev 16098)
@@ -10,11 +10,10 @@
 sub load { 1 }
 
 sub handler {
-    my $r = shift;
 
-    my $meth = $r->method();
-    my %GET = $r->args();
-    my $uri = $r->uri();
+    my $meth = LJ::Request->method();
+    my %GET = LJ::Request->args();
+    my $uri = LJ::Request->uri();
     my $id;
     if ($uri =~ m!^/interface/s2/(\d+)$!) {
         $id = $1 + 0;
@@ -23,17 +22,17 @@
     }
 
     my $lay = LJ::S2::load_layer($id);
-    return error($r, 404, 'Layer not found', "There is no layer with id $id at this site")
+    return error(404, 'Layer not found', "There is no layer with id $id at this site")
         unless $lay;
 
-    LJ::auth_digest($r);
+    LJ::auth_digest(LJ::Request->r);
     my $u = LJ::get_remote();
     unless ($u) {
         # Tell the client how it can authenticate
         # use digest authorization.
 
-        $r->send_http_header("text/plain; charset=utf-8");
-        $r->print("Unauthorized\nYou must send your $LJ::SITENAME username and password or a valid session cookie\n");
+        LJ::Request->send_http_header("text/plain; charset=utf-8");
+        LJ::Request->print("Unauthorized\nYou must send your $LJ::SITENAME username and password or a valid session cookie\n");
 
         return OK;
     }
@@ -42,12 +41,12 @@
 
     my $lu = LJ::load_userid($lay->{'userid'});
 
-    return error($r, 500, "Error", "Unable to find layer owner.")
+    return error(500, "Error", "Unable to find layer owner.")
         unless $lu;
 
     if ($meth eq 'GET') {
 
-        return error($r, 403, "Forbidden", "You are not authorized to retrieve this layer")
+        return error(403, "Forbidden", "You are not authorized to retrieve this layer")
             unless $lu->{'user'} eq 'system' || LJ::can_manage($u, $lu);
 
         my $layerinfo = {};
@@ -56,40 +55,40 @@
             $layerinfo->{$id}->{'source_viewable'} : 1;
 
         # Disallow retrieval of protected system layers
-        return error($r, 403, "Forbidden", "The requested layer is restricted")
+        return error(403, "Forbidden", "The requested layer is restricted")
             if $lu->{'user'} eq 'system' && ! $srcview;
 
         my $s2code = LJ::S2::load_layer_source($id);
 
-        $r->send_http_header("application/x-danga-s2-layer");
-        $r->print($s2code);
+        LJ::Request->send_http_header("application/x-danga-s2-layer");
+        LJ::Request->print($s2code);
 
     }
     elsif ($meth eq 'PUT') {
 
-        return error($r, 403, "Forbidden", "You are not authorized to edit this layer")
+        return error(403, "Forbidden", "You are not authorized to edit this layer")
             unless LJ::can_manage($u, $lu);
 
-        return error($r, 403, "Forbidden", "Your account type is not allowed to edit layers")
+        return error(403, "Forbidden", "Your account type is not allowed to edit layers")
             unless LJ::get_cap($u, "s2styles");
 
         # Read in the entity body to get the source
-        my $len = $r->header_in("Content-length")+0;
+        my $len = LJ::Request->header_in("Content-length")+0;
 
-        return error($r, 400, "Bad Request", "Supply S2 layer code in the request entity body and set Content-length")
+        return error(400, "Bad Request", "Supply S2 layer code in the request entity body and set Content-length")
             unless $len;
 
-        return error($r, 415, "Bad Media Type", "Request body must be of type application/x-danga-s2-layer")
-            unless lc($r->header_in("Content-type")) eq 'application/x-danga-s2-layer';
+        return error(415, "Bad Media Type", "Request body must be of type application/x-danga-s2-layer")
+            unless lc(LJ::Request->header_in("Content-type")) eq 'application/x-danga-s2-layer';
 
         my $s2code;
-        $r->read($s2code, $len);
+        LJ::Request->read($s2code, $len);
 
         my $error = "";
         LJ::S2::layer_compile($lay, \$error, { 's2ref' => \$s2code });
 
         if ($error) {
-            error($r, 500, "Layer Compile Error", "An error was encountered while compiling the layer.");
+            error(500, "Layer Compile Error", "An error was encountered while compiling the layer.");
 
             ## Strip any absolute paths
             $error =~ s/LJ::.+//s;
@@ -99,25 +98,25 @@
             return OK;
         }
         else {
-            $r->status_line("201 Compiled and Saved");
-            $r->header_out("Location" => "$LJ::SITEROOT/interface/s2/$id");
-            $r->send_http_header("text/plain; charset=utf-8");
-            $r->print("Compiled and Saved\nThe layer was uploaded successfully.\n");
+            LJ::Request->status_line("201 Compiled and Saved");
+            LJ::Request->header_out("Location" => "$LJ::SITEROOT/interface/s2/$id");
+            LJ::Request->send_http_header("text/plain; charset=utf-8");
+            LJ::Request->print("Compiled and Saved\nThe layer was uploaded successfully.\n");
         }
     }
     else {
         #  Return 'method not allowed' so that we can add methods in future
         # and clients will get a sensible error from old servers.
-        return error($r, 405, 'Method Not Allowed', 'Only GET and PUT are supported for this resource');
+        return error(405, 'Method Not Allowed', 'Only GET and PUT are supported for this resource');
     }
 }
 
 sub error {
-    my ($r, $code, $string, $long) = @_;
+    my ($code, $string, $long) = @_;
 
-    $r->status_line("$code $string");
-    $r->send_http_header("text/plain; charset=utf-8");
-    $r->print("$string\n$long\n");
+    LJ::Request->status_line("$code $string");
+    LJ::Request->send_http_header("text/plain; charset=utf-8");
+    LJ::Request->print("$string\n$long\n");
 
     # Tell Apache OK so it won't try to handle the error
     return OK;

Modified: branches/modernize2/cgi-bin/Apache/LiveJournal/PalImg.pm
===================================================================
--- branches/modernize2/cgi-bin/Apache/LiveJournal/PalImg.pm	2010-01-18 10:06:34 UTC (rev 16097)
+++ branches/modernize2/cgi-bin/Apache/LiveJournal/PalImg.pm	2010-01-18 10:10:23 UTC (rev 16098)
@@ -17,9 +17,9 @@
 sub handler
 {
     my $r = shift;
-    my $uri = $r->uri;
+    my $uri = LJ::Request->uri;
     my ($base, $ext, $extra) = $uri =~ m!^/palimg/(.+)\.(\w+)(.*)$!;
-    $r->notes("codepath" => "img.palimg");
+    LJ::Request->notes("codepath" => "img.palimg");
     return 404 unless $base && $base !~ m!\.\.!;
 
     my $disk_file = "$LJ::HOME/htdocs/palimg/$base.$ext";
@@ -44,7 +44,7 @@
         }
     }
 
-    return send_file($r, $disk_file, {
+    return send_file($disk_file, {
         'mime' => $mime,
         'etag' => $etag,
         'palspec' => $palspec,
@@ -61,7 +61,7 @@
 
 sub send_file
 {
-    my ($r, $disk_file, $opts) = @_;
+    my ($disk_file, $opts) = @_;
 
     my $etag = $opts->{'etag'};
 
@@ -112,23 +112,46 @@
     }
 
     $etag = '"' . $etag . '"';
-    my $ifnonematch = $r->header_in("If-None-Match");
+    my $ifnonematch = LJ::Request->header_in("If-None-Match");
     return HTTP_NOT_MODIFIED if
         defined $ifnonematch && $etag eq $ifnonematch;
 
     # send the file
-    $r->content_type($opts->{'mime'});
-    $r->header_out("Content-length", $opts->{'size'});
-    $r->header_out("ETag", $etag);
+    LJ::Request->content_type($opts->{'mime'});
+    LJ::Request->header_out("Content-length", $opts->{'size'});
+    LJ::Request->header_out("ETag", $etag);
     if ($opts->{'modtime'}) {
-        $r->update_mtime($opts->{'modtime'});
-        $r->set_last_modified();
+        LJ::Request->update_mtime($opts->{'modtime'});
+        LJ::Request->set_last_modified();
     }
-    $r->send_http_header();
+    LJ::Request->send_http_header();
 
     # HEAD request?
-    return OK if $r->method eq "HEAD";
+    return OK if LJ::Request->method eq "HEAD";
 
+    # this is slow way of sending file.
+    # but in productions this code should not be called.
+    open my $fh, "<" => $disk_file
+        or return 404;
+    binmode $fh;
+    my $palette = undef;
+    if (%pal_colors) {
+        if ($opts->{'mime'} eq "image/gif") {
+            $palette = PaletteModify::new_gif_palette($fh, \%pal_colors);
+        } elsif ($opts->{'mime'} == "image/png") {
+            $palette = PaletteModify::new_png_palette($fh, \%pal_colors);
+        }
+        unless ($palette) {
+            return 404;  # image isn't palette changeable?
+        }
+    }
+    LJ::Request->print($palette) if $palette;
+    while (my $readed = read($fh, my $buf, 1024*1024)){
+        LJ::Request->print($buf);
+    }
+    close $fh;
+
+=head
     my $fh = Apache::File->new($disk_file);
     return 404 unless $fh;
     binmode($fh);
@@ -148,6 +171,7 @@
     $r->print($palette) if $palette; # when palette modified.
     $r->send_fd($fh); # sends remaining data (or all of it) quickly
     $fh->close();
+=cut
     return OK;
 }
 

Modified: branches/modernize2/cgi-bin/Apache/LiveJournal.pm
===================================================================
--- branches/modernize2/cgi-bin/Apache/LiveJournal.pm	2010-01-18 10:06:34 UTC (rev 16097)
+++ branches/modernize2/cgi-bin/Apache/LiveJournal.pm	2010-01-18 10:10:23 UTC (rev 16098)
@@ -6,6 +6,7 @@
 use strict;
 no warnings 'uninitialized';
 
+use LJ::Request;
 use Apache::Constants qw(:common REDIRECT HTTP_NOT_MODIFIED
                          HTTP_MOVED_PERMANENTLY HTTP_MOVED_TEMPORARILY
                          M_TRACE M_OPTIONS);
@@ -88,20 +89,26 @@
 # init handler (PostReadRequest)
 sub handler
 {
-    my $r = shift;
+    my $class = ();
+    my $r     = shift;
 
+    LJ::Request->free();
+    LJ::Request->init($r);
+
+    $class = __PACKAGE__ unless $class;
+
     if ($LJ::SERVER_TOTALLY_DOWN) {
-        $r->handler("perl-script");
-        $r->set_handlers(PerlHandler => [ \&totally_down_content ]);
+        LJ::Request->handler("perl-script");
+        LJ::Request->set_handlers(PerlHandler => [ \&totally_down_content ]);
         return OK;
     }
 
     # only perform this once in case of internal redirects
-    if ($r->is_initial_req) {
-        $r->push_handlers(PerlCleanupHandler => sub { %RQ = () });
-        $r->push_handlers(PerlCleanupHandler => "Apache::LiveJournal::db_logger");
-        $r->push_handlers(PerlCleanupHandler => "LJ::end_request");
-        $r->push_handlers(PerlCleanupHandler => "Apache::DebateSuicide");
+    if (LJ::Request->is_initial_req) {
+        LJ::Request->push_handlers(PerlCleanupHandler => sub { %RQ = () });
+        LJ::Request->push_handlers(PerlCleanupHandler => "Apache::LiveJournal::db_logger");
+        LJ::Request->push_handlers(PerlCleanupHandler => "LJ::end_request");
+        LJ::Request->push_handlers(PerlCleanupHandler => "Apache::DebateSuicide");
 
         if ($LJ::TRUST_X_HEADERS) {
             # if we're behind a lite mod_proxy front-end, we need to trick future handlers
@@ -109,8 +116,8 @@
             # by the fact that mod_proxy did nothing, requiring mod_proxy_add_forward, then
             # decided to do X-Forwarded-For, then did X-Forwarded-Host, so we have to deal
             # with all permutations of versions, hence all the ugliness:
-            @req_hosts = ($r->connection->remote_ip);
-            if (my $forward = $r->header_in('X-Forwarded-For'))
+            @req_hosts = (LJ::Request->remote_ip);
+            if (my $forward = LJ::Request->header_in('X-Forwarded-For'))
             {
                 my (@hosts, %seen);
                 foreach (split(/\s*,\s*/, $forward)) {
@@ -120,16 +127,16 @@
                 }
                 if (@hosts) {
                     my $real = shift @hosts;
-                    $r->connection->remote_ip($real);
+                    LJ::Request->remote_ip($real);
                 }
-                $r->header_in('X-Forwarded-For', join(", ", @hosts));
+                LJ::Request->header_in('X-Forwarded-For', join(", ", @hosts));
             }
 
             # and now, deal with getting the right Host header
-            if ($_ = $r->header_in('X-Host')) {
-                $r->header_in('Host', $_);
-            } elsif ($_ = $r->header_in('X-Forwarded-Host')) {
-                $r->header_in('Host', $_);
+            if ($_ = LJ::Request->header_in('X-Host')) {
+                LJ::Request->header_in('Host', $_);
+            } elsif ($_ = LJ::Request->header_in('X-Forwarded-Host')) {
+                LJ::Request->header_in('Host', $_);
             }
         }
 
@@ -170,64 +177,63 @@
         LJ::work_report_start();
     }
 
-    $r->set_handlers(PerlTransHandler => [ \&trans ]);
+    LJ::Request->set_handlers(PerlTransHandler => [ \&trans ]);
 
     return OK;
 }
 
 sub redir {
-    my ($r, $url, $code) = @_;
-    $r->content_type("text/html");
-    $r->header_out(Location => $url);
+    my ($url, $code) = @_;
+    LJ::Request->content_type("text/html");
+    LJ::Request->header_out(Location => $url);
     if ($LJ::DEBUG{'log_redirects'}) {
-        $r->log_error("redirect to $url from: " . join(", ", caller(0)));
+        LJ::Request->log_error("redirect to $url from: " . join(", ", caller(0)));
     }
     return $code || REDIRECT;
 }
 
 # send the user to the URL for them to get their domain session cookie
 sub remote_domsess_bounce {
-    my $r = Apache->request;
-    return redir($r, LJ::remote_bounce_url(), HTTP_MOVED_TEMPORARILY);
+    return redir(LJ::remote_bounce_url(), HTTP_MOVED_TEMPORARILY);
 }
 
 sub totally_down_content
 {
-    my $r = shift;
-    my $uri = $r->uri;
+    #my $r = shift;
+    my $uri = LJ::Request->uri;
 
     if ($uri =~ m!^/interface/flat! || $uri =~ m!^/cgi-bin/log\.cg!) {
-        $r->content_type("text/plain");
-        $r->send_http_header();
-        $r->print("success\nFAIL\nerrmsg\n$LJ::SERVER_DOWN_MESSAGE");
+        LJ::Request->content_type("text/plain");
+        LJ::Request->send_http_header();
+        LJ::Request->print("success\nFAIL\nerrmsg\n$LJ::SERVER_DOWN_MESSAGE");
         return OK;
     }
 
     if ($uri =~ m!^/customview.cgi!) {
-        $r->content_type("text/html");
-        $r->send_http_header();
-        $r->print("<!-- $LJ::SERVER_DOWN_MESSAGE -->");
+        LJ::Request->content_type("text/html");
+        LJ::Request->send_http_header();
+        LJ::Request->print("<!-- $LJ::SERVER_DOWN_MESSAGE -->");
         return OK;
     }
 
     # set to 500 so people don't cache this error message
     my $body = "<h1>$LJ::SERVER_DOWN_SUBJECT</h1>$LJ::SERVER_DOWN_MESSAGE<!-- " . ("x" x 1024) . " -->";
-    $r->status_line("503 Server Maintenance");
-    $r->content_type("text/html");
-    $r->header_out("Content-length", length $body);
-    $r->send_http_header();
+    LJ::Request->status_line("503 Server Maintenance");
+    LJ::Request->content_type("text/html");
+    LJ::Request->header_out("Content-length", length $body);
+    LJ::Request->send_http_header();
 
-    $r->print($body);
+    LJ::Request->print($body);
     return OK;
 }
 
 sub blocked_bot
 {
-    my $r = shift;
+    #my $r = shift;
 
-    $r->status_line("403 Denied");
-    $r->content_type("text/html");
-    $r->send_http_header();
+    LJ::Request->status_line("403 Denied");
+    LJ::Request->content_type("text/html");
+    LJ::Request->send_http_header();
     my $subject = $LJ::BLOCKED_BOT_SUBJECT || "403 Denied";
     my $message = $LJ::BLOCKED_BOT_MESSAGE || "You don't have permission to view this page.";
 
@@ -237,31 +243,31 @@
         $message .= " $uniq @ $ip";
     }
 
-    $r->print("<h1>$subject</h1>$message");
+    LJ::Request->print("<h1>$subject</h1>$message");
     return OK;
 }
 
 sub trans
 {
-    my $r = shift;
-    return DECLINED if ! $r->is_main || $r->method_number == M_OPTIONS;  # don't deal with subrequests or OPTIONS
+    #my $r = shift;
+    return DECLINED if ! LJ::Request->is_main || LJ::Request->method_number == LJ::Request->M_OPTIONS;  # don't deal with subrequests or OPTIONS
 
-    my $uri = $r->uri;
-    my $args = $r->args;
+    my $uri = LJ::Request->uri;
+    my $args = LJ::Request->args;
     my $args_wq = $args ? "?$args" : "";
-    my $host = $r->header_in("Host");
+    my $host = LJ::Request->header_in("Host");
     my $hostport = ($host =~ s/:\d+$//) ? $& : "";
     $host =~ s/\.$//; ## 'www.livejournal.com.' is a valid DNS hostname
-    
+
     # disable TRACE (so scripts on non-LJ domains can't invoke
     # a trace to get the LJ cookies in the echo)
-    return FORBIDDEN if $r->method_number == M_TRACE;
+    return FORBIDDEN if LJ::Request->method_number == M_TRACE;
 
     # If the configuration says to log statistics and GTop is available, mark
     # values before the request runs so it can be turned into a delta later
     if (my $gtop = LJ::gtop()) {
-        $r->pnotes( 'gtop_cpu' => $gtop->cpu );
-        $r->pnotes( 'gtop_mem' => $gtop->proc_mem($$) );
+        LJ::Request->pnotes( 'gtop_cpu' => $gtop->cpu );
+        LJ::Request->pnotes( 'gtop_mem' => $gtop->proc_mem($$) );
     }
 
     LJ::start_request();
@@ -271,19 +277,17 @@
     my $lang = $LJ::DEFAULT_LANG || $LJ::LANGS[0];
     BML::set_language($lang, \&LJ::Lang::get_text);
 
-    my $is_ssl = $LJ::IS_SSL = LJ::run_hook("ssl_check", {
-        r => $r,
-    });
+    my $is_ssl = $LJ::IS_SSL = LJ::run_hook("ssl_check");
 
     my $bml_handler = sub {
         my $filename = shift;
-        $r->handler("perl-script");
-        $r->notes("bml_filename" => $filename);
-        $r->push_handlers(PerlHandler => \&Apache::BML::handler);
+        LJ::Request->handler("perl-script");
+        LJ::Request->notes("bml_filename" => $filename);
+        LJ::Request->push_handlers(PerlHandler => \&Apache::BML::handler);
         return OK;
     };
 
-    if ($r->is_initial_req) {
+    if (LJ::Request->is_initial_req) {
         # delete cookies if there are any we want gone
         if (my $cookie = $LJ::DEBUG{"delete_cookie"}) {
             LJ::Session::set_cookie($cookie => 0, delete => 1, domain => $LJ::DOMAIN, path => "/");
@@ -298,13 +302,13 @@
 
               # apply sysban block if applicable
               if (LJ::UniqCookie->sysban_should_block) {
-                  $r->handler("perl-script");
-                  $r->push_handlers(PerlHandler => \&blocked_bot );
+                  LJ::Request->handler("perl-script");
+                  LJ::Request->push_handlers(PerlHandler => \&blocked_bot );
                   return OK;
               }
           }
     } else { # not is_initial_req
-        if ($r->status == 404) {
+        if (LJ::Request->status == 404) {
             my $fn = $LJ::PAGE_404 || "404-error.html";
             return $bml_handler->("$LJ::HOME/htdocs/" . $fn);
         }
@@ -315,18 +319,18 @@
     unless ( $LJ::BLOCKED_BOT_URI && index( $uri, $LJ::BLOCKED_BOT_URI ) == 0 ) {
         foreach my $ip (@req_hosts) {
             if (LJ::sysban_check('ip', $ip)) {
-                $r->handler("perl-script");
-                $r->push_handlers(PerlHandler => \&blocked_bot );
+                LJ::Request->handler("perl-script");
+                LJ::Request->push_handlers(PerlHandler => \&blocked_bot );
                 return OK;
             }
         }
-        if (LJ::run_hook("forbid_request", $r)) {
-            $r->handler("perl-script");
-            $r->push_handlers(PerlHandler => \&blocked_bot );
+        if (LJ::run_hook("forbid_request")) {
+            LJ::Request->handler("perl-script");
+            LJ::Request->push_handlers(PerlHandler => \&blocked_bot );
             return OK;
         }
     }
-    
+
     # only allow certain pages over SSL
     if ($is_ssl) {
         if ($uri =~ m!^/interface/! || $uri =~ m!^/__rpc_!) {
@@ -335,11 +339,11 @@
             my $file = "$LJ::SSLDOCS/$uri";
             unless (-e $file) {
                 # no such file.  send them to the main server if it's a GET.
-                return $r->method eq 'GET' ? redir($r, "$LJ::SITEROOT$uri$args_wq") : 404;
+                return LJ::Request->method eq 'GET' ? redir("$LJ::SITEROOT$uri$args_wq") : 404;
             }
             if (-d _) { $file .= "/index.bml"; }
             $file =~ s!/{2,}!/!g;
-            $r->filename($file);
+            LJ::Request->filename($file);
             $LJ::IMGPREFIX = "/img";
             $LJ::STATPREFIX = "/stc";
             return OK;
@@ -356,32 +360,32 @@
     }
 
     # let foo.com still work, but redirect to www.foo.com
-    if ($LJ::DOMAIN_WEB && $r->method eq "GET" &&
+    if ($LJ::DOMAIN_WEB && LJ::Request->method eq "GET" &&
         $host eq $LJ::DOMAIN && $LJ::DOMAIN_WEB ne $LJ::DOMAIN)
     {
         my $url = "$LJ::SITEROOT$uri";
         $url .= "?" . $args if $args;
-        return redir($r, $url);
+        return redir($url);
     }
 
     # see if we should setup a minimal scheme based on the initial part of the
     # user-agent string; FIXME: maybe this should do more than just look at the
     # initial letters?
-    if (my $ua = $r->header_in('User-Agent')) {
+    if (my $ua = LJ::Request->header_in('User-Agent')) {
         if (($ua =~ /^([a-z]+)/i) && $LJ::MINIMAL_USERAGENT{$1}) {
-            $r->notes('use_minimal_scheme' => 1);
-            $r->notes('bml_use_scheme' => $LJ::MINIMAL_BML_SCHEME);
+            LJ::Request->notes('use_minimal_scheme' => 1);
+            LJ::Request->notes('bml_use_scheme' => $LJ::MINIMAL_BML_SCHEME);
         }
     }
 
     # now we know that the request is going to succeed, so do some checking if they have a defined
     # referer.  clients and such don't, so ignore them.
-    my $referer = $r->header_in("Referer");
-    if ($referer && $r->method eq 'POST' && !LJ::check_referer('', $referer)) {
-       $r->log_error("REFERER WARNING: POST to $uri from $referer");
+    my $referer = LJ::Request->header_in("Referer");
+    if ($referer && LJ::Request->method eq 'POST' && !LJ::check_referer('', $referer)) {
+       LJ::Request->log_error("REFERER WARNING: POST to $uri from $referer");
     }
 
-    my %GET = $r->args;
+    my %GET = LJ::Request->args;
 
     if ($LJ::IS_DEV_SERVER && $GET{'as'} =~ /^\w{1,15}$/) {
         my $ru = LJ::load_user($GET{'as'});
@@ -389,8 +393,8 @@
     }
 
     # anti-squatter checking
-    if ($LJ::DEBUG{'anti_squatter'} && $r->method eq "GET") {
-        my $ref = $r->header_in("Referer");
+    if ($LJ::DEBUG{'anti_squatter'} && LJ::Request->method eq "GET") {
+        my $ref = LJ::Request->header_in("Referer");
         if ($ref && index($ref, $LJ::SITEROOT) != 0) {
             # FIXME: this doesn't anti-squat user domains yet
             if ($uri !~ m!^/404!) {
@@ -401,8 +405,8 @@
                 # FIXME: why??  why doesn't it just work to return OK
                 # the first time with the handlers pushed?  nothing
                 # else requires this chicanery!
-                $r->handler("perl-script");
-                $r->push_handlers(PerlHandler => \&anti_squatter);
+                LJ::Request->handler("perl-script");
+                LJ::Request->push_handlers(PerlHandler => \&anti_squatter);
             }
             return OK;
         }
@@ -414,8 +418,8 @@
     }
 
     # allow html pages (with .html extention) in user domains and in common www. domain.
-    if ($r->uri =~ m|\A\/__html(\/.+\.html)\z|){
-        $r->uri($1);
+    if (LJ::Request->uri =~ m|\A\/__html(\/.+\.html)\z|){
+        LJ::Request->uri($1);
         return DECLINED;
     }
 
@@ -445,7 +449,7 @@
             # consistent for the concatenation before redirect
             $newurl =~ s!^/(users/|community/|~)\Q$orig_user\E!/!;
             $newurl = LJ::journal_base($u) . "$newurl$args_wq";
-            return redir($r, $newurl);
+            return redir($newurl);
         }
 
         # check if this entry or journal contains adult content
@@ -483,7 +487,7 @@
             my $is_journal_page = !$opts->{mode} || $journal_pages{$opts->{mode}};
 
             if ($adult_content ne "none" && $is_journal_page && !$should_show_page) {
-                my $returl = LJ::eurl("http://$host" . $r->uri . "$args_wq");
+                my $returl = LJ::eurl("http://$host" . LJ::Request->uri . "$args_wq");
 
                 LJ::ContentFlag->check_adult_cookie($returl, \%BMLCodeBlock::POST, "concepts");
                 LJ::ContentFlag->check_adult_cookie($returl, \%BMLCodeBlock::POST, "explicit");
@@ -499,14 +503,14 @@
                 # logged in users without defined ages and logged out users are given confirmation pages (unless they have already confirmed)
                 if ($remote) {
                     if (($adult_content eq "explicit" && $remote->is_minor) || ($adult_content eq "concepts" && $remote->is_child)) {
-                        $r->args("user=" . LJ::eurl($opts->{'user'}));
+                        LJ::Request->args("user=" . LJ::eurl($opts->{'user'}));
                         return $bml_handler->(LJ::ContentFlag->adult_interstitial_path(type => "${adult_content}_blocked"));
                     } elsif (!$remote->best_guess_age && !$cookie) {
-                        $r->args("ret=$returl&user=" . LJ::eurl($opts->{'user'}));
+                        LJ::Request->args("ret=$returl&user=" . LJ::eurl($opts->{'user'}));
                         return $bml_handler->(LJ::ContentFlag->adult_interstitial_path(type => $adult_content));
                     }
                 } elsif (!$remote && !$cookie) {
-                    $r->args("ret=$returl&user=" . LJ::eurl($opts->{'user'}));
+                    LJ::Request->args("ret=$returl&user=" . LJ::eurl($opts->{'user'}));
                     return $bml_handler->(LJ::ContentFlag->adult_interstitial_path(type => $adult_content));
                 }
             }
@@ -516,14 +520,14 @@
             my $u = LJ::load_user($opts->{user})
                 or return 404;
             my $mode = $GET{mode} eq 'full' ? '?mode=full' : '';
-            return redir($r, $u->profile_url . $mode);
+            return redir($u->profile_url . $mode);
         }
 
         if ($opts->{'mode'} eq "profile") {
             my $burl = LJ::remote_bounce_url();
             return remote_domsess_bounce() if LJ::remote_bounce_url();
 
-            $r->notes("_journal" => $opts->{'user'});
+            LJ::Request->notes("_journal" => $opts->{'user'});
 
             # this is the notes field that all other s1/s2 pages use.
             # so be consistent for people wanting to read it.
@@ -532,7 +536,7 @@
             # passed to the userinfo BML page, whereas this one only
             # works if journalid exists.
             if (my $u = LJ::load_user($opts->{user})) {
-                $r->notes("journalid" => $u->{userid});
+                LJ::Request->notes("journalid" => $u->{userid});
             }
 
             my $file = LJ::run_hook("profile_bml_file");
@@ -547,7 +551,7 @@
             my $u = LJ::load_user($opts->{user})
                 or return 404;
 
-            return redir($r, "$LJ::SITEROOT/update.bml?usejournal=".$u->{'user'});
+            return redir("$LJ::SITEROOT/update.bml?usejournal=".$u->{'user'});
         }
 
         %RQ = %$opts;
@@ -559,19 +563,19 @@
 
             my ($mode, $path) = ($1, $2);
             if ($mode eq "customview") {
-                $r->handler("perl-script");
-                $r->push_handlers(PerlHandler => \&customview_content);
+                LJ::Request->handler("perl-script");
+                LJ::Request->push_handlers(PerlHandler => \&customview_content);
                 return OK;
             }
             if (my $handler = LJ::run_hook("data_handler:$mode", $RQ{'user'}, $path)) {
-                $r->handler("perl-script");
-                $r->push_handlers(PerlHandler => $handler);
+                LJ::Request->handler("perl-script");
+                LJ::Request->push_handlers(PerlHandler => $handler);
                 return OK;
             }
         }
 
-        $r->handler("perl-script");
-        $r->push_handlers(PerlHandler => \&journal_content);
+        LJ::Request->handler("perl-script");
+        LJ::Request->push_handlers(PerlHandler => \&journal_content);
         return OK;
     };
 
@@ -586,11 +590,11 @@
         return DECLINED if $uuri eq "/favicon.ico";
 
         # see if there is a modular handler for this URI
-        my $ret = LJ::URI->handle($uuri, $r);
+        my $ret = LJ::URI->handle($uuri, LJ::Request->r);
         return $ret if defined $ret;
 
         if ($uuri eq "/__setdomsess") {
-            return redir($r, LJ::Session->setdomsess_handler($r));
+            return redir(LJ::Session->setdomsess_handler());
         }
 
         if ($uuri =~ m#^/(\d+)\.html$#) {
@@ -612,7 +616,7 @@
                 $proper .= "/$mon" if defined $mon;
                 $proper .= "/$day" if defined $day;
                 $proper .= "/";
-                return redir($r, $proper);
+                return redir($proper);
             }
 
             # the S1 ljviews code looks at $opts->{'pathextra'}, because
@@ -639,18 +643,18 @@
             if ($mode =~ /^day|calendar$/ && $pe =~ m!^/\d\d\d\d!) {
                 my $newuri = $uri;
                 $newuri =~ s!$mode/(\d\d\d\d)!$1!;
-                return redir($r, LJ::journal_base($user) . $newuri);
+                return redir(LJ::journal_base($user) . $newuri);
             } elsif ($mode eq 'rss') {
                 # code 301: moved permanently, update your links.
-                return redir($r, LJ::journal_base($user) . "/data/rss$args_wq", 301);
+                return redir(LJ::journal_base($user) . "/data/rss$args_wq", 301);
             } elsif ($mode eq 'pics' && $LJ::REDIRECT_ALLOWED{$LJ::FB_DOMAIN}) {
                 # redirect to a user's gallery
                 my $url = "$LJ::FB_SITEROOT/$user";
-                return redir($r, $url);
+                return redir($url);
             } elsif ($mode eq 'tag') {
 
                 # tailing slash on here to prevent a second redirect after this one
-                return redir($r, LJ::journal_base($user) . "$uri/") unless $pe;
+                return redir(LJ::journal_base($user) . "$uri/") unless $pe;
                 if ($pe eq '/') {
                     # tag list page
                     $mode = 'tag';
@@ -664,7 +668,7 @@
                 }
             } elsif ($mode eq 'security') {
                 # tailing slash on here to prevent a second redirect after this one
-                return redir($r, LJ::journal_base($user) . "$uri/") unless $pe;
+                return redir(LJ::journal_base($user) . "$uri/") unless $pe;
                 if ($pe eq '/') {
                     # do a 404 for now
                     return 404;
@@ -711,7 +715,7 @@
             my $renamedto = $u->{'renamedto'};
             if ($renamedto ne '') {
                 my $redirect_url = ($renamedto =~ m!^https?://!) ? $renamedto : LJ::journal_base($renamedto, $vhost) . $uuri . $args_wq;
-                return redir($r, $redirect_url, 301);
+                return redir($redirect_url, 301);
             }
         }
 
@@ -737,7 +741,7 @@
 
         # 1xx: info, 2xx: success, 3xx: redirect, 4xx: client err, 5xx: server err
         # let the main server handle any errors
-        $r->status < 400)
+        LJ::Request->status < 400)
     {
         my $user = $1;
 
@@ -756,14 +760,14 @@
 
         } elsif ($func eq 'portal') {
             # if this is a "portal" subdomain then prepend the portal URL
-            return redir($r, "$LJ::SITEROOT/portal/");
+            return redir("$LJ::SITEROOT/portal/");
 
         } elsif ($func eq 'support') {
-            return redir($r, "$LJ::SITEROOT/support/");
+            return redir("$LJ::SITEROOT/support/");
 
         } elsif (ref $func eq "ARRAY" && $func->[0] eq "changehost") {
 
-            return redir($r, "http://$func->[1]$uri$args_wq");
+            return redir("http://$func->[1]$uri$args_wq");
 
         } elsif ($uri =~ m!^/(?:talkscreen|delcomment)\.bml!) {
             # these URLs need to always work for the javascript comment management code
@@ -776,7 +780,7 @@
                 return DECLINED if $uri eq "/favicon.ico";
                 my $redir = LJ::run_hook("journal_subdomain_redirect_url",
                                          $host, $uri);
-                return redir($r, $redir) if $redir;
+                return redir($redir) if $redir;
                 return 404;
             }
             ($user, $uri) = ($1, $2);
@@ -786,7 +790,7 @@
             if (my $u = LJ::load_user($user)) {
                 my $canon_url = $u->journal_base;
                 unless ($canon_url =~ m!^http://$host!i || $LJ::DEBUG{'user_vhosts_no_wronghost_redirect'}) {
-                    return redir($r, "$canon_url$uri$args_wq");
+                    return redir("$canon_url$uri$args_wq");
                 }
             }
 
@@ -798,7 +802,7 @@
                 'userpics' => \&userpic_trans,
                 'files' => \&files_trans,
             };
-            return $code->{$func}->($r) if $code->{$func};
+            return $code->{$func}->(LJ::Request->r) if $code->{$func};
             return 404;  # bogus ljconfig
         } else {
             my $view = $determine_view->($user, "users", $uri);
@@ -830,7 +834,7 @@
     }
 
     # userpic
-    return userpic_trans($r) if $uri =~ m!^/userpic/!;
+    return userpic_trans() if $uri =~ m!^/userpic/!;
 
     # front page journal
     if ($LJ::FRONTPAGE_JOURNAL) {
@@ -861,11 +865,11 @@
             my $u = LJ::load_user($cuser)
                 or return 404;
             my $base = $u->journal_base;
-            return redir($r, "$base$srest$args_wq", correct_url_redirect_code());
+            return redir("$base$srest$args_wq", correct_url_redirect_code());
         }
 
         # redirect to canonical username and/or add slash if needed
-        return redir($r, "http://$host$hostport/$part1$cuser$srest$args_wq")
+        return redir("http://$host$hostport/$part1$cuser$srest$args_wq")
             if $cuser ne $user or not $rest;
 
         my $vhost = { 'users/' => '', 'community/' => 'community',
@@ -879,7 +883,6 @@
     if ($uri =~ m!^/interface/([\w\-]+)$!) {
         my $inthandle = LJ::run_hook("interface_handler", {
             int         => $1,
-            r           => $r,
             bml_handler => $bml_handler,
         });
         return $inthandle if defined $inthandle;
@@ -888,79 +891,79 @@
     # protocol support
     if ($uri =~ m!^/(?:interface/(\w+))|cgi-bin/log\.cgi!) {
         my $int = $1 || "flat";
-        $r->handler("perl-script");
+        LJ::Request->handler("perl-script");
         if ($int eq "fotobilder") {
-            return 403 unless $LJ::FOTOBILDER_IP{$r->connection->remote_ip};
-            $r->push_handlers(PerlHandler => \&Apache::LiveJournal::Interface::FotoBilder::handler);
+            return 403 unless $LJ::FOTOBILDER_IP{LJ::Request->remote_ip};
+            LJ::Request->push_handlers(PerlHandler => \&Apache::LiveJournal::Interface::FotoBilder::handler);
             return OK;
         }
         if ($int =~ /^flat|xmlrpc|blogger|elsewhere_info|atom(?:api)?$/) {
             $RQ{'interface'} = $int;
             $RQ{'is_ssl'} = $is_ssl;
-            $r->push_handlers(PerlHandler => \&interface_content);
+            LJ::Request->push_handlers(PerlHandler => \&interface_content);
             return OK;
         }
         if ($int eq "s2") {
             Apache::LiveJournal::Interface::S2->load;
-            $r->push_handlers(PerlHandler => \&Apache::LiveJournal::Interface::S2::handler);
+            LJ::Request->push_handlers(PerlHandler => \&Apache::LiveJournal::Interface::S2::handler);
             return OK;
         }
         return 404;
     }
 
     # see if there is a modular handler for this URI
-    my $ret = LJ::URI->handle($uri, $r);
+    my $ret = LJ::URI->handle($uri, LJ::Request->r);
     return $ret if defined $ret;
 
     # customview (get an S1 journal by number)
     if ($uri =~ m!^/customview\.cgi!) {
-        $r->handler("perl-script");
-        $r->push_handlers(PerlHandler => \&customview_content);
+        LJ::Request->handler("perl-script");
+        LJ::Request->push_handlers(PerlHandler => \&customview_content);
         return OK;
     }
 
     if ($uri =~ m!^/palimg/!) {
         Apache::LiveJournal::PalImg->load;
-        $r->handler("perl-script");
-        $r->push_handlers(PerlHandler => \&Apache::LiveJournal::PalImg::handler);
+        LJ::Request->handler("perl-script");
+        LJ::Request->push_handlers(PerlHandler => \&Apache::LiveJournal::PalImg::handler);
         return OK;
     }
 
     # redirected resources
     if ($REDIR{$uri}) {
         my $new = $REDIR{$uri};
-        if ($r->args) {
+        if (LJ::Request->args) {
             $new .= ($new =~ /\?/ ? "&" : "?");
-            $new .= $r->args;
+            $new .= LJ::Request->args;
         }
-        return redir($r, $new, HTTP_MOVED_PERMANENTLY);
+        return redir($new, HTTP_MOVED_PERMANENTLY);
     }
 
     # confirm
     if ($uri =~ m!^/confirm/(\w+\.\w+)!) {
-        return redir($r, "$LJ::SITEROOT/register.bml?$1");
+        return redir("$LJ::SITEROOT/register.bml?$1");
     }
 
     # approve
     if ($uri =~ m!^/approve/(\w+\.\w+)!) {
-        return redir($r, "$LJ::SITEROOT/approve.bml?$1");
+        return redir("$LJ::SITEROOT/approve.bml?$1");
     }
 
     # reject
     if ($uri =~ m!^/reject/(\w+\.\w+)!) {
-        return redir($r, "$LJ::SITEROOT/reject.bml?$1");
+        return redir("$LJ::SITEROOT/reject.bml?$1");
     }
 
     return FORBIDDEN if $uri =~ m!^/userpics!;
 
     # avoid the fakeapache library having to deal with the <Files ~ *.bml> stuff
     # in the modperl_startup.pl http_conf
-    if (ref($r) eq "Test::FakeApache::Request" && $host eq $LJ::DOMAIN_WEB) {
+    if (ref(LJ::Request->r) eq "Test::FakeApache::Request" && $host eq $LJ::DOMAIN_WEB) {
         my $file = "$LJ::HTDOCS$uri";
         $file .= "/index.bml" unless $uri =~ /\.bml$/;
         $file =~ s!/{2,}!/!;
-        $r->notes("bml_filename" => $file);
-        return Apache::BML::handler($r);
+        LJ::Request->notes("bml_filename" => $file);
+        return Apache::BML::handler();
     }
 
     return DECLINED;
@@ -968,26 +971,26 @@
 
 sub userpic_trans
 {
-    my $r = shift;
-    return 404 unless $r->uri =~ m!^/(?:userpic/)?(\d+)/(\d+)$!;
+    #my $r = shift;
+    return 404 unless LJ::Request->uri =~ m!^/(?:userpic/)?(\d+)/(\d+)$!;
     my ($picid, $userid) = ($1, $2);
 
-    $r->notes("codepath" => "img.userpic");
+    LJ::Request->notes("codepath" => "img.userpic");
 
     # redirect to the correct URL if we're not at the right one,
     # and unless CDN stuff is in effect...
     unless ($LJ::USERPIC_ROOT ne $LJ::USERPICROOT_BAK) {
-        my $host = $r->header_in("Host");
+        my $host = LJ::Request->header_in("Host");
         unless (    $LJ::USERPIC_ROOT =~ m!^http://\Q$host\E!i
                     || $LJ::USERPIC_ROOT_CDN && $LJ::USERPIC_ROOT_CDN =~ m!^http://\Q$host\E!i
         ) {
-            return redir($r, "$LJ::USERPIC_ROOT/$picid/$userid");
+            return redir("$LJ::USERPIC_ROOT/$picid/$userid");
         }
     }
 
     # we can safely do this without checking since we never re-use
     # picture IDs and don't let the contents get modified
-    return HTTP_NOT_MODIFIED if $r->header_in('If-Modified-Since');
+    return HTTP_NOT_MODIFIED if LJ::Request->header_in('If-Modified-Since');
 
     $RQ{'picid'} = $picid;
     $RQ{'pic-userid'} = $userid;
@@ -1015,18 +1018,18 @@
         # and thus know if directories were created (if not,
         # apache will give us a pathinfo)
         $RQ{'userpicfile'} = $file;
-        $r->filename($file);
+        LJ::Request->filename($file);
     }
 
-    $r->handler("perl-script");
-    $r->push_handlers(PerlHandler => \&userpic_content);
+    LJ::Request->handler("perl-script");
+    LJ::Request->push_handlers(PerlHandler => \&userpic_content);
     return OK;
 }
 
 sub userpic_content
 {
-    my $r = shift;
-    my $file = $r->filename;
+    #my $r = shift;
+    my $file = LJ::Request->filename;
 
     my $picid = $RQ{'picid'};
     my $userid = $RQ{'pic-userid'}+0;
@@ -1047,11 +1050,11 @@
     my $size;
 
     my $send_headers = sub {
-        $r->content_type($mime);
-        $r->header_out("Content-length", $size+0);
-        $r->header_out("Cache-Control", "no-transform");
-        $r->header_out("Last-Modified", LJ::time_to_http($lastmod));
-        $r->send_http_header();
+        LJ::Request->content_type($mime);
+        LJ::Request->header_out("Content-length", $size+0);
+        LJ::Request->header_out("Cache-Control", "no-transform");
+        LJ::Request->header_out("Last-Modified", LJ::time_to_http($lastmod));
+        LJ::Request->send_http_header();
     };
 
     # Load the user object and pic and make sure the picture is viewable
@@ -1075,12 +1078,12 @@
         my $key = $u->mogfs_userpic_key( $picid );
 
         if ( !$LJ::REPROXY_DISABLE{userpics} &&
-             $r->header_in('X-Proxy-Capabilities') &&
-             $r->header_in('X-Proxy-Capabilities') =~ m{\breproxy-file\b}i )
+             LJ::Request->header_in('X-Proxy-Capabilities') &&
+             LJ::Request->header_in('X-Proxy-Capabilities') =~ m{\breproxy-file\b}i )
         {
             my $memkey = [$picid, "mogp.up.$picid"];
 
-            my $zone = $r->header_in('X-MogileFS-Explicit-Zone') || undef;
+            my $zone = LJ::Request->header_in('X-MogileFS-Explicit-Zone') || undef;
             $memkey->[1] .= ".$zone" if $zone;
 
             my $cache_for = $LJ::MOGILE_PATH_CACHE_TIMEOUT || 3600;
@@ -1094,13 +1097,13 @@
 
             # reproxy url
             if ($paths->[0] =~ m/^http:/) {
-                $r->header_out('X-REPROXY-CACHE-FOR', "$cache_for; Last-Modified Content-Type");
-                $r->header_out('X-REPROXY-URL', join(' ', @$paths));
+                LJ::Request->header_out('X-REPROXY-CACHE-FOR', "$cache_for; Last-Modified Content-Type");
+                LJ::Request->header_out('X-REPROXY-URL', join(' ', @$paths));
             }
 
             # reproxy file
             else {
-                $r->header_out('X-REPROXY-FILE', $paths->[0]);
+                LJ::Request->header_out('X-REPROXY-FILE', $paths->[0]);
             }
 
             $send_headers->();
@@ -1111,7 +1114,7 @@
             return NOT_FOUND unless $data;
             $size = length $$data;
             $send_headers->();
-            $r->print( $$data ) unless $r->header_only;
+            LJ::Request->print( $$data ) unless LJ::Request->header_only;
         }
 
         return OK;
@@ -1120,8 +1123,8 @@
     # dversion < 7 reproxy file path
     if ( !$LJ::REPROXY_DISABLE{userpics} &&
          exists $LJ::PERLBAL_ROOT{userpics} &&
-         $r->header_in('X-Proxy-Capabilities') &&
-         $r->header_in('X-Proxy-Capabilities') =~ m{\breproxy-file\b}i )
+         LJ::Request->header_in('X-Proxy-Capabilities') &&
+         LJ::Request->header_in('X-Proxy-Capabilities') =~ m{\breproxy-file\b}i )
     {
    ...
 (truncated)
Tags: livejournal, pl, pm, wisest-owl
Subscribe

  • Post a new comment

    Error

    Anonymous comments are disabled in this journal

    default userpic

    Your reply will be screened

    Your IP address will be recorded 

  • 0 comments