cgi-bin/lj-bml-init.pl

   1 package LJ;
   2 use strict;
   3
   4 use lib "$ENV{LJHOME}/cgi-bin";
   5 use POSIX qw(ENOENT);
   6 use LJ::Config;
   7 LJ::Config->load;
   8 use LJ::Request;
   9
  10 foreach (@LJ::LANGS, @LJ::LANGS_IN_PROGRESS) {
  11     BML::register_isocode(substr($_, 0, 2), $_);
  12     BML::register_language($_);
  13 }
  14
  15 # set default path/domain for cookies
  16 BML::set_config("CookieDomain" => $LJ::COOKIE_DOMAIN);
  17 BML::set_config("CookiePath"   => $LJ::COOKIE_PATH);
  18
  19 BML::register_hook("startup", sub {
  20     my $uri = "bml" . LJ::Request->uri;
  21     unless ($uri =~ s/\.bml$//) {
  22         $uri .= ".index";
  23     }
  24     $uri =~ s!/!.!g;
  25     LJ::Request->notes("codepath" => $uri);
  26 });
  27
  28 BML::register_hook("codeerror", sub {
  29     my $msg = shift;
  30
  31     my $err = LJ::errobj($msg)       or return;
  32     $err->log;
  33     $msg = $err->as_html;
  34
  35     chomp $msg;
  36     $msg .= " \@ $LJ::SERVER_NAME" if $LJ::SERVER_NAME;
  37     warn "$msg\n";
  38
  39     my $remote = LJ::get_remote();
  40     if (($remote && $remote->show_raw_errors) || $LJ::IS_DEV_SERVER) {
  41         return "<pre>" . LJ::ehtml("[Error: $msg]") . "</pre>";
  42     } else {
  43         return $LJ::MSG_ERROR || "Sorry, there was a problem.";
  44     }
  45 });
  46
  47 if ($LJ::UNICODE) {
  48     BML::set_config("DefaultContentType", "text/html; charset=utf-8");
  49 }
  50
  51 # register BML multi-language hook
  52 BML::register_hook("ml_getter", \&LJ::Lang::get_text);
  53
  54 # include file handling
  55 BML::register_hook('include_getter', sub {
  56     # simply call LJ::load_include, as it does all the work of hitting up
  57     # memcache/db for us and falling back to disk if necessary...
  58     my ($file, $source) = @_;
  59     $$source = LJ::load_include($file);
  60     return 1;
  61 });
  62
  63 # Allow scheme override to be defined as a code ref or an explicit string value
  64 BML::register_hook('default_scheme_override', sub {
  65     my $current_scheme = shift;
  66
  67     my $override = $LJ::BML_SCHEME_OVERRIDE{$current_scheme};
  68     return LJ::conf_test($override) if defined $override;
  69
  70     return LJ::conf_test($LJ::SCHEME_OVERRIDE);
  71 });
  72
  73 # extra perl to insert at the beginning of a code block
  74 # compilation
  75 BML::register_hook("codeblock_init_perl", sub {
  76     return q{
  77         *errors = *BMLCodeBlock::errors;
  78         *warnings = *BMLCodeBlock::warnings;
  79     };
  80 });
  81
  82 # now apply any local behaviors which may be defined
  83 eval { require "lj-bml-init-local.pl" };
  84 die $@ if $@ && $! != ENOENT;
  85
  86 1;