vadvs (vadvs) wrote in changelog,
vadvs
vadvs
changelog

[bml] r116: LJSUP-5445: add LJ::Request as proxy lay...

Committer: vad
LJSUP-5445: add LJ::Request as proxy layer between LJ.com's code and Apache v1/v2.
U   trunk/lib/Apache/BML.pm
Modified: trunk/lib/Apache/BML.pm
===================================================================
--- trunk/lib/Apache/BML.pm	2010-01-25 04:39:58 UTC (rev 115)
+++ trunk/lib/Apache/BML.pm	2010-01-25 08:27:01 UTC (rev 116)
@@ -16,9 +16,7 @@
 
 package Apache::BML;
 
-use Apache::Constants qw(:common REDIRECT HTTP_NOT_MODIFIED);
-use Apache::File ();
-use Apache::URI;
+use LJ::Request;
 use Digest::MD5;
 use File::Spec;
 BEGIN {
@@ -58,7 +56,7 @@
 # instead of just using Apache->request because when using
 # Apache::FakeRequest and non-mod_perl env, I can't seem to get/set
 # the value of Apache->request
-use vars qw($r);
+#use vars qw($r);
 
 # regexps to match open and close tokens. (but old syntax (=..=) is deprecated)
 my ($TokenOpen, $TokenClose) = ('<\?', '\?>');
@@ -68,37 +66,35 @@
 
 sub handler
 {
-    my $r = shift;
+    #my $r = $Apache::BML::r = LJ::Request->r;
 
-    $Apache::BML::r = $r;
-
     # determine what file we're supposed to work with:
-    my $file = Apache::BML::decide_file_and_stat($r);
+    my $file = Apache::BML::decide_file_and_stat();
 
-    # $file was stat'd by decide_file_and_stat above, so use '_'
+    # $file was stat'd by ecide_file_and_stat above, so use '_'
     unless (-e _) {
-        $r->log_error("File does not exist: $file");
-        return NOT_FOUND;
+        LJ::Request->log_error("File does not exist: $file");
+        return LJ::Request::NOT_FOUND;
     }
 
     unless (-r _) {
-        $r->log_error("File permissions deny access: $file");
-        return FORBIDDEN;
+        LJ::Request->log_error("File permissions deny access: $file");
+        return LJ::Request::FORBIDDEN;
     }
 
     my $modtime = (stat _)[9];
 
-    return FORBIDDEN if $file =~ /\b_config/;
+    return LJ::Request::FORBIDDEN if $file =~ /\b_config/;
 
     # create new request
-    my $req = Apache::BML::initialize_cur_req($r, $file);
+    my $req = Apache::BML::initialize_cur_req($file);
 
     # setup env
     my $env = $req->{env};
 
     # walk up directories, looking for _config.bml files, populating env
     my $dir = $file;
-    my $docroot = $r->document_root(); $docroot =~ s!/$!!;
+    my $docroot = LJ::Request->document_root(); $docroot =~ s!/$!!;
     my @dirconfs;
     my %confwant;  # file -> 1, if applicable config
 
@@ -141,7 +137,7 @@
     # wrapped in eval because Apache::FakeRequest doesn't have
     # pnotes support (as of 2004-04-26 at least)
     eval {
-        if (my $or = $r->pnotes('BMLEnvOverride')) {
+        if (my $or = LJ::Request->pnotes('BMLEnvOverride')) {
             while (my ($k, $v) = each %$or) {
                 $env->{$k} = $v;
             }
@@ -157,15 +153,15 @@
     }
 
     if (exists $env->{'HOOK-force_redirect'}) {
-        my $redirect_page = eval { $env->{'HOOK-force_redirect'}->($r->uri); };
+        my $redirect_page = eval { $env->{'HOOK-force_redirect'}->(LJ::Request->uri); };
         if (defined $redirect_page) {
-            $r->header_out(Location => $redirect_page);
+            LJ::Request->header_out(Location => $redirect_page);
             $Apache::BML::r = undef;  # no longer valid
-            return REDIRECT;
+            return LJ::Request::REDIRECT
         }
     }
 
-    # mod_rewrite 
+    # mod_rewrite
     if ( exists $env->{'HOOK-rewrite_filename'} ){
         eval {
             my $new_file = $env->{'HOOK-rewrite_filename'}->(req => $req, env => $env);
@@ -201,9 +197,9 @@
 
     # Read the source of the file
     unless (open F, $file) {
-        $r->log_error("Couldn't open $file for reading: $!");
+        LJ::Request->log_error("Couldn't open $file for reading: $!");
         $Apache::BML::r = undef;  # no longer valid
-        return SERVER_ERROR;
+        return LJ::Request::SERVER_ERROR;
     }
 
     my $bmlsource;
@@ -229,15 +225,18 @@
     # tied interface to BML::ml();
     *BMLCodeBlock::ML = *BML::ML;
 
+    my %gets  = LJ::Request->get_params;
+    my %posts = LJ::Request->post_params;
+
     # let BML code blocks see input
-    %BMLCodeBlock::GET = ();
+    %BMLCodeBlock::GET  = ();
     %BMLCodeBlock::POST = ();
     %BMLCodeBlock::FORM = ();  # whatever request method is
     my %input_target = ( GET  => [ \%BMLCodeBlock::GET  ],
                          POST => [ \%BMLCodeBlock::POST ], );
-    push @{$input_target{$r->method}}, \%BMLCodeBlock::FORM;
-    foreach my $id ([ [ $r->args    ] => $input_target{'GET'}  ],
-                    [ [ $r->content ] => $input_target{'POST'} ])
+    push @{$input_target{LJ::Request->method}}, \%BMLCodeBlock::FORM;
+    foreach my $id ([ [ %gets  ] => $input_target{'GET'}  ],
+                    [ [ %posts ] => $input_target{'POST'} ])
     {
         while (my ($k, $v) = splice @{$id->[0]}, 0, 2) {
             foreach my $dest (@{$id->[1]}) {
@@ -262,7 +261,7 @@
         eval {
             $env->{'HOOK-startup'}->();
         };
-        return report_error($r, "<b>Error running startup hook:</b><br />\n$@")
+        return report_error("<b>Error running startup hook:</b><br />\n$@")
             if $@;
     }
 
@@ -272,10 +271,10 @@
     $BML::CODE_INIT_PERL = "";
     if ($env->{'HOOK-codeblock_init_perl'}) {
         $BML::CODE_INIT_PERL = eval { $env->{'HOOK-codeblock_init_perl'}->(); };
-        return report_error($r, "<b>Error running codeblock_init_perl hook:</b><br />\n$@") if $@;
+        return report_error("<b>Error running codeblock_init_perl hook:</b><br />\n$@") if $@;
     }
 
-    my $scheme = $r->notes('bml_use_scheme') ||
+    my $scheme = LJ::Request->notes('bml_use_scheme') ||
         $env->{'ForceScheme'} ||
         $BMLCodeBlock::GET{'usescheme'} ||
         $BML::COOKIE{'BMLschemepref'};
@@ -289,7 +288,7 @@
         $default_scheme_override = eval {
             $env->{'HOOK-default_scheme_override'}->($scheme || $env->{DefaultScheme});
         };
-        return report_error($r, "<b>Error running scheme override hook:</b><br />\n$@") if $@;
+        return report_error("<b>Error running scheme override hook:</b><br />\n$@") if $@;
     }
 
     $scheme ||= $default_scheme_override || $env->{'DefaultScheme'};
@@ -297,7 +296,7 @@
     # now we've made the decision about what scheme to use
     # -- does a hook want to translate this into another scheme?
     if ($env->{'HOOK-scheme_translation'}) {
-        my $newscheme = eval { 
+        my $newscheme = eval {
             $env->{'HOOK-scheme_translation'}->($scheme);
         };
         $scheme = $newscheme if $newscheme;
@@ -309,8 +308,8 @@
         BML::set_scheme($scheme);
     }
 
-    my $uri = $r->uri;
-    my $path_info = $r->path_info;
+    my $uri = LJ::Request->uri;
+    my $path_info = LJ::Request->path_info;
     my $lang_scope = $uri;
     $lang_scope =~ s/$path_info$//;
     BML::set_language_scope($lang_scope);
@@ -322,7 +321,7 @@
 
     if ($env->{'HOOK-before_decode'}) {
         eval { $env->{'HOOK-before_decode'}->(); };
-        return report_error($r, "<b>Error running before_decode hook:</b><br />\n$@") if $@;
+        return report_error("<b>Error running before_decode hook:</b><br />\n$@") if $@;
     }
 
     bml_decode($req, \$bmlsource, \$html, { DO_CODE => $env->{'AllowCode'} })
@@ -331,13 +330,13 @@
     # force out any cookies we have set
     BML::send_cookies($req);
 
-    $r->register_cleanup(\&reset_codeblock) if $req->{'clean_package'};
+    LJ::Request->register_cleanup(\&reset_codeblock) if $req->{'clean_package'};
 
     # redirect, if set previously
     if ($req->{'location'}) {
-        $r->header_out(Location => $req->{'location'});
+        LJ::Request->set_header_out(Location => $req->{'location'});
         $Apache::BML::r = undef;  # no longer valid
-        return REDIRECT;
+        return LJ::Request::REDIRECT
     }
 
     # see if we can save some bandwidth (though we already killed a bunch of CPU)
@@ -349,17 +348,17 @@
     }
     $etag = '"' . $etag . '"' if defined $etag;
 
-    my $ifnonematch = $r->header_in("If-None-Match");
+    my $ifnonematch = LJ::Request->header_in("If-None-Match");
     if (defined $ifnonematch && defined $etag && $etag eq $ifnonematch) {
         $Apache::BML::r = undef;  # no longer valid
-        return HTTP_NOT_MODIFIED;
+        return LJ::Request::HTTP_NOT_MODIFIED;
     }
 
     my $rootlang = substr($req->{'lang'}, 0, 2);
     unless ($env->{'NoHeaders'}) {
         eval {
             # this will fail while using Apache::FakeRequest, but that's okay.
-            $r->content_languages([ $rootlang ]);
+            LJ::Request->content_languages([ $rootlang ]);
         };
     }
 
@@ -371,68 +370,66 @@
 
     unless ($env->{'NoHeaders'})
     {
-        my $ims = $r->header_in("If-Modified-Since");
+        my $ims = LJ::Request->header_in("If-Modified-Since");
         if ($ims && ! $env->{'NoCache'} &&
             $ims eq $modtime_http)
         {
             $Apache::BML::r = undef;  # no longer valid
-            return HTTP_NOT_MODIFIED;
+            return LJ::Request::HTTP_NOT_MODIFIED;
         }
 
-        $r->content_type($content_type);
+        LJ::Request->content_type($content_type);
 
         if ($env->{'NoCache'}) {
-            $r->header_out("Cache-Control", "no-cache");
-            $r->no_cache(1);
+            LJ::Request->header_out("Cache-Control", "no-cache");
+            LJ::Request->no_cache(1);
         }
 
-        $r->header_out("Last-Modified", $modtime_http)
+        LJ::Request->header_out("Last-Modified", $modtime_http)
             if $env->{'Static'} || $req->{'want_last_modified'};
 
-        $r->header_out("Cache-Control", "private, proxy-revalidate");
-        $r->header_out("ETag", $etag) if defined $etag;
+        LJ::Request->header_out("Cache-Control", "private, proxy-revalidate");
+        LJ::Request->header_out("ETag", $etag) if defined $etag;
 
         # gzip encoding
         my $do_gzip = $env->{'DoGZIP'} && $Apache::BML::HAVE_ZLIB;
         $do_gzip = 0 if $do_gzip && $content_type !~ m!^text/html!;
-        $do_gzip = 0 if $do_gzip && $r->header_in("Accept-Encoding") !~ /gzip/;
+        $do_gzip = 0 if $do_gzip && LJ::Request->header_in("Accept-Encoding") !~ /gzip/;
         my $length = length($html);
         $do_gzip = 0 if $length < 500;
         if ($do_gzip) {
             my $pre_len = $length;
-            $r->notes("bytes_pregzip" => $pre_len);
+            LJ::Request->notes("bytes_pregzip" => $pre_len);
             $html = Compress::Zlib::memGzip($html);
             $length = length($html);
-            $r->header_out('Content-Encoding', 'gzip');
-            $r->header_out('Vary', 'Accept-Encoding');
+            LJ::Request->header_out('Content-Encoding', 'gzip');
+            LJ::Request->header_out('Vary', 'Accept-Encoding');
         }
-        $r->header_out('Content-length', $length);
+        LJ::Request->header_out('Content-length', $length);
 
-        $r->send_http_header();
+        LJ::Request->send_http_header();
     }
 
-    $r->print($html) unless $env->{'NoContent'} || $r->header_only;
+    LJ::Request->print($html) unless $env->{'NoContent'} || LJ::Request->header_only;
 
     $Apache::BML::r = undef;  # no longer valid
-    return OK;
+    return LJ::Request::OK;
 }
 
 sub decide_file_and_stat
 {
-    my $r = shift;
     my $file;
-    if (ref $r eq "Apache::FakeRequest") {
+    if (ref (LJ::Request->r) eq "Apache::FakeRequest") {
         # for testing.  FakeRequest's 'notes' method is busted, always returning
         # true.
-        $file = $r->filename;
+        $file = LJ::Request->filename;
         stat($file);
-    } elsif ($file = $r->notes("bml_filename")) {
+    } elsif ($file = LJ::Request->notes("bml_filename")) {
         # when another handler needs to invoke BML directly
         stat($file);
     } else {
-        # normal case - $r->filename is already stat'd
-        $file = $r->filename;
-        $r->finfo;
+        $file = LJ::Request->filename;
+        LJ::Request->finfo;
     }
 
     return $file;
@@ -445,12 +442,11 @@
 
 sub initialize_cur_req
 {
-    my $r = shift;
     my $file = shift;
 
     my $req = $cur_req = fields::new('BML::Request');
-    $req->{file} = $file || Apache::BML::decide_file_and_stat($r);
-    $req->{r}    = $r;
+    $req->{file} = $file || Apache::BML::decide_file_and_stat();
+    $req->{r}    = LJ::Request->r; # TODO: remove
     $req->{BlockStack} = [""];
     $req->{scratch}    = {};  # _CODE blocks can play
     $req->{cookies} = {};
@@ -465,14 +461,13 @@
 
 sub report_error
 {
-    my $r = shift;
     my $err = shift;
 
-    $r->content_type("text/html");
-    $r->send_http_header();
-    $r->print($err);
+    LJ::Request->content_type("text/html");
+    LJ::Request->send_http_header();
+    LJ::Request->print($err);
 
-    return OK;  # TODO: something else?
+    return LJ::Request::OK;  # TODO: something else?
 }
 
 sub file_dontcheck
@@ -496,11 +491,10 @@
     my ($volume,$dirs,$file) = File::Spec->splitpath($ffile);
 
     # see which configs are denied
-    my $r = $Apache::BML::r;
-    if ($r->dir_config("BML_denyconfig") && ! %DenyConfig) {
-        my $docroot = $r->document_root();
-        my $deny = $r->dir_config("BML_denyconfig");
-        $deny =~ s/^\s+//; $deny =~ s/\s+$//;
+    if (LJ::Request->dir_config("BML_denyconfig") && ! %DenyConfig) {
+        my $docroot = LJ::Request->document_root();
+        my $deny = LJ::Request->dir_config("BML_denyconfig");
+        $deny =~ s/(^\s+|\s+)$//g;
         my @denydir = split(/\s*\,\s*/, $deny);
         foreach $deny (@denydir) {
             $deny = dir_rel2abs($docroot, $deny);
@@ -528,7 +522,7 @@
 
     unless ($conf) {
         unless (open (C, $ffile)) {
-            Apache->log_error("Can't read config file: $file")
+            LJ::Request->log_error("Can't read config file: $file")
                 if -e $file;
             return ();
         }
@@ -731,7 +725,7 @@
 
         my $cv = \&{"${md5_package}::${md5_handler}"};
         $req->{clean_package} = $md5_package;
-        my $ret = eval { $cv->($req, $req->{'scratch'}, $elhash || {}) };
+        my $ret = eval { $cv->($req->{'scratch'}, $elhash || {}) };
         return handle_code_error($env, $@) if $@;
 
         # don't call bml_decode if BML::noparse() told us not to, there's
@@ -782,7 +776,7 @@
                 if $req->{'lang'} eq 'debug';
             my $getter = $req->{'env'}->{'HOOK-ml_getter'};
             return "[ml_getter not defined]" unless $getter;
-            $code = $req->{'r'}->uri . $code
+            $code = LJ::Request->uri . $code
                 if rindex($code, '.', 0) == 0;
             return $getter->($req->{'lang'}, $code);
         }
@@ -1404,10 +1398,9 @@
 sub parse_multipart
 {
     my ($dest, $error, $max_size) = @_;
-    my $r = $Apache::BML::r;
     my $err = sub { $$error = $_[0]; return 0; };
 
-    my $size = $r->header_in("Content-length");
+    my $size = LJ::Request->header_in("Content-length");
     unless ($size) {
         return $err->("No content-length header: can't parse");
     }
@@ -1416,13 +1409,13 @@
     }
 
     my $sep;
-    unless ($r->header_in("Content-Type") =~ m!^multipart/form-data;\s*boundary=(\S+)!) {
+    unless (LJ::Request->header_in("Content-Type") =~ m!^multipart/form-data;\s*boundary=(\S+)!) {
         return $err->("[unknowntype] Unknown content type");
     }
     $sep = $1;
 
     my $content;
-    $r->read($content, $size);
+    LJ::Request->read($content, $size);
     my @lines = split(/\r\n/, $content);
     my $line = shift @lines;
     return $err->("[parse] Error parsing upload") unless $line eq "--$sep";
@@ -1452,7 +1445,7 @@
 
 # FIXME: document the hooks
 sub parse_multipart_interactive {
-    my ($r, $errref, $hooks) = @_;
+    my ($errref, $hooks) = @_;
 
     # subref to set $@ and $$errref, then return false
     my $err = sub { $$errref = $@ = $_[0], return 0 };
@@ -1470,14 +1463,14 @@
     };
 
     # size hook is optional
-    my $size = $r->header_in("Content-length");
+    my $size = LJ::Request->header_in("Content-length");
     if ($hooks->{size}) {
         $run_hook->('size', $size)
             or return 0;
     }
 
-    unless ($r->header_in("Content-Type") =~ m!^multipart/form-data;\s*boundary=(\S+)!) {
-        return $err->("No MIME boundary.  Bogus Content-type? " . $r->header_in("Content-Type"));
+    unless (LJ::Request->header_in("Content-Type") =~ m!^multipart/form-data;\s*boundary=(\S+)!) {
+        return $err->("No MIME boundary.  Bogus Content-type? " . LJ::Request->header_in("Content-Type"));
     }
     my $sep = "--$1";
     my $seplen = length($sep) + 2;  # plus \r\n
@@ -1497,7 +1490,7 @@
     while (1) {
         my $read = -1;
         if ($to_read) {
-            $read = $r->read($window,
+            $read = LJ::Request->read($window,
                              $to_read < $max_read ? $to_read : $max_read,
                              length($window));
             $to_read -= $read;
@@ -1762,67 +1755,62 @@
     # callers sometimes use %BML::COOKIE, so $Apache::BML::r isn't set.
     # the cookie FETCH below calls this function to try and use Apache->request,
     # else fall back to the global one (for use in profiling/debugging)
-    my $r;
-    eval {
-        $r = Apache->request;
-    };
-    $r ||= $Apache::BML::r;
-    return $r;
+    
+    #my $r;
+    #eval {
+    #    $r = LJ::Request->r;
+    #};
+    #$r ||= $Apache::BML::r;
+    #return $r;
+    #
+
+    return eval { LJ::Request->r };
 }
 
 sub get_query_string
 {
-    my $r = BML::get_request();
-    return scalar($r->args);
+    return scalar(LJ::Request->args);
 }
 
 sub get_uri
 {
-    my $r = BML::get_request();
-    return $r->uri;
+    return LJ::Request->uri;
 }
 
 sub get_hostname
 {
-    my $r = BML::get_request();
-    return $r->hostname;
+    return LJ::Request->hostname;
 }
 
 sub get_method
 {
-    my $r = BML::get_request();
-    return $r->method;
+    return LJ::Request->method;
 }
 
 sub get_path_info
 {
-    my $r = BML::get_request();
-    return $r->path_info;
+    return LJ::Request->path_info;
 }
 
 sub get_remote_ip
 {
-    my $r = BML::get_request();
-    return $r->connection()->remote_ip;
+    return LJ::Request->remote_ip;
 }
 
 sub get_remote_host
 {
-    my $r = BML::get_request();
-    return $r->connection()->remote_host;
+    return LJ::Request->remote_host;
 }
 
 sub get_remote_user
 {
-    my $r = BML::get_request();
-    return $r->connection()->user;
+    return LJ::Request->user;
 }
 
 sub get_client_header
 {
     my $hdr = shift;
-    my $r = BML::get_request();
-    return $r->header_in($hdr);
+    return LJ::Request->header_in($hdr);
 }
 
 # <LJFUNC>
@@ -1837,7 +1825,7 @@
 sub self_link
 {
     my $newvars = shift;
-    my $link = $Apache::BML::r->uri;
+    my $link = LJ::Request->uri;
     my $form = \%BMLCodeBlock::FORM;
 
     $link .= "?";
@@ -1858,10 +1846,9 @@
 {
     my ($code, $msg) = @_;
 
-    my $r = $Apache::BML::r;
-    $r->status($code);
-    $r->content_type('text/html');
-    $r->print($msg);
+    LJ::Request->status($code);
+    LJ::Request->content_type('text/html');
+    LJ::Request->print($msg);
     finish_suppress_all();
     return;
 }
@@ -1968,8 +1955,7 @@
 {
     my ($lang, $getter) = @_;  # getter is optional
     my BML::Request $req = $Apache::BML::cur_req;
-    my $r = BML::get_request();
-    $r->notes('langpref' => $lang);
+    LJ::Request->notes('langpref' => $lang);
 
     # don't rely on $req (the current BML request) being defined, as
     # we allow callers to use this interface directly from non-BML
@@ -2089,8 +2075,9 @@
     }
 
     foreach (values %{$req->{'cookies'}}) {
-        $req->{'r'}->err_headers_out->add("Set-Cookie" => $_);
+        LJ::Request->add_header_out("Set-Cookie" => $_);
     }
+
     $req->{'cookies'} = {};
     $req->{'env'}->{'SentCookies'} = 1;
 }
@@ -2251,9 +2238,8 @@
     my ($t, $key) = @_;
     # we do this, and not use $Apache::BML::r directly because some non-BML
     # callers sometimes use %BML::COOKIE.
-    my $r = BML::get_request();
     unless ($BML::COOKIES_PARSED) {
-        foreach (split(/;\s+/, $r->header_in("Cookie"))) {
+        foreach (split(/;\s+/, LJ::Request->header_in("Cookie"))) {
             next unless ($_ =~ /(.*)=(.*)/);
             my ($name, $value) = ($1, $2);
             my $dname  = BML::durl($name);

Tags: bml, pm, vadvs
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