root/branches/release-35/lib/MT.pm.pre @ 1954

Revision 1954, 105.8 kB (checked in by bchoate, 20 months ago)

Adding blog_id to mail template stash since some handlers expect it.
  • Property svn:keywords set to Author Date Id Revision
Line 
1# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
2# This program is distributed under the terms of the
3# GNU General Public License, version 2.
4#
5# $Id$
6
7package MT;
8
9use strict;
10use base qw( MT::ErrorHandler );
11use File::Spec;
12use File::Basename;
13use MT::Util qw( weaken );
14use MT::I18N qw( encode_text );
15
16our ( $VERSION,      $SCHEMA_VERSION );
17our ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID );
18our ( $MT_DIR,       $APP_DIR, $CFG_DIR, $CFG_FILE, $SCRIPT_SUFFIX );
19our (
20    $plugin_sig, $plugin_envelope, $plugin_registry,
21    %Plugins,    @Components,      %Components,
22    $DebugMode,  $mt_inst,         %mt_inst
23);
24my %Text_filters;
25
26# For state determination in MT::Object
27our $plugins_installed;
28
29BEGIN {
30    $plugins_installed = 0;
31
32    ( $VERSION, $SCHEMA_VERSION ) = ( '__API_VERSION__', '__SCHEMA_VERSION__' );
33    ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID ) = (
34        '__PRODUCT_NAME__',    '__PRODUCT_CODE__',
35        '__PRODUCT_VERSION__', '__PRODUCT_VERSION_ID__'
36    );
37
38    $DebugMode = 0;
39
40    # Alias lowercase to uppercase package; note: this is an equivalence
41    # as opposed to having @mt::ISA set to 'MT'. so @mt::Plugins would
42    # resolve as well as @MT::Plugins.
43    *{mt::} = *{MT::};
44
45    # Alias these; Components is the preferred array for MT 4
46    *Plugins = \@Components;
47}
48
49# On-demand loading of compatibility module, if a plugin asks for it, using
50#     use MT 3;
51# or even specific to minor version (but this just loads MT::Compat::v3)
52#     use MT 3.3;
53sub VERSION {
54    my $v = $_[1];
55    if ( defined $v && ( $v =~ m/^(\d+)/ ) ) {
56        my $compat = "MT::Compat::v" . $1;
57        if ( ( $1 > 2 ) && ( $1 < int($VERSION) ) ) {
58            no strict 'refs';
59            unless ( defined *{ $compat . '::' } ) {
60                eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $compat;";
61            }
62        }
63    }
64    return UNIVERSAL::VERSION(@_);
65}
66
67sub version_number  { $VERSION }
68sub version_id      { $VERSION_ID }
69sub product_code    { $PRODUCT_CODE }
70sub product_name    { $PRODUCT_NAME }
71sub product_version { $PRODUCT_VERSION }
72sub schema_version  { $SCHEMA_VERSION }
73
74# Default id method turns MT::App::CMS => cms; Foo::Bar => foo/bar
75sub id {
76    my $pkg = shift;
77    my $id = ref($pkg) || $pkg;
78    # ignore the MT::App prefix as part of the identifier
79    $id =~ s/^MT::App:://;
80    $id =~ s!::!/!g;
81    return lc $id;
82}
83
84sub version_slug {
85    return MT->translate_templatized(<<"SLUG");
86<MT_TRANS phrase="Powered by [_1]" params="$PRODUCT_NAME">
87<MT_TRANS phrase="Version [_1]" params="$VERSION_ID">
88<MT_TRANS phrase="http://www.sixapart.com/movabletype/">
89SLUG
90}
91
92sub import {
93    my $pkg = shift;
94    return unless @_;
95
96    my (%param) = @_;
97    my $app_pkg;
98    if ( $app_pkg = $param{app} || $param{App} || $ENV{MT_APP} ) {
99        if ( $app_pkg !~ m/::/ ) {
100            my $apps = $pkg->registry('applications');
101            $app_pkg = $apps->fetch($app_pkg);
102            if ( ref $app_pkg ) {
103
104                # pick first one??
105                $app_pkg = $app_pkg->[0];
106
107                # pick last one??
108                # $app_pkg = pop @$app_pkg;
109            }
110        }
111    }
112    elsif ( $param{run} || $param{Run} ) {
113
114        # my $script = File::Spec->rel2abs($0);
115        my ( $filename, $path, $suffix ) = fileparse( $0, qr{\..+$} );
116        $SCRIPT_SUFFIX = $suffix;
117        my $script = lc $filename;
118        $script =~ s/^mt-//;
119        my $apps = $pkg->registry('applications');
120        $app_pkg = $apps->fetch( lc $script );
121        unless ($app_pkg) {
122            die "cannot determine application for script $0, stopped at";
123        }
124    }
125    $pkg->run_app( $app_pkg, \%param )
126      if $app_pkg;
127}
128
129sub run_app {
130    my $pkg = shift;
131    my ( $class, $param ) = @_;
132
133    # When running under FastCGI, the initial invocation of the
134    # script has a bare environment. We can use this to test
135    # for FastCGI.
136    my $not_fast_cgi = 0;
137    $not_fast_cgi ||= exists $ENV{$_}
138      for qw(HTTP_HOST GATEWAY_INTERFACE SCRIPT_FILENAME SCRIPT_URL);
139    my $fast_cgi = ( !$not_fast_cgi ) || $param->{fastcgi};
140    $fast_cgi =
141      defined( $param->{fastcgi} || $param->{FastCGI} )
142      ? ( $param->{fastcgi} || $param->{FastCGI} )
143      : $fast_cgi;
144    if ($fast_cgi) {
145        eval { require CGI::Fast; };
146        $fast_cgi = 0 if $@;
147    }
148
149    # ready to run now... run inside an eval block so we can gracefully
150    # die if something bad happens
151    my $app;
152    eval {
153        eval "require $class; 1;" or die $@;
154        if ($fast_cgi) {
155            while ( my $cgi = new CGI::Fast ) {
156                $app = $class->new( %$param, CGIObject => $cgi )
157                  or die $class->errstr;
158                local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
159                $pkg->set_instance($app);
160                $app->init_request( CGIObject => $cgi );
161                $app->run;
162            }
163        }
164        else {
165            $app = $class->new(%$param) or die $class->errstr;
166            local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
167            $app->run;
168        }
169    };
170    if ( my $err = $@ ) {
171        my $charset = 'utf-8';
172        eval {
173            $app ||= MT->instance;
174            my $cfg = $app->config;
175            my $c   = $app->find_config;
176            $cfg->read_config($c);
177            $charset = $cfg->PublishCharset;
178        };
179        if ( $app && UNIVERSAL::isa( $app, 'MT::App' ) ) {
180            eval {
181                my %param = ( error => $err );
182                if ( $err =~ m/Bad ObjectDriver/ ) {
183                    $param{error_database_connection} = 1;
184                }
185                elsif ( $err =~ m/Bad CGIPath/ ) {
186                    $param{error_cgi_path} = 1;
187                }
188                elsif ( $err =~ m/Missing configuration file/ ) {
189                    $param{error_config_file} = 1;
190                }
191                my $page = $app->build_page( 'error.tmpl', \%param )
192                  or die $app->errstr;
193                print "Content-Type: text/html; charset=$charset\n\n";
194                print $page;
195            };
196            if ( my $err = $@ ) {
197                print "Content-Type: text/plain; charset=$charset\n\n";
198                print $app
199                  ? $app->translate( "Got an error: [_1]", $err )
200                  : "Got an error: $err";
201            }
202        }
203        else {
204            if ( $err =~ m/Missing configuration file/ ) {
205                my $host = $ENV{SERVER_NAME} || $ENV{HTTP_HOST};
206                $host =~ s/:\d+//;
207                my $port = $ENV{SERVER_PORT};
208                my $uri = $ENV{REQUEST_URI} || $ENV{PATH_INFO};
209                $uri =~ s/mt(\Q$SCRIPT_SUFFIX\E)?.*$//;
210                my $cgipath = '';
211                $cgipath = $port == 443 ? 'https' : 'http';
212                $cgipath .= '://' . $host;
213                $cgipath .= ( $port == 443 || $port == 80 ) ? '' : ':' . $port;
214                $cgipath .= $uri;
215
216                print "Status: 302 Moved\n";
217                print "Location: " . $cgipath . "mt-wizard.cgi\n\n";
218            }
219            else {
220                print "Content-Type: text/plain; charset=$charset\n\n";
221                print $app
222                  ? $app->translate( "Got an error: [_1]", $err )
223                  : "Got an error: $err\n";
224            }
225        }
226    }
227}
228
229sub app {
230    my $class = shift;
231    $mt_inst ||= $mt_inst{$class} ||= $class->construct(@_);
232}
233*instance = *app;
234
235sub set_instance {
236    my $class = shift;
237    $mt_inst = shift;
238}
239
240sub new {
241    my $mt = &instance_of;
242    $mt_inst ||= $mt;
243    $mt;
244}
245
246sub instance_of {
247    my $class = shift;
248    $mt_inst{$class} ||= $class->construct(@_);
249}
250
251sub construct {
252    my $class = shift;
253    my $mt = bless {}, $class;
254    local $mt_inst = $mt;
255    $mt->init(@_)
256      or die $mt->errstr;
257    $mt;
258}
259
260{
261    my %object_types;
262
263    sub model {
264        my $pkg = shift;
265        my ($k) = @_;
266        $object_types{$k} = $_[1] if scalar @_ > 1;
267        return $object_types{$k} if exists $object_types{$k};
268
269        if ($k =~ m/^(.+):meta$/) {
270            my $ppkg = $pkg->model($1);
271            my $mpkg = $ppkg->meta_pkg;
272            return $mpkg ? $object_types{$k} = $mpkg : undef;
273        }
274
275        my $model = $pkg->registry( 'object_types', $k );
276        if ( ref($model) eq 'ARRAY' ) {
277
278            # First element of an array *should* be a scalar; in case it isn't,
279            # return undef.
280            $model = $model->[0];
281            return undef if ref $model;
282        }
283        elsif ( ref($model) eq 'HASH' ) {
284
285            # If all we have is a hash, this doesn't tell us the package for
286            # this object type, so it's undefined.
287            return undef;
288        }
289        return undef unless $model;
290
291        # Element in object type hash is scalar, so return it
292        no strict 'refs';
293        unless ( defined *{ $model . '::__properties' } ) {
294            use strict 'refs';
295            eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $model;";
296            if ( $@ && ( $k =~ m/^(.+)\./ ) ) {
297
298                # x.foo can't be found, so try loading x
299                if ( my $ppkg = $pkg->model($1) ) {
300
301                    # well now see if $model is defined
302                    no strict 'refs';
303                    unless ( defined *{ $model . '::__properties' } ) {
304
305                        # if not, use parent package instead
306                        $model = $ppkg;
307                    }
308                }
309            }
310        }
311        return $object_types{$k} = $model;
312    }
313
314    sub models {
315        my $pkg = shift;
316        my ($k) = @_;
317
318        my @matches;
319        my $model = $pkg->registry('object_types');
320        foreach my $m ( keys %$model ) {
321            if ( $m =~ m/^\Q$k\E\.?/ ) {
322                push @matches, $m;
323            }
324        }
325        return @matches;
326    }
327}
328
329sub registry {
330    my $pkg = shift;
331
332    # if (!ref $pkg) {
333    #     return $pkg->instance->registry(@_);
334    # }
335    require MT::Component;
336    my $regs = MT::Component->registry(@_);
337    my $r;
338    if ($regs) {
339        foreach my $cr (@$regs) {
340
341            # in the event that our registry request returns something
342            # other than an array of hashes, return it as is instead of
343            # merging it together.
344            return $regs unless ref($cr) eq 'HASH';
345
346            # next unless ref($cr) eq 'HASH';
347            delete $cr->{plugin} if exists $cr->{plugin};
348            __merge_hash( $r ||= {}, $cr );
349        }
350    }
351    return $r;
352}
353
354# merges contents of two hashes, giving preference to the right side
355# if $replace is true; otherwise it will always append to the left side.
356sub __merge_hash {
357    my ( $h1, $h2, $replace ) = @_;
358    for my $k ( keys(%$h2) ) {
359        if ( exists( $h1->{$k} ) && ( !$replace ) ) {
360            if ( ref $h1->{$k} eq 'HASH' ) {
361                __merge_hash( $h1->{$k}, $h2->{$k}, ( $replace || 0 ) + 1 );
362            }
363            elsif ( ref $h1->{$k} eq 'ARRAY' ) {
364                if ( ref $h2->{$k} eq 'ARRAY' ) {
365                    push @{ $h1->{$k} }, @{ $h2->{$k} };
366                }
367                else {
368                    push @{ $h1->{$k} }, $h2->{$k};
369                }
370            }
371            else {
372                $h1->{$k} = [ $h1->{$k}, $h2->{$k} ];
373            }
374        }
375        else {
376            $h1->{$k} = $h2->{$k};
377        }
378    }
379}
380
381# The above functions can all be used to make MT objects (and subobjects).
382# The difference between them is characterized by these assertions:
383#
384#  $mt = MT::App::Search->new();
385#  assert($mt->isa('MT::App::Search'))
386#
387#  $mt1 = MT->instance
388#  $mt2 = MT->instance
389#  assert($mt1 == $mt2);
390#
391#  $mt1 = MT::App::CMS->construct()
392#  $mt2 = MT::App::CMS->construct()
393#  assert($mt1 != $mt2);
394#
395# TBD: make a test script for these.
396
397sub unplug {
398}
399
400sub config {
401    my $mt = shift;
402    ref $mt or $mt = MT->instance;
403    unless ( $mt->{cfg} ) {
404        require MT::ConfigMgr;
405        weaken( $mt->{cfg} = MT::ConfigMgr->instance );
406    }
407    if (@_) {
408        my $setting = shift;
409        @_ ? $mt->{cfg}->set( $setting, @_ ) : $mt->{cfg}->get($setting);
410    }
411    else {
412        $mt->{cfg};
413    }
414}
415
416sub request {
417    my $pkg  = shift;
418    my $inst = ref($pkg) ? $pkg : $pkg->instance;
419    unless ( $inst->{request} ) {
420        require MT::Request;
421        $inst->{request} = MT::Request->instance;
422    }
423    if (@_) {
424        $inst->{request}->stash(@_);
425    }
426    else {
427        $inst->{request};
428    }
429}
430
431sub log {
432    my $mt = shift;
433    unless ($plugins_installed) {
434        # finish init_schema here since we have to log something
435        # to the database.
436        $mt->init_schema();
437    }
438    my $msg;
439    if ( !@_ ) {    # single parameter to log, so $mt must be message
440        $msg = $mt;
441        $mt  = MT->instance;
442    }
443    else {          # multiple parameters to log; second one is message
444        $msg = shift;
445    }
446    my $log_class = $mt->model('log');
447    my $log = $log_class->new();
448    if ( ref $msg eq 'HASH' ) {
449        $log->set_values($msg);
450    }
451    elsif ( ( ref $msg ) && ( UNIVERSAL::isa( $msg, 'MT::Log' ) ) ) {
452        $log = $msg;
453    }
454    else {
455        $log->message($msg);
456    }
457    $log->level( MT::Log::INFO() )
458      unless defined $log->level;
459    $log->class('system')
460      unless defined $log->class;
461    $log->save();
462    print STDERR MT->translate( "Message: [_1]", $log->message ) . "\n"
463      if $MT::DebugMode;
464}
465my $plugin_full_path;
466
467sub run_tasks {
468    my $mt = shift;
469    require MT::TaskMgr;
470    MT::TaskMgr->run_tasks(@_);
471}
472
473sub add_plugin {
474    my $class = shift;
475    my ($plugin) = @_;
476    if ( ref $plugin eq 'HASH' ) {
477        require MT::Plugin;
478        $plugin = new MT::Plugin($plugin);
479    }
480    $plugin->{name} ||= $plugin_sig;
481    $plugin->{plugin_sig} = $plugin_sig;
482
483    my $id = $plugin->id;
484    unless ($plugin_envelope) {
485        warn "MT->add_plugin improperly called outside of MT plugin load loop.";
486        return;
487    }
488    $plugin->envelope($plugin_envelope);
489    Carp::confess("You cannot register multiple plugin objects from a single script. $plugin_sig")
490      if exists( $Plugins{$plugin_sig} )
491      && ( exists $Plugins{$plugin_sig}{object} );
492
493    $Components{ lc $id } = $plugin if $id;
494    $Plugins{$plugin_sig}{object} = $plugin;
495    $plugin->{full_path}  = $plugin_full_path;
496    $plugin->path($plugin_full_path);
497    unless ( $plugin->{registry} && ( %{ $plugin->{registry} } ) ) {
498        $plugin->{registry} = $plugin_registry;
499    }
500    if ( $plugin->{registry} ) {
501        if ( my $settings = $plugin->{registry}{config_settings} ) {
502            $settings = $plugin->{registry}{config_settings} = $settings->()
503              if ref($settings) eq 'CODE';
504            $class->config->define($settings);
505        }
506    }
507    push @Components, $plugin;
508    1;
509}
510
511our %CallbackAlias;
512our $CallbacksEnabled = 1;
513my %CallbacksEnabled;
514my @Callbacks;
515
516sub add_callback {
517    my $class = shift;
518    my ( $meth, $priority, $plugin, $code ) = @_;
519    if ( $meth =~ m/^(.+::)?([^\.]+)(\..+)?$/ ) {
520
521        # Remap (whatever)::(name).(something)
522        if ( exists $CallbackAlias{$2} ) {
523            $meth = $CallbackAlias{$2};
524            $meth = $1 . $meth if $1;
525            $meth = $meth . $3 if $3;
526        }
527    }
528    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
529    my $internal = 0;
530    if ( ref $plugin ) {
531        if ( ( defined $mt_inst ) && ( $plugin == $mt_inst ) ) {
532            $plugin   = undef;
533            $internal = 1;
534        }
535        elsif ( !UNIVERSAL::isa( $plugin, "MT::Component" ) ) {
536            return $class->trans_error(
537"If present, 3rd argument to add_callback must be an object of type MT::Component or MT::Plugin"
538            );
539        }
540    }
541    if ( ( ref $code ) ne 'CODE' ) {
542        if ( ref $code ) {
543            return $class->trans_error(
544                '4th argument to add_callback must be a CODE reference.');
545        }
546        else {
547            # Defer until callback is used
548            # if ($plugin) {
549            #     $code = MT->handler_to_coderef($code);
550            # }
551        }
552    }
553
554    # 0 and 11 are exclusive.
555    if ( $priority == 0 || $priority == 11 ) {
556        if ( $Callbacks[$priority]->{$meth} ) {
557            return $class->trans_error("Two plugins are in conflict");
558        }
559    }
560    return $class->trans_error( "Invalid priority level [_1] at add_callback",
561        $priority )
562      if ( ( $priority < 0 ) || ( $priority > 11 ) );
563    require MT::Callback;
564    $CallbacksEnabled{$meth} = 1;
565    ## push @{$Plugins{$plugin_sig}{callbacks}}, "$meth Callback" if $plugin_sig;
566    my $cb = new MT::Callback(
567        plugin   => $plugin,
568        code     => $code,
569        priority => $priority,
570        internal => $internal,
571        method   => $meth
572    );
573    push @{ $Callbacks[$priority]->{$meth} }, $cb;
574    $cb;
575}
576
577sub remove_callback {
578    my $class    = shift;
579    my ($cb)     = @_;
580    my $priority = $cb->{priority};
581    my $method   = $cb->{method};
582    my $list     = $Callbacks[$priority];
583    return unless $list;
584    my $cbarr = $list->{$method};
585    return unless $cbarr;
586    @$cbarr = grep { $_ != $cb } @$cbarr;
587}
588
589# For use by MT internal code
590sub _register_core_callbacks {
591    my $class = shift;
592    my ($callback_table) = @_;
593    foreach my $name ( keys %$callback_table ) {
594        $class->add_callback( $name, 5, $mt_inst, $callback_table->{$name} )
595          || return;
596    }
597    1;
598}
599
600sub register_callbacks {
601    my $class = shift;
602    my ($callback_list) = @_;
603    foreach my $cb (@$callback_list) {
604        $class->add_callback( $cb->{name}, $cb->{priority}, $cb->{plugin},
605            $cb->{code} )
606          || return;
607    }
608    1;
609}
610
611our $CB_ERR;
612sub callback_error { $CB_ERR = $_[0]; }
613sub callback_errstr { $CB_ERR }
614
615sub run_callback {
616    my $class = shift;
617    my ( $cb, @args ) = @_;
618
619    $cb->error();    # reset the error string
620    my $result = eval {
621        # line __LINE__ __FILE__
622        $cb->invoke(@args);
623    };
624    if ( my $err = $@ ) {
625        $cb->error($err);
626        my $plugin = $cb->{plugin};
627        my $name;
628        if ( $cb->{internal} ) {
629            $name = "Internal callback";
630        }
631        elsif ( UNIVERSAL::isa( $plugin, 'MT::Plugin' ) ) {
632            $name = $plugin->name() || MT->translate("Unnamed plugin");
633        }
634        else {
635            $name = MT->translate("Unnamed plugin");
636        }
637        require MT::Log;
638        MT->log(
639            {
640                message => MT->translate( "[_1] died with: [_2]", $name, $err ),
641                class   => 'system',
642                category => 'callback',
643                level    => MT::Log::ERROR(),
644            }
645        );
646        return 0;
647    }
648    if ( $cb->errstr() ) {
649        return 0;
650    }
651    return $result;
652}
653
654# A callback should return a true/false value. The result of
655# run_callbacks is the logical AND of all the callback's return
656# values. Some hookpoints will ignore the return value: e.g. object
657# callbacks don't use it. By convention, those that use it have Filter
658# at the end of their names (CommentPostFilter, CommentThrottleFilter,
659# etc.)
660# Note: this composition is not short-circuiting. All callbacks are
661# executed even if one has already returned false.
662# ALSO NOTE: failure (dying or setting $cb->errstr) does not force a
663# "false" return.
664# THINK: are there cases where a true value should override all false values?
665# that is, where logical OR is the right way to compose multiple callbacks?
666sub run_callbacks {
667    my $class = shift;
668    my ( $meth, @args ) = @_;
669    return 1 unless $CallbacksEnabled && %CallbacksEnabled;
670    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
671    my @methods;
672
673    # execution:
674    #   Full::Name.<variant>
675    #   *::Name.<variant> OR Name.<variant>
676    #   Full::Name
677    #   *::Name OR Name
678    push @methods, $meth if $CallbacksEnabled{$meth};    # bleh::blah variant
679    if ( $meth =~ /::/ ) {    # presence of :: implies it's an obj. cb
680        my $name = $meth;
681        $name =~ s/^.*::([^:]*)$/$1/;
682        $name = $CallbackAlias{ '*::' . $name }
683          if exists $CallbackAlias{ '*::' . $name };
684        push @methods, '*::' . $name
685          if $CallbacksEnabled{ '*::' . $name };    # *::blah variant
686        push @methods, $name if $CallbacksEnabled{$name};    # blah variant
687    }
688    if ( $meth =~ /\./ ) {    # presence of ' ' implies it is a variant callback
689        my ($name) = split /\./, $meth, 2;
690        $name = $CallbackAlias{$name} if exists $CallbackAlias{$name};
691        push @methods, $name if $CallbacksEnabled{$name};    # bleh::blah
692        if ( $name =~ m/::/ ) {
693            my $name2 = $name;
694            $name2 =~ s/^.*::([^:]*)$/$1/;
695            $name2 = $CallbackAlias{ '*::' . $name2 }
696              if exists $CallbackAlias{ '*::' . $name2 };
697            push @methods, '*::' . $name2
698              if $CallbacksEnabled{ '*::' . $name2 };        # *::blah
699            push @methods, $name2 if $CallbacksEnabled{$name2};    # blah
700        }
701    }
702    return 1 unless @methods;
703
704    $CallbacksEnabled{$_} = 0 for @methods;
705    my @errors;
706    my $filter_value = 1;
707    my $first_error;
708
709    foreach my $callback_sheaf (@Callbacks) {
710        for my $meth (@methods) {
711            if ( my $set = $callback_sheaf->{$meth} ) {
712                for my $cb (@$set) {
713                    my $result = $class->run_callback( $cb, @args );
714                    $filter_value &&= $result;
715                    if ( !$result ) {
716                        if ( $cb->errstr() ) {
717                            push @errors, $cb->errstr();
718                        }
719                        if ( !defined($first_error) ) {
720                            $first_error = $cb->errstr();
721                        }
722                    }
723                }
724            }
725        }
726    }
727
728    callback_error( join( '', @errors ) );
729
730    $CallbacksEnabled{$_} = 1 for @methods;
731    if ( !$filter_value ) {
732        return $class->error($first_error);
733    }
734    else {
735        return $filter_value;
736    }
737}
738
739sub user_class {
740    shift->{user_class};
741}
742
743sub find_config {
744    my $mt = shift;
745    my ($param) = @_;
746
747    $param->{Config}    ||= $ENV{MT_CONFIG};
748    $param->{Directory} ||= $ENV{MT_HOME};
749    if ( !$param->{Directory} ) {
750        if ( $param->{Config} ) {
751            $param->{Directory} = dirname( $param->{Config} );
752        }
753        else {
754            $param->{Directory} = dirname($0) || $ENV{PWD} || '.';
755        }
756    }
757
758    # the directory is the more important parameter between it and
759    # the config parameter. if config is unreadable, then scan for
760    # a config file using the directory as a base.  we support
761    # either mt.cfg or mt-config.cgi for the config file name. the
762    # latter being a more secure choice since it is unreadable from
763    # a browser.
764    for my $cfg_file ( $param->{Config},
765        File::Spec->catfile( $param->{Directory}, 'mt-config.cgi' ),
766        'mt-config.cgi' )
767    {
768        return $cfg_file if $cfg_file && -r $cfg_file && -f $cfg_file;
769    }
770    return undef;
771}
772
773sub init_schema {
774    require MT::Object;
775    MT::Object->install_pre_init_properties();
776}
777
778sub init_permissions {
779    require MT::Permission;
780    MT::Permission->init_permissions;
781}
782
783sub init_config {
784    my $mt = shift;
785    my ($param) = @_;
786
787    my $cfg_file = $mt->find_config($param);
788    return $mt->error(
789"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
790    ) unless $cfg_file;
791    $cfg_file = File::Spec->rel2abs($cfg_file);
792
793    # translate the config file's location to an absolute path, so we
794    # can use that directory as a basis for calculating other relative
795    # paths found in the config file.
796    my $config_dir = $mt->{config_dir} = dirname($cfg_file);
797
798    # store the mt_dir (home) as an absolute path; fallback to the config
799    # directory if it isn't set.
800    $mt->{mt_dir} =
801      $param->{Directory}
802      ? File::Spec->rel2abs( $param->{Directory} )
803      : $mt->{config_dir};
804    $mt->{mt_dir} ||= dirname($0);
805
806    # also make note of the active application path; this is derived by
807    # checking the PWD environment variable, the dirname of $0,
808    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
809    $mt->{app_dir} = $ENV{PWD} || "";
810    $mt->{app_dir} = dirname($0)
811      if !$mt->{app_dir}
812      || !File::Spec->file_name_is_absolute( $mt->{app_dir} );
813    $mt->{app_dir} = dirname( $ENV{SCRIPT_FILENAME} )
814      if $ENV{SCRIPT_FILENAME}
815      && ( !$mt->{app_dir}
816        || ( !File::Spec->file_name_is_absolute( $mt->{app_dir} ) ) );
817    $mt->{app_dir} ||= $mt->{mt_dir};
818    $mt->{app_dir} = File::Spec->rel2abs( $mt->{app_dir} );
819
820    my $cfg = $mt->config;
821    $cfg->define( $mt->registry('config_settings') );
822    $cfg->read_config($cfg_file) or return $mt->error( $cfg->errstr );
823    $mt->{cfg_file} = $cfg_file;
824
825    my @mt_paths = $cfg->paths;
826    for my $meth (@mt_paths) {
827        my $path = $cfg->get( $meth, undef );
828        my $type = $cfg->type($meth);
829        if ( defined $path ) {
830            if ( $type eq 'ARRAY' ) {
831                my @paths = $cfg->get($meth);
832                local $_;
833                foreach (@paths) {
834                    next if File::Spec->file_name_is_absolute($_);
835                    $_ = File::Spec->catfile( $config_dir, $_ );
836                }
837                $cfg->$meth( \@paths );
838            }
839            else {
840                if ( !File::Spec->file_name_is_absolute($path) ) {
841                    $path = File::Spec->catfile( $config_dir, $path );
842                    $cfg->$meth($path);
843                }
844            }
845        }
846        else {
847            next if $type eq 'ARRAY';
848            my $path = $cfg->default($meth);
849            if ( defined $path ) {
850                $cfg->$meth( File::Spec->catfile( $config_dir, $path ) );
851            }
852        }
853    }
854
855    return $mt->trans_error("Bad ObjectDriver config")
856      unless $cfg->ObjectDriver;
857
858    if ( $MT::DebugMode = $cfg->DebugMode ) {
859        require Data::Dumper;
860        $Data::Dumper::Terse    = 1;
861        $Data::Dumper::Maxdepth = 4;
862        $Data::Dumper::Sortkeys = 1;
863        $Data::Dumper::Indent   = 1;
864    }
865
866    if ($cfg->PerformanceLogging && $cfg->ProcessMemoryCommand) {
867        $mt->log_times();
868    }
869
870    $mt->set_language( $cfg->DefaultLanguage );
871
872    my $cgi_path = $cfg->CGIPath;
873    if ( !$cgi_path || $cgi_path =~ m!http://www\.example\.com/! ) {
874        return $mt->trans_error("Bad CGIPath config");
875    }
876
877    $mt->{cfg} = $cfg;
878
879    1;
880}
881
882{
883my ($memory_start);
884sub log_times {
885    my $pkg = shift;
886
887    my $timer = $pkg->get_timer;
888    return unless $timer;
889
890    my $memory;
891    my $cmd = $pkg->config->ProcessMemoryCommand;
892    if ($cmd) {
893        my $re;
894        if (ref($cmd) eq 'HASH') {
895            $re = $cmd->{regex};
896            $cmd = $cmd->{command};
897        }
898        $cmd =~ s/\$\$/$$/g;
899        $memory = `$cmd`;
900        if ($re) {
901            if ($memory =~ m/$re/) {
902                $memory = $1;
903                $memory =~ s/\D//g;
904            }
905        } else {
906            $memory =~ s/\s+//gs;
907        }
908    }
909
910    # Called at the start of the process; so we're only recording
911    # the memory usage at the start of the app right now.
912    unless ($timer->{elapsed}) {
913        $memory_start = $memory;
914        return;
915    }
916
917    my $log_file;
918
919    # Log filename calcluation; changes daily, so we don't cache this
920    require File::Spec;
921    my $dir = File::Spec->catdir( MT->instance->static_file_path,
922        'support', 'logs');
923    if (! -d $dir) {
924        require File::Path;
925        eval { File::Path::mkpath([$dir], 0, 0777) };
926        if ($@) {
927            $log_file = 0;
928            return;
929        }
930    }
931    my @time = localtime(time);
932    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
933    $log_file = File::Spec->catfile( $dir, $file );
934
935    my $first_write = ! -f $log_file;
936
937    local *PERFLOG;
938    open PERFLOG, ">>$log_file";
939    require Fcntl;
940    flock(PERFLOG, Fcntl::LOCK_EX());
941
942    if ($first_write) {
943        require Config;
944        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
945        print PERFLOG "# Operating System: $osname/$osvers\n";
946        print PERFLOG "# Platform: $^O\n";
947        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
948        print PERFLOG "# Perl Version: $ver\n";
949        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
950        require MT::Object;
951        my $driver = MT::Object->driver;
952        if ($driver) {
953            my $dbh = $driver->r_handle;
954            if ($dbh) {
955                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
956                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
957                if ($dbname && $dbver) {
958                    print PERFLOG "# Database: $dbname/$dbver\n";
959                }
960            }
961        }
962        my ($drname, $drh) = each %DBI::installed_drh;
963        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
964        if ($ENV{MOD_PERL}) {
965            print PERFLOG "# App Mode: mod_perl\n";
966        }
967        elsif ($ENV{FAST_CGI}) {
968            print PERFLOG "# App Mode: FastCGI\n";
969        }
970        else {
971            print PERFLOG "# App Mode: CGI\n";
972        }
973    }
974
975    if ($memory) {
976        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
977    } else {
978        print PERFLOG $timer->dump_line();
979    }
980
981    close PERFLOG;
982}
983}
984
985sub get_timer {
986    my $mt = shift;
987    $mt = MT->instance unless ref $mt;
988    my $timer = $mt->request('timer');
989    unless (defined $timer) {
990        if (MT->config('PerformanceLogging')) {
991            my $uri;
992            if ($mt->isa('MT::App')) {
993                $uri = $mt->uri( args => { $mt->param_hash } );
994            }
995            require MT::Util::ReqTimer;
996            $timer = MT::Util::ReqTimer->new( $uri );
997        } else {
998            $timer = 0;
999        }
1000        $mt->request('timer', $timer);
1001    }
1002    return $timer;
1003}
1004
1005sub time_this {
1006    my $mt = shift;
1007    my ($str, $code) = @_;
1008    my $timer = $mt->get_timer();
1009    my $ret;
1010    if ($timer) {
1011        $timer->pause_partial();
1012        $ret = $code->();
1013        $timer->mark($str);
1014    } else {
1015        $ret = $code->();
1016    }
1017    return $ret;
1018}
1019
1020sub init_config_from_db {
1021    my $mt = shift;
1022    my ($param) = @_;
1023    my $cfg = $mt->config;
1024    $cfg->read_config_db();
1025
1026    # Tell any instantiated drivers to reconfigure themselves as necessary
1027    MT::ObjectDriverFactory->configure;
1028
1029    1;
1030}
1031
1032sub bootstrap {
1033    my $pkg = shift;
1034    $pkg->init_paths() or return;
1035    $pkg->init_core()  or return;
1036}
1037
1038sub init_paths {
1039    my $mt = shift;
1040    my ($param) = @_;
1041
1042    # determine MT directory
1043    my ($orig_dir);
1044    require File::Spec;
1045    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1046        if ( $0 =~ m!(.*([/\\]))! ) {
1047            $orig_dir = $MT_DIR = $1;
1048            my $slash = $2;
1049            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1050            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1051        }
1052        else {
1053
1054            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1055            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1056        }
1057        unless ($MT_DIR) {
1058            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1059            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1060        }
1061        $ENV{MT_HOME} = $MT_DIR;
1062    }
1063    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1064    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1065      if $orig_dir && ( $orig_dir ne $MT_DIR );
1066
1067    $mt->set_language('__BUILD_LANGUAGE__');
1068
1069    if ( my $cfg_file = $mt->find_config($param) ) {
1070        $cfg_file = File::Spec->rel2abs($cfg_file);
1071        $CFG_FILE = $cfg_file;
1072    }
1073    else {
1074        return $mt->trans_error(
1075"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1076        ) if ref($mt);
1077    }
1078
1079    # store the mt_dir (home) as an absolute path; fallback to the config
1080    # directory if it isn't set.
1081    $MT_DIR ||=
1082      $param->{directory}
1083      ? File::Spec->rel2abs( $param->{directory} )
1084      : $CFG_DIR;
1085    $MT_DIR ||= dirname($0);
1086
1087    # also make note of the active application path; this is derived by
1088    # checking the PWD environment variable, the dirname of $0,
1089    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1090    $APP_DIR = $ENV{PWD} || "";
1091    $APP_DIR = dirname($0)
1092      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1093    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1094      if $ENV{SCRIPT_FILENAME}
1095      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1096    $APP_DIR ||= $MT_DIR;
1097    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1098
1099    return 1;
1100}
1101
1102sub init_core {
1103    my $mt = shift;
1104    return if exists $Components{'core'};
1105    require MT::Core;
1106    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1107      or die MT::Core->errstr;
1108    $Components{'core'} = $c;
1109
1110    # Additional locale-specific defaults
1111    my $defaults = $c->{registry}{config_settings};
1112    $defaults->{DefaultLanguage}{default} = '__BUILD_LANGUAGE__';
1113    $defaults->{NewsboxURL}{default} = '__NEWSBOX_URL__';
1114    $defaults->{LearningNewsURL}{default} = '__LEARNINGNEWS_URL__';
1115    $defaults->{SupportURL}{default} = '__SUPPORT_URL__';
1116    $defaults->{NewsURL}{default} = '__NEWS_URL__';
1117    #$defaults->{HelpURL}{default} = '__HELP_URL__';
1118    $defaults->{DefaultTimezone}{default} = '__DEFAULT_TIMEZONE__';
1119    $defaults->{TimeOffset}{default} = '__DEFAULT_TIMEZONE__';
1120    $defaults->{MailEncoding}{default} = '__MAIL_ENCODING__';
1121    $defaults->{ExportEncoding}{default} = '__EXPORT_ENCODING__';
1122    $defaults->{LogExportEncoding}{default} = '__LOG_EXPORT_ENCODING__';
1123    $defaults->{CategoryNameNodash}{default} = '__CATEGORY_NAME_NODASH__';
1124    $defaults->{PublishCharset}{default} = '__PUBLISH_CHARSET__';
1125
1126    push @Components, $c;
1127    return 1;
1128}
1129
1130sub init {
1131    my $mt    = shift;
1132    my %param = @_;
1133
1134    $mt->bootstrap() unless $MT_DIR;
1135    $mt->{mt_dir}     = $MT_DIR;
1136    $mt->{config_dir} = $CFG_DIR;
1137    $mt->{app_dir}    = $APP_DIR;
1138
1139    $mt->init_callbacks();
1140
1141    ## Initialize the language to the default in case any errors occur in
1142    ## the rest of the initialization process.
1143    $mt->init_config( \%param ) or return;
1144    $mt->init_addons(@_)       or return;
1145    $mt->init_config_from_db( \%param ) or return;
1146    $mt->init_plugins(@_)       or return;
1147    $plugins_installed = 1;
1148    $mt->init_schema();
1149    $mt->init_permissions();
1150
1151    # Load MT::Log so constants are available
1152    require MT::Log;
1153
1154    return $mt;
1155}
1156
1157sub init_callbacks {
1158    my $mt = shift;
1159    MT->_register_core_callbacks({
1160        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1161        'cms_upload_file' => \&core_upload_file_to_sync,
1162        'api_upload_file' => \&core_upload_file_to_sync,
1163    });
1164}
1165
1166sub core_upload_file_to_sync {
1167    my ($cb, %args) = @_;
1168    MT->upload_file_to_sync(%args);
1169}
1170
1171sub upload_file_to_sync {
1172    my $class = shift;
1173    my (%args) = @_;
1174
1175    # no need to do this unless we're syncing stuff.
1176    return unless MT->config('SyncTarget');
1177
1178    my $url = $args{url};
1179    my $file = $args{file};
1180    return unless -f $file;
1181
1182    my $blog = $args{blog};
1183    my $blog_id = $blog->id;
1184    return unless $blog->publish_queue;
1185
1186    require MT::FileInfo;
1187    my $base_url = $url;
1188    $base_url =~ s!^https?://[^/]+!!;
1189    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1190    if (!$fi) {
1191        $fi = new MT::FileInfo;
1192        $fi->blog_id($blog_id);
1193        $fi->url($base_url);
1194        $fi->file_path($file);
1195    } else {
1196        $fi->file_path($file);
1197    }
1198    $fi->save;
1199
1200    require MT::TheSchwartz;
1201    require TheSchwartz::Job;
1202    my $job = TheSchwartz::Job->new();
1203    $job->funcname('MT::Worker::Sync');
1204    $job->uniqkey( $fi->id );
1205    $job->coalesce( ( $fi->blog_id || 0 ) . ':' . $$ . ':' . ( time - ( time % 10 ) ) );
1206    MT::TheSchwartz->insert($job);
1207}
1208
1209sub init_addons {
1210    my $mt = shift;
1211    my $cfg = $mt->config;
1212    my @PluginPaths;
1213
1214    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1215    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1216}
1217
1218sub init_plugins {
1219    my $mt = shift;
1220
1221    # Load compatibility module for prior version
1222    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1223    require MT::Compat::v3;
1224
1225    require MT::Plugin;
1226    my $cfg          = $mt->config;
1227    my $use_plugins  = $cfg->UsePlugins;
1228    my @PluginPaths  = $cfg->PluginPath;
1229    my $PluginSwitch = $cfg->PluginSwitch || {};
1230    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1231}
1232
1233sub _init_plugins_core {
1234    my $mt = shift;
1235    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1236
1237    my $timer;
1238    if ($mt->config->PerformanceLogging) {
1239        $timer = $mt->get_timer();
1240    }
1241
1242    foreach my $PluginPath (@$PluginPaths) {
1243        my $plugin_lastdir = $PluginPath;
1244        $plugin_lastdir =~ s![\\/]$!!;
1245        $plugin_lastdir =~ s!.*[\\/]!!;
1246        local *DH;
1247        if ( opendir DH, $PluginPath ) {
1248            my @p = readdir DH;
1249          PLUGIN:
1250            for my $plugin (@p) {
1251                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1252
1253                my $load_plugin = sub {
1254                    my ( $plugin, $sig ) = @_;
1255                    die "Bad plugin filename '$plugin'"
1256                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1257                    local $plugin_sig      = $sig;
1258                    local $plugin_registry = {};
1259                    $plugin = $1;
1260                    if (
1261                        !$use_plugins
1262                        || ( exists $PluginSwitch->{$plugin_sig}
1263                            && !$PluginSwitch->{$plugin_sig} )
1264                      )
1265                    {
1266                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1267                        $Plugins{$plugin_sig}{enabled}   = 0;
1268                        return 0;
1269                    }
1270                    return 0 if exists $Plugins{$plugin_sig};
1271                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1272                    $timer->pause_partial if $timer;
1273                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire '$plugin';";
1274                    $timer->mark("Loaded plugin " . $sig) if $timer;
1275                    if ($@) {
1276                        $Plugins{$plugin_sig}{error} = $@;
1277                        # Issue MT log within another eval block in the
1278                        # event that the plugin error is happening before
1279                        # the database has been initialized...
1280                        eval {
1281                            # line __LINE__ __FILE__
1282                            require MT::Log;
1283                            $mt->log(
1284                                {
1285                                    message => $mt->translate(
1286                                        "Plugin error: [_1] [_2]", $plugin,
1287                                        $Plugins{$plugin_sig}{error}
1288                                    ),
1289                                    class => 'system',
1290                                    level => MT::Log::ERROR()
1291                                }
1292                            );
1293                        };
1294                        return 0;
1295                    }
1296                    else {
1297                        if ( my $obj = $Plugins{$plugin_sig}{object} ) {
1298                            $obj->init_callbacks();
1299                        }
1300                        else {
1301
1302                            # A plugin did not register itself, so
1303                            # create a dummy plugin object which will
1304                            # cause it to show up in the plugin listing
1305                            # by it's filename.
1306                            MT->add_plugin( {} );
1307                        }
1308                    }
1309                    $Plugins{$plugin_sig}{enabled} = 1;
1310                    return 1;
1311                };
1312                $plugin_full_path = File::Spec->catfile( $PluginPath, $plugin );
1313                if ( -f $plugin_full_path ) {
1314                    $plugin_envelope = $plugin_lastdir;
1315                    $load_plugin->( $plugin_full_path, $plugin )
1316                      if $plugin_full_path =~ /\.pl$/;
1317                }
1318                else {
1319                    my $plugin_dir = $plugin;
1320                    $plugin_envelope = "$plugin_lastdir/" . $plugin;
1321
1322                    # handle config.yaml
1323                    my $yaml =
1324                      File::Spec->catdir( $plugin_full_path, 'config.yaml' );
1325                    my $libdir;
1326                    ( unshift @INC, $libdir )
1327                      if -d ( $libdir =
1328                          File::Spec->catdir( $plugin_full_path, 'lib' ) );
1329                    if ( -f $yaml ) {
1330                        my $pclass =
1331                          $plugin_dir =~ m/\.pack$/
1332                          ? 'MT::Component'
1333                          : 'MT::Plugin';
1334
1335                        # Don't process disabled plugin config.yaml files.
1336                        if (
1337                            $pclass eq 'MT::Plugin'
1338                            && (
1339                                !$use_plugins
1340                                || ( exists $PluginSwitch->{$plugin_dir}
1341                                    && !$PluginSwitch->{$plugin_dir} )
1342                            )
1343                          )
1344                        {
1345                            $Plugins{$plugin_dir}{full_path} =
1346                              $plugin_full_path;
1347                            $Plugins{$plugin_dir}{enabled} = 0;
1348                            next;
1349                        }
1350                        my $id = lc $plugin_dir;
1351                        $id =~ s/\.\w+$//;
1352                        my $p = $pclass->new(
1353                            {
1354                                id       => $id,
1355                                path     => $plugin_full_path,
1356                                envelope => $plugin_envelope
1357                            }
1358                        );
1359
1360                        # rebless? based on config?
1361                        local $plugin_sig = $plugin_dir;
1362                        MT->add_plugin($p);
1363                        $p->init_callbacks()
1364                            if $pclass eq 'MT::Plugin';
1365                        next;
1366                    }
1367
1368                    opendir SUBDIR, $plugin_full_path;
1369                    my @plugins = readdir SUBDIR;
1370                    closedir SUBDIR;
1371                    for my $plugin (@plugins) {
1372                        next if $plugin !~ /\.pl$/;
1373                        my $plugin_file =
1374                          File::Spec->catfile( $plugin_full_path, $plugin );
1375                        if ( -f $plugin_file ) {
1376                            $load_plugin->(
1377                                $plugin_file, $plugin_dir . '/' . $plugin
1378                            );
1379                        }
1380                    }
1381                }
1382            }
1383            closedir DH;
1384        }
1385    }
1386
1387    # Reset the Text_filters hash in case it was preloaded by plugins by
1388    # calling all_text_filters (Markdown in particular does this).
1389    # Upon calling all_text_filters again, it will be properly loaded by
1390    # querying the registry.
1391    %Text_filters = ();
1392
1393    1;
1394}
1395
1396my %addons;
1397
1398sub find_addons {
1399    my $mt = shift;
1400    my ($type) = @_;
1401
1402    unless (%addons) {
1403        my $addon_path = File::Spec->catdir( $MT_DIR, 'addons' );
1404        local *DH;
1405        if ( opendir DH, $addon_path ) {
1406            my @p = readdir DH;
1407            foreach my $p (@p) {
1408                next if $p eq '.' || $p eq '..';
1409                my $full_path = File::Spec->catdir( $addon_path, $p );
1410                if ( -d $full_path ) {
1411                    if ( $p =~ m/^(.+)\.(\w+)$/ ) {
1412                        my $label = $1;
1413                        my $id    = lc $1;
1414                        my $type  = $2;
1415                        if ( $type eq 'pack' ) {
1416                            $label .= ' Pack';
1417                        }
1418                        elsif ( $type eq 'theme' ) {
1419                            $label .= ' Theme';
1420                        }
1421                        elsif ( $type eq 'plugin' ) {
1422                            $label .= ' Plugin';
1423                        }
1424                        push @{ $addons{$type} },
1425                          {
1426                            label    => $label,
1427                            id       => $id,
1428                            envelope => 'addons/' . $p . '/',
1429                            path     => $full_path,
1430                          };
1431                    }
1432                }
1433            }
1434        }
1435    }
1436    if ($type) {
1437        my $addons = $addons{$type} ||= [];
1438        return $addons;
1439    }
1440    return 1;
1441}
1442
1443*mt_dir = \&server_path;
1444sub server_path { $_[0]->{mt_dir} }
1445sub app_dir     { $_[0]->{app_dir} }
1446sub config_dir  { $_[0]->{config_dir} }
1447
1448sub component {
1449    my $mt = shift;
1450    my ($id) = @_;
1451    return $Components{ lc $id };
1452}
1453
1454sub publisher {
1455    my $mt = shift;
1456    $mt = $mt->instance unless ref $mt;
1457    unless ( $mt->{WeblogPublisher} ) {
1458        require MT::WeblogPublisher;
1459        $mt->{WeblogPublisher} = new MT::WeblogPublisher();
1460    }
1461    $mt->{WeblogPublisher};
1462}
1463
1464sub rebuild {
1465    my $mt = shift;
1466    $mt->publisher->rebuild(@_)
1467      or return $mt->error( $mt->publisher->errstr );
1468}
1469
1470sub rebuild_entry {
1471    my $mt = shift;
1472    $mt->publisher->rebuild_entry(@_)
1473      or return $mt->error( $mt->publisher->errstr );
1474}
1475
1476sub rebuild_indexes {
1477    my $mt = shift;
1478    $mt->publisher->rebuild_indexes(@_)
1479      or return $mt->error( $mt->publisher->errstr );
1480}
1481
1482sub rebuild_archives {
1483    my $mt = shift;
1484    $mt->publisher->rebuild_archives(@_)
1485      or return $mt->error( $mt->publisher->errstr );
1486}
1487
1488sub ping {
1489    my $mt    = shift;
1490    my %param = @_;
1491    my $blog;
1492    require MT::Entry;
1493    require MT::Util;
1494    unless ( $blog = $param{Blog} ) {
1495        my $blog_id = $param{BlogID};
1496        $blog = MT::Blog->load($blog_id)
1497          or return $mt->trans_error( "Load of blog '[_1]' failed: [_2]",
1498            $blog_id, MT::Blog->errstr );
1499    }
1500
1501    my (@res);
1502
1503    my $send_updates = 1;
1504    if ( exists $param{OldStatus} ) {
1505        ## If this is a new entry (!$old_status) OR the status was previously
1506        ## set to draft, and is now set to publish, send the update pings.
1507        my $old_status = $param{OldStatus};
1508        if ( $old_status && $old_status eq MT::Entry::RELEASE() ) {
1509            $send_updates = 0;
1510        }
1511    }
1512
1513    if ( $send_updates && !( MT->config->DisableNotificationPings ) ) {
1514        ## Send update pings.
1515        my @updates = $mt->update_ping_list($blog);
1516        for my $url (@updates) {
1517            require MT::XMLRPC;
1518            if ( MT::XMLRPC->ping_update( 'weblogUpdates.ping', $blog, $url ) )
1519            {
1520                push @res, { good => 1, url => $url, type => "update" };
1521            }
1522            else {
1523                push @res,
1524                  {
1525                    good  => 0,
1526                    url   => $url,
1527                    type  => "update",
1528                    error => MT::XMLRPC->errstr
1529                  };
1530            }
1531        }
1532        if ( $blog->mt_update_key ) {
1533            require MT::XMLRPC;
1534            if ( MT::XMLRPC->mt_ping($blog) ) {
1535                push @res,
1536                  {
1537                    good => 1,
1538                    url  => $mt->{cfg}->MTPingURL,
1539                    type => "update"
1540                  };
1541            }
1542            else {
1543                push @res,
1544                  {
1545                    good  => 0,
1546                    url   => $mt->{cfg}->MTPingURL,
1547                    type  => "update",
1548                    error => MT::XMLRPC->errstr
1549                  };
1550            }
1551        }
1552    }
1553
1554    my $cfg     = $mt->{cfg};
1555    my $send_tb = $cfg->OutboundTrackbackLimit;
1556    return \@res if $send_tb eq 'off';
1557
1558    my @tb_domains;
1559    if ( $send_tb eq 'selected' ) {
1560        @tb_domains = $cfg->OutboundTrackbackDomains;
1561    }
1562    elsif ( $send_tb eq 'local' ) {
1563        my $iter = MT::Blog->load_iter();
1564        while ( my $b = $iter->() ) {
1565            next if $b->id == $blog->id;
1566            push @tb_domains, MT::Util::extract_domains( $b->site_url );
1567        }
1568    }
1569    my $tb_domains;
1570    if (@tb_domains) {
1571        $tb_domains = '';
1572        my %seen;
1573        local $_;
1574        foreach (@tb_domains) {
1575            next unless $_;
1576            $_ = lc($_);
1577            next if $seen{$_};
1578            $tb_domains .= '|' if $tb_domains ne '';
1579            $tb_domains .= quotemeta($_);
1580            $seen{$_} = 1;
1581        }
1582        $tb_domains = '(' . $tb_domains . ')' if $tb_domains;
1583    }
1584
1585    ## Send TrackBack pings.
1586    if ( my $entry = $param{Entry} ) {
1587        my $pings = $entry->to_ping_url_list;
1588
1589        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1590        my $cats = $entry->categories;
1591        for my $cat (@$cats) {
1592            push @$pings, grep !$pinged{$_}, @{ $cat->ping_url_list };
1593        }
1594
1595        my $ua = MT->new_ua;
1596
1597        ## Build query string to be sent on each ping.
1598        my @qs;
1599        push @qs, 'title=' . MT::Util::encode_url( $entry->title );
1600        push @qs, 'url=' . MT::Util::encode_url( $entry->permalink );
1601        push @qs, 'excerpt=' . MT::Util::encode_url( $entry->get_excerpt );
1602        push @qs, 'blog_name=' . MT::Util::encode_url( $blog->name );
1603        my $qs = join '&', @qs;
1604
1605        ## Character encoding--best guess.
1606        my $enc = $mt->{cfg}->PublishCharset;
1607
1608        for my $url (@$pings) {
1609            $url =~ s/^\s*//;
1610            $url =~ s/\s*$//;
1611            my $url_domain;
1612            ($url_domain) = MT::Util::extract_domains($url);
1613            next if $tb_domains && lc($url_domain) !~ m/$tb_domains$/;
1614
1615            my $req = HTTP::Request->new( POST => $url );
1616            $req->content_type(
1617                "application/x-www-form-urlencoded; charset=$enc");
1618            $req->content($qs);
1619            my $res = $ua->request($req);
1620            if ( substr( $res->code, 0, 1 ) eq '2' ) {
1621                my $c = $res->content;
1622                my ( $error, $msg ) =
1623                  $c =~ m!<error>(\d+).*<message>(.+?)</message>!s;
1624                if ($error) {
1625                    push @res,
1626                      {
1627                        good  => 0,
1628                        url   => $url,
1629                        type  => 'trackback',
1630                        error => $msg
1631                      };
1632                }
1633                else {
1634                    push @res, { good => 1, url => $url, type => 'trackback' };
1635                }
1636            }
1637            else {
1638                push @res,
1639                  {
1640                    good  => 0,
1641                    url   => $url,
1642                    type  => 'trackback',
1643                    error => "HTTP error: " . $res->status_line
1644                  };
1645            }
1646        }
1647    }
1648    \@res;
1649}
1650
1651sub ping_and_save {
1652    my $mt    = shift;
1653    my %param = @_;
1654    if ( my $entry = $param{Entry} ) {
1655        my $results = MT::ping( $mt, @_ ) or return;
1656        my %still_ping;
1657        my $pinged = $entry->pinged_url_list;
1658        for my $res (@$results) {
1659            next if $res->{type} ne 'trackback';
1660            if ( !$res->{good} ) {
1661                $still_ping{ $res->{url} } = 1;
1662            }
1663            push @$pinged,
1664              $res->{url}
1665              . ( $res->{good}
1666                ? ''
1667                : ' ' . MT::I18N::encode_text( $res->{error} ) );
1668        }
1669        $entry->pinged_urls( join "\n", @$pinged );
1670        $entry->to_ping_urls( join "\n", keys %still_ping );
1671        $entry->save or return $mt->error( $entry->errstr );
1672        return $results;
1673    }
1674    1;
1675}
1676
1677sub needs_ping {
1678    my $mt    = shift;
1679    my %param = @_;
1680    my $blog  = $param{Blog};
1681    my $entry = $param{Entry};
1682    require MT::Entry;
1683    return unless $entry->status == MT::Entry::RELEASE();
1684    my $old_status = $param{OldStatus};
1685    my %list;
1686    ## If this is a new entry (!$old_status) OR the status was previously
1687    ## set to draft, and is now set to publish, send the update pings.
1688    if ( ( !$old_status || $old_status ne MT::Entry::RELEASE() )
1689        && !( MT->config->DisableNotificationPings ) )
1690    {
1691        my @updates = $mt->update_ping_list($blog);
1692        @list{@updates} = (1) x @updates;
1693        $list{ $mt->{cfg}->MTPingURL } = 1 if $blog && $blog->mt_update_key;
1694    }
1695    if ($entry) {
1696        @list{ @{ $entry->to_ping_url_list } } = ();
1697        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1698        my $cats = $entry->categories;
1699        for my $cat (@$cats) {
1700            @list{ grep !$pinged{$_}, @{ $cat->ping_url_list } } = ();
1701        }
1702    }
1703    my @list = keys %list;
1704    return unless @list;
1705    \@list;
1706}
1707
1708sub update_ping_list {
1709    my $mt = shift;
1710    my ($blog) = @_;
1711
1712    my @updates;
1713    if ( my $pings = MT->registry('ping_servers') ) {
1714        my $up = $blog->update_pings;
1715        if ($up) {
1716            foreach ( split ',', $up ) {
1717                next unless exists $pings->{$_};
1718                push @updates, $pings->{$_}->{url};
1719            }
1720        }
1721    }
1722    if ( my $others = $blog->ping_others ) {
1723        push @updates, split /\r?\n/, $others;
1724    }
1725    my %updates;
1726    for my $url (@updates) {
1727        for ($url) {
1728            s/^\s*//;
1729            s/\s*$//;
1730        }
1731        next unless $url =~ /\S/;
1732        $updates{$url}++;
1733    }
1734    keys %updates;
1735}
1736
1737{
1738    my $LH;
1739
1740    sub set_language {
1741        my $pkg = shift;
1742        require MT::L10N;
1743        $LH = MT::L10N->get_handle(@_);
1744
1745        # Clear any l10n_handles in request
1746        $pkg->request( 'l10n_handle', {} );
1747        return $LH;
1748    }
1749
1750    require MT::I18N;
1751
1752    sub translate {
1753        my $this = shift;
1754        my $app = ref($this) ? $this : $this->app;
1755        if ( $app->{component} ) {
1756            if ( my $c = $app->component( $app->{component} ) ) {
1757                local $app->{component} = undef;
1758                return $c->translate(@_);
1759            }
1760        }
1761        my ( $format, @args ) = @_;
1762        foreach (@args) {
1763            $_ = $_->() if ref($_) eq 'CODE';
1764        }
1765        my $enc = MT->instance->config('PublishCharset') || 'utf-8';
1766        return $LH->maketext( $format, @args ) if $enc =~ m/utf-?8/i;
1767        $format = MT::I18N::encode_text( $format, $enc, 'utf-8' );
1768        MT::I18N::encode_text(
1769            $LH->maketext(
1770                $format,
1771                map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
1772            ),
1773            'utf-8', $enc
1774        );
1775    }
1776
1777    sub translate_templatized {
1778        my $mt = shift;
1779        my $app = ref($mt) ? $mt : $mt->app;
1780        if ( $app->{component} ) {
1781            if ( my $c = $app->component( $app->{component} ) ) {
1782                local $app->{component} = undef;
1783                return $c->translate_templatized(@_);
1784            }
1785        }
1786        my @cstack;
1787        my ($text) = @_;
1788        while (1) {
1789            $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
1790            my($msg, $close, $section, %args) = ($1, $2, $3);
1791            while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
1792                $args{$1} = $3;
1793            }
1794            if ($section) {
1795                if ($close) {
1796                    $mt = pop @cstack;
1797                } else {
1798                    if ($args{component}) {
1799                        push @cstack, $mt;
1800                        $mt = MT->component($args{component})
1801                            or die "Bad translation component: $args{component}";
1802                    }
1803                    else {
1804                        die "__trans_section without a component argument";
1805                    }
1806                }
1807                '';
1808            }
1809            else {
1810                $args{params} = '' unless defined $args{params};
1811                my @p = map MT::Util::decode_html($_),
1812                        split /\s*%%\s*/, $args{params}, -1;
1813                @p = ('') unless @p;
1814                my $translation = $mt->translate($args{phrase}, @p);
1815                if (exists $args{escape}) {
1816                    if (lc($args{escape}) eq 'html') {
1817                        $translation = MT::Util::encode_html($translation);
1818                    } elsif (lc($args{escape}) eq 'url') {
1819                        $translation = MT::Util::encode_url($translation);
1820                    } else {
1821                        # fallback for js/javascript/singlequotes
1822                        $translation = MT::Util::encode_js($translation);
1823                    }
1824                }
1825                $translation;
1826            }
1827            !igem or last;
1828        }
1829        return $text;
1830    }
1831
1832    sub current_language { $LH->language_tag }
1833    sub language_handle  { $LH }
1834
1835    sub charset {
1836        my $mt = shift;
1837        $mt->{charset} = shift if @_;
1838        return $mt->{charset} if $mt->{charset};
1839        $mt->{charset} = $mt->config->PublishCharset
1840          || $mt->language_handle->encoding;
1841    }
1842}
1843
1844sub supported_languages {
1845    my $mt = shift;
1846    require MT::L10N;
1847    require File::Basename;
1848    ## Determine full path to lib/MT/L10N directory...
1849    my $lib =
1850      File::Spec->catdir( File::Basename::dirname( $INC{'MT/L10N.pm'} ),
1851        'L10N' );
1852    ## ... From that, determine full path to extlib/MT/L10N.
1853    ## To do that, we look for the last instance of the string 'lib'
1854    ## in $lib and replace it with 'extlib'. reverse is a nice tricky
1855    ## way of doing that.
1856    ( my $extlib = reverse $lib ) =~ s!bil!biltxe!;
1857    $extlib = reverse $extlib;
1858    my @dirs = ( $lib, $extlib );
1859    my %langs;
1860    for my $dir (@dirs) {
1861        opendir DH, $dir or next;
1862        for my $f ( readdir DH ) {
1863            my ($tag) = $f =~ /^(\w+)\.pm$/;
1864            next unless $tag;
1865            my $lh = MT::L10N->get_handle($tag);
1866            $langs{ $lh->language_tag } = $lh->language_name;
1867        }
1868        closedir DH;
1869    }
1870    \%langs;
1871}
1872
1873# For your convenience
1874sub trans_error {
1875    my $app = shift;
1876    $app->error( $app->translate(@_) );
1877}
1878
1879sub all_text_filters {
1880    unless (%Text_filters) {
1881        if ( my $filters = MT->registry('text_filters') ) {
1882            %Text_filters = %$filters if ref($filters) eq 'HASH';
1883        }
1884    }
1885    if (my $enabled_filters = MT->config('AllowedTextFilters')) {
1886        my %enabled = map { $_ => 1 } split /\s*,\s*/, $enabled_filters;
1887        %Text_filters = map { $_ => $Text_filters{$_} }
1888                        grep { exists $enabled{$_} }
1889                        keys %Text_filters;
1890    }
1891    return \%Text_filters;
1892}
1893
1894sub apply_text_filters {
1895    my $mt = shift;
1896    my ( $str, $filters, @extra ) = @_;
1897    my $all_filters = $mt->all_text_filters;
1898    for my $filter (@$filters) {
1899        my $f = $all_filters->{$filter} or next;
1900        my $code = $f->{code} || $f->{handler};
1901        unless ( ref($code) eq 'CODE' ) {
1902            $code = $mt->handler_to_coderef($code);
1903            $f->{code} = $code;
1904        }
1905        if ( !$code ) {
1906            warn "Bad text filter: $filter";
1907            next;
1908        }
1909        $str = $code->( $str, @extra );
1910    }
1911    return $str;
1912}
1913
1914sub static_path {
1915    my $app = shift;
1916    my $spath = $app->config->StaticWebPath;
1917    if (!$spath) {
1918        $spath = $app->config->CGIPath;
1919        $spath .= '/' unless $spath =~ m!/$!;
1920        $spath .= 'mt-static/';
1921    } else {
1922        $spath .= '/' unless $spath =~ m!/$!;
1923    }
1924    $spath;
1925}
1926
1927sub static_file_path {
1928    my $app = shift;
1929    return $app->{__static_file_path}
1930        if exists $app->{__static_file_path};
1931
1932    my $path = $app->config('StaticFilePath');
1933    return $app->{__static_file_path} = $path if defined $path;
1934
1935    # Attempt to derive StaticFilePath based on environment
1936    my $web_path = $app->config->StaticWebPath || 'mt-static';
1937    $web_path =~ s!^https?://[^/]+/!!;
1938    if ($app->can('document_root')) {
1939        my $doc_static_path = File::Spec->catdir($app->document_root(), $web_path);
1940        return $app->{__static_file_path} = $doc_static_path
1941            if -d $doc_static_path;
1942    }
1943    my $mtdir_static_path = File::Spec->catdir($app->mt_dir, 'mt-static');
1944    return $app->{__static_file_path} = $mtdir_static_path
1945        if -d $mtdir_static_path;
1946    return;
1947}
1948
1949sub template_paths {
1950    my $mt = shift;
1951    my @paths;
1952    my $path = $mt->config->TemplatePath;
1953    if ($mt->{plugin_template_path}) {
1954        if (File::Spec->file_name_is_absolute($mt->{plugin_template_path})) {
1955            push @paths, $mt->{plugin_template_path}
1956                if -d $mt->{plugin_template_path};
1957        } else {
1958            my $dir = File::Spec->catdir($mt->app_dir,
1959                                         $mt->{plugin_template_path});
1960            if (-d $dir) {
1961                push @paths, $dir;
1962            } else {
1963                $dir = File::Spec->catdir($mt->mt_dir,
1964                                          $mt->{plugin_template_path});
1965                push @paths, $dir if -d $dir;
1966            }
1967        }
1968    }
1969    if (my $alt_path = $mt->config->AltTemplatePath) {
1970        if (-d $alt_path) {    # AltTemplatePath is absolute
1971            push @paths, File::Spec->catdir($alt_path,
1972                                            $mt->{template_dir})
1973                if $mt->{template_dir};
1974            push @paths, $alt_path;
1975        }
1976    }
1977 
1978    for my $addon ( @{ $mt->find_addons('pack') } ) {
1979        push @paths, File::Spec->catdir($addon->{path}, 'tmpl', $mt->{template_dir})
1980            if $mt->{template_dir};
1981        push @paths, File::Spec->catdir($addon->{path}, 'tmpl');
1982    }
1983
1984    push @paths, File::Spec->catdir($path, $mt->{template_dir})
1985        if $mt->{template_dir};
1986    push @paths, $path;
1987 
1988    return @paths;
1989}
1990
1991sub find_file {
1992    my $mt = shift;
1993    my ($paths, $file) = @_;
1994    my $filename;
1995    foreach my $p (@$paths) {
1996        my $filepath = File::Spec->canonpath(File::Spec->catfile($p, $file));
1997        $filename = File::Spec->canonpath($filepath);
1998        return $filename if -f $filename;
1999    }
2000    undef;
2001}
2002
2003sub load_tmpl {
2004    my $mt = shift;
2005    if ($mt->{component}) {
2006        if (my $c = $mt->component($mt->{component})) {
2007            return $c->load_tmpl(@_);
2008        }
2009    }
2010
2011    my($file, @p) = @_;
2012    my $param;
2013    if (@p && (ref($p[$#p]) eq 'HASH')) {
2014        $param = pop @p;
2015    }
2016    my $cfg = $mt->config;
2017    require MT::Template;
2018    my $tmpl;
2019    my @paths = $mt->template_paths;
2020
2021    my $type = {'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref'}->{ref $file}
2022        || 'filename';
2023    $tmpl = MT::Template->new(
2024        type => $type, source => $file,
2025        path => \@paths,
2026        filter => sub {
2027            my ($str, $fname) = @_;
2028            if ($fname) {
2029                $fname = File::Basename::basename($fname);
2030                $fname =~ s/\.tmpl$//;
2031                $mt->run_callbacks("template_source.$fname", $mt, @_);
2032            } else {
2033                $mt->run_callbacks("template_source", $mt, @_);
2034            }
2035            return $str;
2036        },
2037        @p);
2038    return $mt->error(
2039        $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
2040    $mt->set_default_tmpl_params($tmpl);
2041    $tmpl->param($param) if $param;
2042    $tmpl;
2043}
2044
2045sub set_default_tmpl_params {
2046    my $mt = shift;
2047    my ($tmpl) = @_;
2048    my $param = {};
2049    $param->{mt_debug} = $MT::DebugMode;
2050    $param->{mt_beta} = 1 if MT->version_id =~ m/^\d+\.\d+(?:a|b|rc)/;
2051    $param->{static_uri} = $mt->static_path;
2052    $param->{mt_version} = MT->version_number;
2053    $param->{mt_version_id} = MT->version_id;
2054    $param->{mt_product_code} = MT->product_code;
2055    $param->{mt_product_name} = $mt->translate(MT->product_name);
2056    $param->{language_tag} = substr($mt->current_language, 0, 2);
2057    $param->{language_encoding} = $mt->charset;
2058    if ($mt->isa('MT::App')) {
2059        if (my $author = $mt->user) {
2060            $param->{author_id} = $author->id;
2061            $param->{author_name} = $author->name;
2062        }
2063        ## We do this in load_tmpl because show_error and login don't call
2064        ## build_page; so we need to set these variables here.
2065        require MT::Auth;
2066        $param->{can_logout} = MT::Auth->can_logout;
2067        $param->{script_url} = $mt->uri;
2068        $param->{mt_url} = $mt->mt_uri;
2069        $param->{script_path} = $mt->path;
2070        $param->{script_full_url} = $mt->base . $mt->uri;
2071        $param->{agent_mozilla} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /gecko/i;
2072        $param->{agent_ie} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /\bMSIE\b/;
2073    }
2074    if (!$tmpl->param('template_filename')) {
2075        if (my $fname = $tmpl->{__file}) {
2076            $fname =~ s!\\!/!g;
2077            $fname =~ s/\.tmpl$//;
2078            $param->{template_filename} = $fname;
2079        }
2080    }
2081    $tmpl->param($param);
2082}
2083
2084sub process_mt_template {
2085    my $mt = shift;
2086    my ($body) = @_;
2087    $body =~ s@<(?:_|MT)_ACTION\s+mode="([^"]+)"(?:\s+([^>]*))?>@
2088        my $mode = $1; my %args;
2089        %args = $2 =~ m/\s*(\w+)="([^"]*?)"\s*/g if defined $2; # "
2090        MT::Util::encode_html($mt->uri(mode => $mode, args => \%args));
2091    @geis;
2092    # Strip out placeholder wrappers to facilitate tmpl_* callbacks
2093    $body =~ s/<\/?MT_(\w+):(\w+)>//g;
2094    $body;
2095}
2096
2097sub build_page {
2098    my $mt = shift;
2099    my($file, $param) = @_;
2100    my $tmpl;
2101    my $mode = $mt->mode;
2102    $param->{"mode_$mode"} ||= 1;
2103    $param->{breadcrumbs} = $mt->{breadcrumbs};
2104    if ($param->{breadcrumbs}[-1]) {
2105        $param->{breadcrumbs}[-1]{is_last} = 1;
2106        $param->{page_titles} = [ reverse @{ $mt->{breadcrumbs} } ];
2107    }
2108    pop @{ $param->{page_titles} };
2109    if (my $lang_id = $mt->current_language) {
2110        $param->{local_lang_id} ||= lc $lang_id;
2111    }
2112    $param->{magic_token} = $mt->current_magic if $mt->user;
2113
2114    # List of installed packs in the application footer
2115    my @packs_installed;
2116    my $packs = $mt->find_addons('pack');
2117    if ($packs) {
2118        foreach my $pack (@$packs) {
2119            my $c = $mt->component(lc $pack->{id});
2120            if ($c) {
2121                my $label = $c->label || $pack->{label};
2122                $label = $label->() if ref($label) eq 'CODE';
2123                push @packs_installed, {
2124                    label => $label,
2125                    version => $c->version,
2126                    id => $c->id,
2127                };
2128            }
2129        }
2130    }
2131    @packs_installed = sort { $a->{label} cmp $b->{label} } @packs_installed;
2132    $param->{packs_installed} = \@packs_installed;
2133    $param->{portal_url} = $mt->translate("__PORTAL_URL__");
2134
2135    for my $config_field (keys %{ MT::ConfigMgr->instance->{__var} || {} }) {
2136        $param->{ $config_field . '_readonly' } = 1;
2137    }
2138
2139    my $tmpl_file = '';
2140    if (UNIVERSAL::isa($file, 'MT::Template')) {
2141        $tmpl = $file;
2142        $tmpl_file = (exists $file->{__file}) ? $file->{__file} : '';
2143    } else {
2144        $tmpl = $mt->load_tmpl($file) or return;
2145        $tmpl_file = $file unless ref($file);
2146    }
2147
2148    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2149        ($mt->{requires_login} && !$mt->user))) {
2150        ## If it's a login screen, direct the user to where they were going
2151        ## (query params including mode and all) unless they were logging in,
2152        ## logging out, or deleting something.
2153        my $q = $mt->{query};
2154        if ($mode) {
2155            my @query = map { { name => $_, value => scalar encode_text( $q->param($_) ) }; }
2156                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2157            $param->{query_params} = \@query;
2158        }
2159        $param->{login_again} = $mt->{login_again};
2160    }
2161
2162    my $blog = $mt->blog;
2163    $tmpl->context()->stash('blog', $blog) if $blog;
2164
2165    $tmpl->param($param) if $param;
2166
2167    if ($tmpl_file) {
2168        $tmpl_file = File::Basename::basename($tmpl_file);
2169        $tmpl_file =~ s/\.tmpl$//;
2170        $tmpl_file = '.' . $tmpl_file;
2171    }
2172    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2173
2174    my $output = $mt->build_page_in_mem($tmpl);
2175    return unless defined $output;
2176
2177    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2178    return $output;
2179}
2180
2181sub build_page_in_mem {
2182    my $mt = shift;
2183    my($tmpl, $param) = @_;
2184    $tmpl->param($param) if $param;
2185    my $out = $tmpl->output;
2186    return $mt->error($tmpl->errstr) unless defined $out;
2187    return $mt->translate_templatized($mt->process_mt_template($out));
2188}
2189
2190sub new_ua {
2191    my $class = shift;
2192    my ($opt) = @_;
2193    $opt ||= {};
2194    my $lwp_class = 'LWP::UserAgent';
2195    if ($opt->{paranoid}) {
2196        eval { require LWPx::ParanoidAgent; };
2197        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2198    }
2199    eval "require $lwp_class;";
2200    return undef if $@;
2201    my $cfg = $class->config;
2202    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2203    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2204    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2205    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2206    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2207    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2208
2209    if ( my $localaddr = $interface ) {
2210        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2211            LocalAddr => $localaddr,
2212            Reuse     => 1
2213        );
2214    }
2215
2216    my $ua = $lwp_class->new;
2217    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2218    $ua->agent( $agent );
2219    $ua->timeout( $timeout ) if defined $timeout;
2220    if ( defined $proxy ) {
2221        $ua->proxy( http => $proxy );
2222        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2223        $ua->no_proxy(@domains) if @domains;
2224    }
2225    return $ua;
2226}
2227
2228sub build_email {
2229    my $class = shift;
2230    my ( $file, $param ) = @_;
2231    my $mt = $class->instance;
2232
2233    # basically, try to load from database
2234    my $blog = $param->{blog} || undef;
2235    my $id = $file;
2236    $id =~ s/(\.tmpl|\.mtml)$//;
2237
2238    require MT::Template;
2239    my @tmpl = MT::Template->load(
2240        {
2241            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2242            identifier => $id,
2243            type       => 'email',
2244        }
2245    );
2246    my $tmpl =
2247      @tmpl
2248      ? (
2249        scalar @tmpl > 1
2250        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2251        : $tmpl[0]
2252      )
2253      : undef;
2254
2255    # try to load from file
2256    unless ($tmpl) {
2257        local $mt->{template_dir} = 'email';
2258        $tmpl = $mt->load_tmpl($file);
2259    }
2260    return unless $tmpl;
2261
2262    my $ctx = $tmpl->context;
2263    $ctx->stash( 'blog_id', $blog->id ) if $blog;
2264    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2265    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2266    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2267    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2268      if $param->{'commenter'};
2269    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2270    $ctx->stash( 'category', delete $param->{'category'} )
2271      if $param->{'category'};
2272    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2273
2274    foreach my $p (%$param) {
2275        if ( ref($p) ) {
2276            $tmpl->param( $p, $param->{$p} );
2277        }
2278    }
2279    return $mt->build_page_in_mem( $tmpl, $param );
2280}
2281
2282sub get_next_sched_post_for_user {
2283    my ( $author_id, @further_blog_ids ) = @_;
2284    require MT::Permission;
2285    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2286    my @blogs = @further_blog_ids;
2287    for my $perm (@perms) {
2288        next
2289          unless ( $perm->can_edit_config
2290            || $perm->can_publish_post
2291            || $perm->can_edit_all_posts );
2292        push @blogs, $perm->blog_id;
2293    }
2294    my $next_sched_utc = undef;
2295    require MT::Entry;
2296    for my $blog_id (@blogs) {
2297        my $blog           = MT::Blog->load($blog_id)
2298            or next;
2299        my $earliest_entry = MT::Entry->load(
2300            {
2301                status  => MT::Entry::FUTURE(),
2302                blog_id => $blog_id
2303            },
2304            { 'sort' => 'created_on' }
2305        );
2306        if ($earliest_entry) {
2307            my $entry_utc =
2308              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2309            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2310                $next_sched_utc = $entry_utc;
2311            }
2312        }
2313    }
2314    return $next_sched_utc;
2315}
2316
2317our %Commenter_Auth;
2318
2319sub init_commenter_authenticators {
2320    my $self = shift;
2321    my $auths = $self->registry("commenter_authenticators") || {};
2322    foreach my $auth ( keys %$auths ) {
2323        delete $auths->{$auth}
2324          if exists( $auths->{$auth}->{condition} )
2325          && !( $auths->{$auth}->{condition}->() );
2326    }
2327    %Commenter_Auth = %$auths;
2328    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2329}
2330
2331sub commenter_authenticator {
2332    my $self = shift;
2333    my ($key) = @_;
2334    %Commenter_Auth or $self->init_commenter_authenticators();
2335    return $Commenter_Auth{$key};
2336}
2337
2338sub commenter_authenticators {
2339    my $self = shift;
2340    %Commenter_Auth or $self->init_commenter_authenticators();
2341    return values %Commenter_Auth;
2342}
2343
2344sub _commenter_auth_params {
2345    my ( $key, $blog_id, $entry_id, $static ) = @_;
2346    my $params = {
2347        blog_id => $blog_id,
2348        static  => $static,
2349    };
2350    $params->{entry_id} = $entry_id if defined $entry_id;
2351    return $params;
2352}
2353
2354sub _openid_commenter_condition {
2355    eval "require Digest::SHA1;";
2356    return $@ ? 0 : 1;
2357}
2358
2359sub core_commenter_authenticators {
2360    return {
2361        'OpenID' => {
2362            class      => 'MT::Auth::OpenID',
2363            label      => 'OpenID',
2364            login_form => <<OpenID,
2365<form method="post" action="<mt:var name="script_url">">
2366<input type="hidden" name="__mode" value="login_external" />
2367<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2368<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2369<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2370<fieldset>
2371<mtapp:setting
2372    id="openid_display"
2373    label="<__trans phrase="OpenID URL">"
2374    hint="<__trans phrase="Sign in using your OpenID identity.">">
2375<input type="hidden" name="key" value="OpenID" />
2376<input name="openid_url" style="background: #fff url('<mt:var name="static_uri">images/comment/openid_logo.png') no-repeat left; padding-left: 18px; padding-bottom: 1px; border: 1px solid #5694b6; width: 304px; font-size: 110%;" />
2377    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2378</mtapp:setting>
2379
2380<div class="pkg">
2381<div class="left"><input type="submit" name="submit" value="<__trans phrase="Sign In">" /></div>
2382<div class="right"><img src="<mt:var name="static_uri">images/comment/openid_enabled.png" /></div>
2383</div>
2384<p><img src="<mt:var name="static_uri">images/comment/blue_moreinfo.png"> <a href="http://www.openid.net/"><__trans phrase="Learn more about OpenID."></a></p>
2385</fieldset>
2386</form>
2387OpenID
2388            login_form_params => \&_commenter_auth_params,
2389            condition         => \&_openid_commenter_condition,
2390            logo              => 'images/comment/signin_openid.png',
2391            logo_small        => 'images/comment/openid_logo.png',
2392        },
2393        'LiveJournal' => {
2394            class      => 'MT::Auth::LiveJournal',
2395            label      => 'LiveJournal',
2396            login_form => <<LiveJournal,
2397<form method="post" action="<mt:var name="script_url">">
2398<input type="hidden" name="__mode" value="login_external" />
2399<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2400<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2401<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2402<input type="hidden" name="key" value="LiveJournal" />
2403<fieldset>
2404<mtapp:setting
2405    id="livejournal_display"
2406    label="<__trans phrase="Your LiveJournal Username">"
2407    hint="<__trans phrase="Sign in using your Vox blog URL">">
2408<input name="openid_userid" style="background: #fff url('<mt:var name="static_uri">images/comment/livejournal_logo.png') no-repeat 2px center; padding: 2px 2px 2px 20px; border: 1px solid #5694b6; width: 300px; font-size: 110%;" />
2409</mtapp:setting>
2410<div class="actions-bar actions-bar-login">
2411    <div class="actions-bar-inner pkg actions">
2412        <button
2413            type="submit"
2414            class="primary-button"
2415            ><__trans phrase="Sign in"></button>
2416    </div>
2417</div>
2418<p><img src="<mt:var name="static_uri">images/comment/blue_moreinfo.png"> <a href="http://www.livejournal.com/"><__trans phrase="Learn more about LiveJournal."></a></p>
2419</fieldset>
2420</form>
2421LiveJournal
2422            login_form_params => \&_commenter_auth_params,
2423            condition         => \&_openid_commenter_condition,
2424            logo              => 'images/comment/signin_livejournal.png',
2425            logo_small        => 'images/comment/livejournal_logo.png',
2426        },
2427        'Vox' => {
2428            class      => 'MT::Auth::Vox',
2429            label      => 'Vox',
2430            login_form => <<Vox,
2431<form method="post" action="<mt:var name="script_url">">
2432<input type="hidden" name="__mode" value="login_external" />
2433<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2434<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2435<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2436<input type="hidden" name="key" value="Vox" />
2437<fieldset>
2438<mtapp:setting
2439    id="vox_display"
2440    label="<__trans phrase="Your Vox Blog URL">">
2441http:// <input name="openid_userid" style="background: #fff url('<mt:var name="static_uri">images/comment/vox_logo.png') no-repeat 2px center; padding: 2px 2px 2px 20px; border: 1px solid #5694b6; width: 200px; font-size: 110%; vertical-align: middle" />.vox.com
2442</mtapp:setting>
2443<div class="actions-bar actions-bar-login">
2444    <div class="actions-bar-inner pkg actions">
2445        <button
2446            type="submit"
2447            class="primary-button"
2448            ><__trans phrase="Sign in"></button>
2449    </div>
2450</div>
2451<p><img src="<mt:var name="static_uri">images/comment/blue_moreinfo.png"> <a href="http://www.vox.com/"><__trans phrase="Learn more about Vox."></a></p>
2452</fieldset>
2453</form>
2454Vox
2455            login_form_params => \&_commenter_auth_params,
2456            condition         => \&_openid_commenter_condition,
2457            logo              => 'images/comment/signin_vox.png',
2458            logo_small        => 'images/comment/vox_logo.png',
2459        },
2460        'TypeKey' => {
2461            class      => 'MT::Auth::TypeKey',
2462            label      => 'TypeKey',
2463            login_form => <<TypeKey,
2464<p class="hint"><__trans phrase="TypeKey is a free, open system providing you a central identity for posting comments on weblogs and logging into other websites. You can register for free."></p>
2465<p><img src="<mt:var name="static_uri">images/comment/blue_goto.png"> <a href="<mt:var name="tk_signin_url">"><__trans phrase="Sign in or register with TypeKey."></a></p>
2466TypeKey
2467            login_form_params => sub {
2468                my ( $key, $blog_id, $entry_id, $static ) = @_;
2469                my $entry = MT::Entry->load($entry_id) if $entry_id;
2470
2471                ## TypeKey URL
2472                require MT::Template::Context;
2473                my $ctx = MT::Template::Context->new;
2474                $ctx->stash( 'blog_id', $blog_id );
2475                my $blog = MT::Blog->load($blog_id);
2476                $ctx->stash( 'blog',  $blog );
2477                $ctx->stash( 'entry', $entry );
2478                my $params = {};
2479                $params->{tk_signin_url} =
2480                  MT::Template::Context::_hdlr_remote_sign_in_link( $ctx,
2481                    { static => $static } );
2482                return $params;
2483            },
2484            logo => 'images/comment/signin_typekey.png',
2485            logo_small        => 'images/comment/typekey_logo.png',
2486        },
2487    };
2488}
2489
2490our %Captcha_Providers;
2491
2492sub captcha_provider {
2493    my $self = shift;
2494    my ($key) = @_;
2495    $self->init_captcha_providers() unless %Captcha_Providers;
2496    return $Captcha_Providers{$key};
2497}
2498
2499sub captcha_providers {
2500    my $self = shift;
2501    $self->init_captcha_providers() unless %Captcha_Providers;
2502    my $def  = delete $Captcha_Providers{'mt_default'};
2503    my @vals = values %Captcha_Providers;
2504    if ( defined($def) && $def->{condition}->() ) {
2505        unshift @vals, $def;
2506    }
2507    @vals;
2508}
2509
2510sub core_captcha_providers {
2511    return {
2512        'mt_default' => {
2513            label     => 'Movable Type default',
2514            class     => 'MT::Util::Captcha',
2515            condition => sub {
2516                require MT::Util::Captcha;
2517                if ( my $error = MT::Util::Captcha->check_availability ) {
2518                    return 0;
2519                }
2520                1;
2521            },
2522        }
2523    };
2524}
2525
2526sub init_captcha_providers {
2527    my $self = shift;
2528    my $providers = $self->registry("captcha_providers") || {};
2529    foreach my $provider ( keys %$providers ) {
2530        delete $providers->{$provider}
2531          if exists( $providers->{$provider}->{condition} )
2532          && !( $providers->{$provider}->{condition}->() );
2533    }
2534    %Captcha_Providers = %$providers;
2535    $Captcha_Providers{$_}{key} ||= $_ for keys %Captcha_Providers;
2536}
2537
2538sub effective_captcha_provider {
2539    my $class = shift;
2540    my ($key) = @_;
2541    return undef unless $key;
2542    my $cp = $class->captcha_provider($key) or return;
2543    if ( exists $cp->{condition} ) {
2544        return undef unless $cp->{condition}->();
2545    }
2546    my $pkg = $cp->{class};
2547    $pkg =~ s/;//g;
2548    eval "require $pkg" or return;
2549    return $cp->{class};
2550}
2551
2552sub handler_to_coderef {
2553    my $pkg = shift;
2554    my ( $name, $delayed ) = @_;
2555
2556    return $name if ref($name) eq 'CODE';
2557    return undef unless defined $name && $name ne '';
2558
2559    my $code;
2560    if ( $name !~ m/->/ ) {
2561
2562        # check for Package::Routine first; if defined, return coderef
2563        no strict 'refs';
2564        $code = \&$name if defined &$name;
2565        return $code if $code;
2566    }
2567
2568    my $component;
2569    if ( $name =~ m!^\$! ) {
2570        if ( $name =~ s/^\$(\w+)::// ) {
2571            $component = $1;
2572        }
2573    }
2574    if ( $name =~ m/^\s*sub\s*\{/s ) {
2575        $code = eval $name or die $@;
2576
2577        if ($component) {
2578            return sub {
2579                my $mt_inst = MT->instance;
2580                local $mt_inst->{component} = $component;
2581                $code->(@_);
2582            };
2583        }
2584        else {
2585            return $code;
2586        }
2587    }
2588
2589    my $hdlr_pkg = $name;
2590    my $method;
2591    if ( $hdlr_pkg =~ s/(->|::)([^:]+)$// ) {    # strip routine name
2592        $method = $2 if $1 eq '->';
2593    }
2594    if ( !defined(&$name) && !$pkg->can( 'AUTOLOAD' ) ) {
2595
2596        # The delayed option will return a coderef that delays the loading
2597        # of the package holding the handler routine.
2598        if ($delayed) {
2599            if ($method) {
2600                return sub {
2601                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $hdlr_pkg;"
2602                      or Carp::confess(
2603                        "failed loading package $hdlr_pkg for routine $name: $@");
2604                    my $mt_inst = MT->instance;
2605                    local $mt_inst->{component} = $component
2606                      if $component;
2607                    return $hdlr_pkg->$method(@_);
2608                };
2609            }
2610            else {
2611                return sub {
2612                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $hdlr_pkg;"
2613                      or Carp::confess(
2614                        "failed loading package $hdlr_pkg for routine $name: $@");
2615                    my $mt_inst = MT->instance;
2616                    local $mt_inst->{component} = $component
2617                      if $component;
2618                    no strict 'refs';
2619                    my $hdlr = \&$name;
2620                    use strict 'refs';
2621                    return $hdlr->(@_);
2622                };
2623            }
2624        }
2625        else {
2626            eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $hdlr_pkg;"
2627              or Carp::confess(
2628                "failed loading package $hdlr_pkg for routine $name: $@");
2629        }
2630    }
2631    if ($method) {
2632        $code = sub {
2633            my $mt_inst = MT->instance;
2634            local $mt_inst->{component} = $component
2635              if $component;
2636            return $hdlr_pkg->$method(@_);
2637        };
2638    }
2639    else {
2640        if ($component) {
2641            $code = sub {
2642                no strict 'refs';
2643                my $hdlr = (
2644                    defined &$name ? \&$name
2645                    : ( $pkg->can( 'AUTOLOAD' ) ? \&$name
2646                        : undef )
2647                );
2648                use strict 'refs';
2649                if ($hdlr) {
2650                    my $mt_inst = MT->instance;
2651                    local $mt_inst->{component} = $component
2652                      if $component;
2653                    return $hdlr->(@_);
2654                }
2655                return undef;
2656              }
2657        }
2658        else {
2659            no strict 'refs';
2660            $code =
2661              (
2662                defined &$name
2663                ? \&$name
2664                : ( $hdlr_pkg->can( 'AUTOLOAD' ) ? \&$name : undef )
2665              );
2666        }
2667    }
2668    return $code;
2669}
2670
2671sub help_url {
2672    my $pkg = shift;
2673    my ( $append ) = @_;
2674
2675    my $url = $pkg->config->HelpURL;
2676    return $url if defined $url;
2677    $url = $pkg->translate('http://www.movabletype.org/documentation/');
2678    if ( $append ) {
2679        $url .= $append;
2680    }
2681    $url;
2682}
2683
2684sub register_refresh_cache_event {
2685    my $pkg = shift;
2686    my ($callback) = @_;
2687    return unless $callback;
2688
2689    MT->_register_core_callbacks({
2690        "$callback" => \&refresh_cache,
2691    });
2692}
2693
2694sub refresh_cache {
2695    my ($cb, %args) = @_;
2696
2697    require MT::Cache::Negotiate;
2698    my $cache_driver = MT::Cache::Negotiate->new();
2699    return unless $cache_driver;
2700
2701    $cache_driver->flush_all();
2702}
2703
2704sub DESTROY {
2705    # save_config here so not to miss any dirty config change to persist
2706    # particulary for those which does not construct MT::App.
2707    $_[0]->config->save_config();
2708}
2709
27101;
2711
2712__END__
2713
2714=head1 NAME
2715
2716MT - Movable Type
2717
2718=head1 SYNOPSIS
2719
2720    use MT;
2721    my $mt = MT->new;
2722    $mt->rebuild(BlogID => 1)
2723        or die $mt->errstr;
2724
2725=head1 DESCRIPTION
2726
2727The I<MT> class is the main high-level rebuilding/pinging interface in the
2728Movable Type library. It handles all rebuilding operations. It does B<not>
2729handle any of the application functionality--for that, look to I<MT::App> and
2730I<MT::App::CMS>, both of which subclass I<MT> to handle application requests.
2731
2732=head1 PLUGIN APPLICATIONS
2733
2734At any given time, the user of the Movable Type platform is
2735interacting with either the core Movable Type application, or a plugin
2736application (or "sub-application").
2737
2738A plugin application is a plugin with a user interface that inherits
2739functionality from Movable Type, and appears to the user as a
2740component of Movable Type. A plugin application typically has its own
2741templates displaying its own special features; but it inherits some
2742templates from Movable Type, such as the navigation chrome and error
2743pages.
2744
2745=head2 The MT Root and the Application Root
2746
2747To locate assets of the core Movable Type application and any plugin
2748applications, the platform uses two directory paths, C<mt_dir> and
2749C<app_dir>. These paths are returned by the MT class methods with the
2750same names, and some other methods return derivatives of these paths.
2751
2752Conceptually, mt_dir is the root of the Movable Type installation, and
2753app_dir is the root of the "currently running application", which
2754might be Movable Type or a plugin application. It is important to
2755understand the distinction between these two values and what each is
2756used for.
2757
2758The I<mt_dir> is the absolute path to the directory where MT itself is
2759located. Most importantly, the MT configuration file and the CGI scripts that
2760bootstrap an MT request are found here. This directory is also the
2761default base path under which MT's core templates are found (but this
2762can be overridden using the I<TemplatePath> configuration setting).
2763
2764Likewise, the I<app_dir> is the directory where the "current"
2765application's assets are rooted. The platform will search for
2766application templates underneath the I<app_dir>, but this search also
2767searches underneath the I<mt_dir>, allowing the application to make
2768use of core headers, footers, error pages, and possibly other
2769templates.
2770
2771In order for this to be useful, the plugin's templates and
2772code should all be located underneath the same directory. The relative
2773path from the I<app_dir> to the application's templates is
2774configurable. For details on how to indicate the location of your
2775plugin's templates, see L<MT::App>.
2776
2777=head2 Finding the Root Paths
2778
2779When a plugin application initializes its own application class (a
2780subclass of MT::App), the I<mt_dir> should be discovered and passed
2781constructor. This comes either from the C<Directory> parameter or the
2782C<Config> parameter.
2783
2784Since plugins are loaded from a descendent of the MT root directory,
2785the plugin bootstrap code can discover the MT configuration file (and thus
2786the MT root directory) by traversing the filesystem; the absolute path
2787to that file can be passed as the C<Config> parameter to
2788MT::App::new. Working code to do this can be found in the
2789examples/plugins/mirror/mt-mirror.cgi file.
2790
2791The I<app_dir>, on the other hand, always derives from the location of
2792the currently-running program, so it typically does not need to be
2793specified.
2794
2795=head1 USAGE
2796
2797I<MT> has the following interface. On failure, all methods return C<undef>
2798and set the I<errstr> for the object or class (depending on whether the
2799method is an object or class method, respectively); look below at the section
2800L<ERROR HANDLING> for more information.
2801
2802=head2 MT->new( %args )
2803
2804Constructs a new I<MT> instance and returns that object. Returns C<undef>
2805on failure.
2806
2807I<new> will also read your MT configuration file (provided that it can find it--if
2808you find that it can't, take a look at the I<Config> directive, below). It
2809will also initialize the chosen object driver; the default is the C<DBM>
2810object driver.
2811
2812I<%args> can contain:
2813
2814=over 4
2815
2816=item * Config
2817
2818Path to the MT configuration file.
2819
2820If you do not specify a path, I<MT> will try to find your MT configuration file
2821in the current working directory.
2822
2823=item * Directory
2824
2825Path to the MT home directory.
2826
2827If you do not specify a path, I<MT> will try to find the MT directory using
2828the discovered path of the MT configuration file.
2829
2830=back
2831
2832=head2 $mt->init
2833
2834Initializes the Movable Type instance, including registration of basic
2835resources and callbacks. This method also invokes the C<init_config>
2836and C<init_plugins> methods.
2837
2838=head2 MT->instance
2839
2840MT and all it's subclasses are now singleton classes, meaning you can only
2841have one instance per package. MT->instance() returns the active instance.
2842MT->new() is now an alias to instance_of.
2843
2844=head2 $class->instance_of
2845
2846Returns the singleton instance of the MT subclass identified by C<$class>.
2847
2848=head2 $class->construct
2849
2850Constructs a new instance of the MT subclass identified by C<$class>.
2851
2852=head2 MT->set_instance
2853
2854Assigns the active MT instance object. This value is returned when
2855C<MT-E<gt>instance> is invoked.
2856
2857=head2 $mt->find_config($params)
2858
2859Handles the discovery of the MT configuration file. The path and filename
2860for the configuration file is returned as the result. The C<$params>
2861parameter is a reference to the hash of settings passed to the MT
2862constructor.
2863
2864=head2 $mt->init_config($params)
2865
2866Reads the MT configuration settingss from the MT configuration file
2867and settings from database (L<MT::Config>).
2868
2869The C<$params> parameter is a reference to the hash of settings passed to
2870the MT constructor.
2871
2872=head2 $mt->init_plugins
2873
2874Loads any discoverable plugins that are available. This is called from
2875the C<init> method, after the C<init_config> method has loaded the
2876configuration settings.
2877
2878=head2 $mt->init_tasks
2879
2880Registers the standard set of periodic tasks that Movable Type provides
2881and then invokes the C<init_tasks> method for each available plugin.
2882
2883=head2 MT->run_tasks
2884
2885Initializes the tasks, running C<init_tasks> and invokes the task system
2886through L<MT::TaskMgr> to run any registered tasks that are pending
2887execution. See L<MT::TaskMgr> for further documentation.
2888
2889=head2 MT->unplug
2890
2891Removes the global reference to the MT instance.
2892
2893=head2 MT::log( $message ) or $mt->log( $message )
2894
2895Adds an entry to the application's log table. Also writes message to
2896STDERR which is typically routed to the web server's error log.
2897
2898=head2 $mt->server_path, $mt->mt_dir
2899
2900Both of these methods return the physical file path to the directory
2901that is the home of the MT installation. This would be the value of
2902the 'Directory' parameter given in the MT constructor, or would be
2903determined based on the path of the configuration file.
2904
2905=head2 $mt->app_dir
2906
2907Returns the physical file path to the active application directory. This
2908is determined by the directory of the active script.
2909
2910=head2 $mt->config_dir
2911
2912Returns the path to the MT configuration file.
2913
2914=head2 $mt->config([$setting[, $value]])
2915
2916This method is used to get and set configuration settings. When called
2917without any parameters, it returns the active MT::ConfigMgr instance
2918used by the application.
2919
2920Specifying the C<$setting> parameter will return the value for that setting.
2921When passing the C<$value> parameter, this will update the config object,
2922assigning that value for the named C<$setting>.
2923
2924=head2 $mt->user_class
2925
2926Returns the package name for the class used for user authentication.
2927This is typically L<MT::Author>.
2928
2929=head2 $mt->request([$element[,$data]])
2930
2931The request method provides a request-scoped storage object. It is an
2932access interface for the L<MT::Request> package. Calling without any
2933parameters will return the L<MT::Request> instance.
2934
2935When called with the C<$element> parameter, the data stored for that
2936element is returned (or undef, if it didn't exist). When called with
2937the C<$data> parameter, it will store the data into the specified
2938element in the request object.
2939
2940All values placed in the request object are lost at the end of the
2941request. If the running application is not a web-based application,
2942the request object exists for the lifetime of the process and is
2943released when the process ends.
2944
2945See the L<MT::Request> package for more information.
2946
2947=head2 MT->new_ua
2948
2949Returns a new L<LWP::UserAgent> instance that is configured according to the
2950Movable Type configuration settings (specifically C<HTTPInterface>, C<HTTPTimeout>, C<HTTPProxy> and C<HTTPNoProxy>). The agent string is set
2951to "MovableType/(version)" and is also limited to receiving a response of
2952100,000 bytes by default (you can override this by using the 'max_size'
2953method on the returned instance). Using this method is recommended for
2954any HTTP requests issued by Movable Type since it uses the MT configuration
2955settings to prepare the UserAgent object.
2956
2957=head2 $mt->ping( %args )
2958
2959Sends all configured XML-RPC pings as a way of notifying other community
2960sites that your blog has been updated.
2961
2962I<%args> can contain:
2963
2964=over 4
2965
2966=item * Blog
2967
2968An I<MT::Blog> object corresponding to the blog for which you would like to
2969send the pings.
2970
2971Either this or C<BlogID> is required.
2972
2973=item * BlogID
2974
2975The ID of the blog for which you would like to send the pings.
2976
2977Either this or C<Blog> is required.
2978
2979=back
2980
2981=head2 $mt->ping_and_save( %args )
2982
2983Handles the task of issuing any pending ping operations for a given
2984entry and then saving that entry back to the database.
2985
2986The I<%args> hash should contain an element named C<Entry> that is a
2987reference to a L<MT::Entry> object.
2988
2989=head2 $mt->needs_ping(%param)
2990
2991Returns a list of URLs that have not been pinged for a given entry. Named
2992parameters for this method are:
2993
2994=over 4
2995
2996=item Entry
2997
2998The L<MT::Entry> object to examine.
2999
3000=item Blog
3001
3002The L<MT::Blog> object that is the parent of the entry given.
3003
3004=back
3005
3006The return value is an array reference of URLs that have not been pinged
3007for the given entry.
3008
3009An empty list is returned for entries that have a non 'RELEASE' status.
3010
3011=head2 $mt->update_ping_list($blog)
3012
3013Returns a list of URLs for ping services that have been configured to
3014be notified when posting new entries.
3015
3016=head2 $mt->set_language($tag)
3017
3018Loads the localization plugin for the language specified by I<$tag>, which
3019should be a valid and supported language tag--see I<supported_languages> to
3020obtain a list of supported languages.
3021
3022The language is set on a global level, and affects error messages and all
3023text in the administration system.
3024
3025This method can be called as either a class method or an object method; in
3026other words,
3027
3028    MT->set_language($tag)
3029
3030will also work. However, the setting will still be global--it will not be
3031specified to the I<$mt> object.
3032
3033The default setting--set when I<MT::new> is called--is U.S. English. If a
3034I<DefaultLanguage> is set in the MT configuration file, the default is then
3035set to that language.
3036
3037=head2 MT->translate($str[, $param, ...])
3038
3039Translates I<$str> into the currently-set language (set by I<set_language>),
3040and returns the translated string. Any parameters following I<$str> are
3041passed through to the C<maketext> method of the active localization module.
3042
3043=head2 MT->translate_templatized($str)
3044
3045Translates a string that has embedded E<lt>MT_TRANSE<gt> tags. These
3046tags identify the portions of the string that require localization.
3047Each tag is processed separately and passed through the MT->translate
3048method. Examples (used in your application's HTML::Template templates):
3049
3050    <p><MT_TRANS phrase="Hello, world"></p>
3051
3052and
3053
3054    <p><MT_TRANS phrase="Hello, [_1]" params="<TMPL_VAR NAME=NAME>"></p>
3055
3056=head2 $mt->trans_error( $str[, $arg1, $arg2] )
3057
3058Translates I<$str> into the currently-set language (set by I<set_language>),
3059and assigns it as the active error for the MT instance. It returns undef,
3060which is the usual return value upon generating an error in the application.
3061So when an error occurs, the typical return result would be:
3062
3063    if ($@) {
3064        return $app->trans_error("An error occurred: [_1]", $@);
3065    }
3066
3067The optional I<$arg1> (and so forth) parameters are passed as parameters to
3068any parameterized error message.
3069
3070=head2 $mt->current_language
3071
3072Returns the language tag for the currently-set language.
3073
3074=head2 MT->supported_languages
3075
3076Returns a reference to an associative array mapping language tags to their
3077proper names. For example:
3078
3079    use MT;
3080    my $langs = MT->supported_languages;
3081    print map { $_ . " => " . $langs->{$_} . "\n" } keys %$langs;
3082
3083=head2 MT->language_handle
3084
3085Returns the active MT::L10N language instance for the active language.
3086
3087=head2 MT->add_plugin($plugin)
3088
3089Adds the plugin described by $plugin to the list of plugins displayed
3090on the welcome page. The argument should be an object of the
3091I<MT::Plugin> class.
3092
3093=head2 MT->all_text_filters
3094
3095Returns a reference to a hash containing the registry of text filters.
3096
3097=head2 MT->apply_text_filters($str, \@filters)
3098
3099Applies the set of filters I<\@filters> to the string I<$str> and returns
3100the result (the filtered string).
3101
3102I<\@filters> should be a reference to an array of filter keynames--these
3103are the short names passed in as the first argument to I<add_text_filter>.
3104I<$str> should be a scalar string to be filtered.
3105
3106If one of the filters listed in I<\@filters> is not found in the list of
3107registered filters (that is, filters added through I<add_text_filter>),
3108it will be skipped silently. Filters are executed in the order in which they
3109appear in I<\@filters>.
3110
3111As it turns out, the I<MT::Entry::text_filters> method returns a reference
3112to the list of text filters to be used for that entry. So, for example, to
3113use this method to apply filters to the main entry text for an entry
3114I<$entry>, you would use
3115
3116    my $out = MT->apply_text_filters($entry->text, $entry->text_filters);
3117
3118=head2 MT->add_callback($meth, $priority, $plugin, $code)
3119
3120Registers a new callback handler for a particular registered callback.
3121
3122The first parameter is the name of the callback method. The second
3123parameter is a priority (a number in the range of 1-10) which will control
3124the order that the handler is executed in relation to other handlers. If
3125two handlers register with the same priority, they will be executed in
3126the order that they registered. The third parameter is a C<MT::Plugin> object
3127reference that is associated with the handler (this parameter is optional).
3128The fourth parameter is a code reference that is invoked to handle the
3129callback. For example:
3130
3131    MT->add_callback('BuildFile', 1, undef, \&rebuild_file_hdlr);
3132
3133The code reference should expect to receive an object of type
3134L<MT::Callback> as its first argument. This object is used to
3135communicate errors to the caller:
3136
3137    sub rebuild_file_hdlr {
3138        my ($cb, ...) = @_;
3139        if (something bad happens) {
3140            return $cb->error("Something bad happened!");
3141        }
3142    }
3143
3144Other parameters to the callback function depend on the callback point.
3145
3146The treatment of the error string depends on the callback point.
3147Typically, either it is ignored or the user's action fails and the
3148error message is displayed.
3149
3150The value returned from this method is the new L<MT::Callback> object.
3151
3152=head2 MT->remove_callback($callback)
3153
3154Removes a callback that was previously registered.
3155
3156=head2 MT->register_callbacks([...])
3157
3158Registers several callbacks simultaneously. Each element in the array
3159parameter given should be a hashref containing these elements: C<name>,
3160C<priority>, C<plugin> and C<code>.
3161
3162=head2 MT->run_callbacks($meth[, $arg1, $arg2, ...])
3163
3164Invokes a particular callback, running any associated callback handlers.
3165
3166The first parameter is the name of the callback to execute. This is one
3167of the global callback methods (see L<Callbacks> section) or can be
3168a class-specific method that includes the package name associated with
3169the callback.
3170
3171The remaining arguments are passed through to any callback handlers that
3172are invoked.
3173
3174For "Filter"-type callbacks, this routine will return a 0 if any of the
3175handlers return a false result. If all handlers return a true result,
3176a value of 1 is returned.
3177
3178Example:
3179
3180    MT->run_callbacks('MyClass::frobnitzes', \@whirlygigs);
3181
3182Which would execute any handlers that registered in this fashion:
3183
3184    MT->add_callback('MyClass::frobnitzes', 4, $plugin, \&frobnitz_hdlr);
3185
3186=head2 MT->run_callback($cb[, $arg1, $arg2, ...])
3187
3188An internal routine used by C<run_callbacks> to invoke a single
3189L<MT::Callback>.
3190
3191=head2 callback_error($str)
3192
3193This routine is used internally by C<MT::Callback> to set any error response
3194that comes from invoking a callback.
3195
3196=head2 callback_errstr
3197
3198This internal routine returns the error response stored using the
3199C<callback_error> routine.
3200
3201=head2 MT->product_code
3202
3203The product code identifying the Movable Type product that is installed.
3204This is either 'MTE' for Movable Type Enterprise or 'MT' for the
3205non-Enterprise product.
3206
3207=head2 MT->product_name
3208
3209The name of the Movable Type product that is installed. This is either
3210'Movable Type Enterprise' or 'Movable Type Publishing Platform'.
3211
3212=head2 MT->product_version
3213
3214The version number of the product. This is different from the C<version_id>
3215and C<version_number> methods as they report the API version information.
3216
3217=head2 MT->version_id
3218
3219Returns the API version of MT (including any beta/alpha designations).
3220
3221=head2 MT->version_number
3222
3223Returns the numeric API version of MT (without any beta/alpha designations).
3224For example, if I<version_id> returned C<2.5b1>, I<version_number> would
3225return C<2.5>.
3226
3227=head2 MT->schema_version
3228
3229Returns the version of the MT database schema.
3230
3231=head2 MT->version_slug
3232
3233Returns a string of text that is appended to emails sent through the
3234C<build_email> method.
3235
3236=head2 $mt->publisher
3237
3238Returns the L<MT::WeblogPublisher> object that is used for managing the
3239MT publishing process. See L<MT::WeblogPublisher> for more information.
3240
3241=head2 $mt->rebuild
3242
3243An alias to L<MT::WeblogPublisher::rebuild>. See L<MT::WeblogPublisher>
3244for documentation of this method.
3245
3246=head2 $mt->rebuild_entry
3247
3248An alias to L<MT::WeblogPublisher::rebuild_entry>. See L<MT::WeblogPublisher>
3249for documentation of this method.
3250
3251=head2 $mt->rebuild_indexes
3252
3253An alias to L<MT::WeblogPublisher::rebuild_indexes>. See
3254L<MT::WeblogPublisher> for documentation of this method.
3255
3256=head2 $mt->build_email($file, $param)
3257
3258Loads a template from the application's 'email' template directory and
3259processes it as a HTML::Template. The C<$param> argument is a hash reference
3260of parameter data for the template. The return value is the output of the
3261template.
3262
3263=head2 MT::get_next_sched_post_for_user($author_id, @blog_ids)
3264
3265This is an internal routine used by L<MT::XMLRPCServer> and the
3266getNextScheduled XMLRPC method to determine the timestamp for the next
3267entry that is scheduled for publishing. The return value is the timestamp
3268in UTC time in the format "YYYY-MM-DDTHH:MM:SSZ".
3269
3270=head1 ERROR HANDLING
3271
3272On an error, all of the above methods return C<undef>, and the error message
3273can be obtained by calling the method I<errstr> on the class or the object
3274(depending on whether the method called was a class method or an instance
3275method).
3276
3277For example, called on a class name:
3278
3279    my $mt = MT->new or die MT->errstr;
3280
3281Or, called on an object:
3282
3283    $mt->rebuild(BlogID => $blog_id)
3284        or die $mt->errstr;
3285
3286=head1 DEBUGGING
3287
3288MT has a package variable C<$MT::DebugMode> which is assigned through
3289your MT configuration file (DebugMode setting). If this is set to
3290any non-zero value, MT applications will display any C<warn>'d
3291statements to a panel that is displayed within the app.
3292
3293The DebugMode is a bit-wise setting and offers the following options:
3294
3295    1 - Display debug messages
3296    2 - Display a stack trace for messages captured
3297    4 - Lists queries issued by Data::ObjectDriver
3298    8 - Reports on MT templates that take more than 1/4 second to build*
3299    128 - Outputs app-level request/response information to STDERR.
3300
3301These can be combined, so if you want to display queries and debug messages,
3302use a DebugMode of 5 for instance.
3303
3304You may also use the local statement to temporarily apply a particular bit,
3305if you want to scope the debug messages you receive to a block of code:
3306
3307    local $MT::DebugMode |= 4;  # show me the queries for the following
3308    my $obj = MT::Entry->load({....});
3309
3310*DebugMode bit 8 actually outputs it's messages to STDERR (which typically
3311is sent to your web server's error log).
3312
3313=head1 CALLBACKS
3314
3315Movable Type has a variety of hook points at which a plugin can attach
3316a callback.
3317
3318In each case, the first parameter is an L<MT::Callback> object which
3319can be used to pass error information back to the caller.
3320
3321The app-level callbacks related to rebuilding are documented
3322in L<MT::WeblogPublisher>. The specific apps document the callbacks
3323which they invoke.
3324
3325=head2 NewUserProvisioning($cb, $user)
3326
3327This callback is invoked when a user is being added to Movable Type.
3328Movable Type itself registers for this callback (with a priority of 5)
3329to provision the user with a new weblog if the system has been configured
3330to do so.
3331
3332=head1 LICENSE
3333
3334The license that applies is the one you agreed to when downloading
3335Movable Type.
3336
3337=head1 AUTHOR & COPYRIGHT
3338
3339Except where otherwise noted, MT is Copyright 2001-2008 Six Apart.
3340All rights reserved.
3341
3342=cut
Note: See TracBrowser for help on using the browser.