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

[bml] r108: forgotten changes

Committer: wisest-owl
forgotten changes

U   trunk/lib/Apache/BML.pm
Modified: trunk/lib/Apache/BML.pm
===================================================================
--- trunk/lib/Apache/BML.pm	2009-04-16 01:12:57 UTC (rev 107)
+++ trunk/lib/Apache/BML.pm	2010-01-18 10:41:50 UTC (rev 108)
@@ -19,6 +19,7 @@
 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 {
@@ -68,21 +69,19 @@
 
 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");
+        LJ::Request->log_error("File does not exist: $file");
         return NOT_FOUND;
     }
 
     unless (-r _) {
-        $r->log_error("File permissions deny access: $file");
+        LJ::Request->log_error("File permissions deny access: $file");
         return FORBIDDEN;
     }
 
@@ -98,7 +97,7 @@
 
     # 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 +140,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 +156,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;
         }
     }
 
-    # mod_rewrite 
+    # mod_rewrite
     if ( exists $env->{'HOOK-rewrite_filename'} ){
         eval {
             my $new_file = $env->{'HOOK-rewrite_filename'}->(req => $req, env => $env);
@@ -201,7 +200,7 @@
 
     # 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;
     }
@@ -229,15 +228,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]}) {
@@ -275,7 +277,7 @@
         return report_error($r, "<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'};
@@ -297,7 +299,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 +311,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);
@@ -331,11 +333,11 @@
     # 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;
     }
@@ -349,7 +351,7 @@
     }
     $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;
@@ -359,7 +361,7 @@
     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,7 +373,7 @@
 
     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)
         {
@@ -379,39 +381,39 @@
             return 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;
@@ -419,20 +421,19 @@
 
 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;
@@ -468,9 +469,9 @@
     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?
 }
@@ -497,10 +498,10 @@
 
     # 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);
@@ -782,7 +783,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);
         }
@@ -1407,7 +1408,7 @@
     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 +1417,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";
@@ -1470,14 +1471,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 +1498,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;
@@ -1764,7 +1765,7 @@
     # else fall back to the global one (for use in profiling/debugging)
     my $r;
     eval {
-        $r = Apache->request;
+        $r = LJ::Request->request;
     };
     $r ||= $Apache::BML::r;
     return $r;
@@ -1772,57 +1773,48 @@
 
 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 +1829,7 @@
 sub self_link
 {
     my $newvars = shift;
-    my $link = $Apache::BML::r->uri;
+    my $link = LJ::Request->uri;
     my $form = \%BMLCodeBlock::FORM;
 
     $link .= "?";
@@ -1859,9 +1851,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 +1960,8 @@
 {
     my ($lang, $getter) = @_;  # getter is optional
     my BML::Request $req = $Apache::BML::cur_req;
-    my $r = BML::get_request();
-    $r->notes('langpref' => $lang);
+    #my $r = BML::get_request();
+    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 +2081,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;
 }
@@ -2253,7 +2246,7 @@
     # 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, 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