root/branches/release-38/lib/MT.pm.pre @ 2246

Revision 2246, 105.9 kB (checked in by fumiakiy, 19 months ago)

Added post_init callback. The callback is invoked when MT is initialized and addons and plugins are loaded. See POD for the signature. BugId:79507
  • 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    require File::Spec;
918    my $dir = MT->config('PerformanceLoggingPath') or return;
919
920    my @time = localtime(time);
921    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
922    my $log_file = File::Spec->catfile( $dir, $file );
923
924    my $first_write = ! -f $log_file;
925
926    local *PERFLOG;
927    open PERFLOG, ">>$log_file";
928    require Fcntl;
929    flock(PERFLOG, Fcntl::LOCK_EX());
930
931    if ($first_write) {
932        require Config;
933        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
934        print PERFLOG "# Operating System: $osname/$osvers\n";
935        print PERFLOG "# Platform: $^O\n";
936        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
937        print PERFLOG "# Perl Version: $ver\n";
938        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
939        require MT::Object;
940        my $driver = MT::Object->driver;
941        if ($driver) {
942            my $dbh = $driver->r_handle;
943            if ($dbh) {
944                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
945                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
946                if ($dbname && $dbver) {
947                    print PERFLOG "# Database: $dbname/$dbver\n";
948                }
949            }
950        }
951        my ($drname, $drh) = each %DBI::installed_drh;
952        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
953        if ($ENV{MOD_PERL}) {
954            print PERFLOG "# App Mode: mod_perl\n";
955        }
956        elsif ($ENV{FAST_CGI}) {
957            print PERFLOG "# App Mode: FastCGI\n";
958        }
959        else {
960            print PERFLOG "# App Mode: CGI\n";
961        }
962    }
963
964    if ($memory) {
965        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
966    } else {
967        print PERFLOG $timer->dump_line();
968    }
969
970    close PERFLOG;
971}
972}
973
974sub get_timer {
975    my $mt = shift;
976    $mt = MT->instance unless ref $mt;
977    my $timer = $mt->request('timer');
978    unless (defined $timer) {
979        if (MT->config('PerformanceLogging')) {
980            my $uri;
981            if ($mt->isa('MT::App')) {
982                $uri = $mt->uri( args => { $mt->param_hash } );
983            }
984            require MT::Util::ReqTimer;
985            $timer = MT::Util::ReqTimer->new( $uri );
986        } else {
987            $timer = 0;
988        }
989        $mt->request('timer', $timer);
990    }
991    return $timer;
992}
993
994sub time_this {
995    my $mt = shift;
996    my ($str, $code) = @_;
997    my $timer = $mt->get_timer();
998    my $ret;
999    if ($timer) {
1000        $timer->pause_partial();
1001        $ret = $code->();
1002        $timer->mark($str);
1003    } else {
1004        $ret = $code->();
1005    }
1006    return $ret;
1007}
1008
1009sub init_config_from_db {
1010    my $mt = shift;
1011    my ($param) = @_;
1012    my $cfg = $mt->config;
1013    $cfg->read_config_db();
1014
1015    # Tell any instantiated drivers to reconfigure themselves as necessary
1016    MT::ObjectDriverFactory->configure;
1017
1018    1;
1019}
1020
1021sub bootstrap {
1022    my $pkg = shift;
1023    $pkg->init_paths() or return;
1024    $pkg->init_core()  or return;
1025}
1026
1027sub init_paths {
1028    my $mt = shift;
1029    my ($param) = @_;
1030
1031    # determine MT directory
1032    my ($orig_dir);
1033    require File::Spec;
1034    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1035        if ( $0 =~ m!(.*([/\\]))! ) {
1036            $orig_dir = $MT_DIR = $1;
1037            my $slash = $2;
1038            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1039            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1040        }
1041        else {
1042
1043            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1044            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1045        }
1046        unless ($MT_DIR) {
1047            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1048            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1049        }
1050        $ENV{MT_HOME} = $MT_DIR;
1051    }
1052    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1053    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1054      if $orig_dir && ( $orig_dir ne $MT_DIR );
1055
1056    $mt->set_language('__BUILD_LANGUAGE__');
1057
1058    if ( my $cfg_file = $mt->find_config($param) ) {
1059        $cfg_file = File::Spec->rel2abs($cfg_file);
1060        $CFG_FILE = $cfg_file;
1061    }
1062    else {
1063        return $mt->trans_error(
1064"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1065        ) if ref($mt);
1066    }
1067
1068    # store the mt_dir (home) as an absolute path; fallback to the config
1069    # directory if it isn't set.
1070    $MT_DIR ||=
1071      $param->{directory}
1072      ? File::Spec->rel2abs( $param->{directory} )
1073      : $CFG_DIR;
1074    $MT_DIR ||= dirname($0);
1075
1076    # also make note of the active application path; this is derived by
1077    # checking the PWD environment variable, the dirname of $0,
1078    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1079    $APP_DIR = $ENV{PWD} || "";
1080    $APP_DIR = dirname($0)
1081      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1082    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1083      if $ENV{SCRIPT_FILENAME}
1084      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1085    $APP_DIR ||= $MT_DIR;
1086    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1087
1088    return 1;
1089}
1090
1091sub init_core {
1092    my $mt = shift;
1093    return if exists $Components{'core'};
1094    require MT::Core;
1095    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1096      or die MT::Core->errstr;
1097    $Components{'core'} = $c;
1098
1099    # Additional locale-specific defaults
1100    my $defaults = $c->{registry}{config_settings};
1101    $defaults->{DefaultLanguage}{default} = '__BUILD_LANGUAGE__';
1102    $defaults->{NewsboxURL}{default} = '__NEWSBOX_URL__';
1103    $defaults->{LearningNewsURL}{default} = '__LEARNINGNEWS_URL__';
1104    $defaults->{SupportURL}{default} = '__SUPPORT_URL__';
1105    $defaults->{NewsURL}{default} = '__NEWS_URL__';
1106    #$defaults->{HelpURL}{default} = '__HELP_URL__';
1107    $defaults->{DefaultTimezone}{default} = '__DEFAULT_TIMEZONE__';
1108    $defaults->{TimeOffset}{default} = '__DEFAULT_TIMEZONE__';
1109    $defaults->{MailEncoding}{default} = '__MAIL_ENCODING__';
1110    $defaults->{ExportEncoding}{default} = '__EXPORT_ENCODING__';
1111    $defaults->{LogExportEncoding}{default} = '__LOG_EXPORT_ENCODING__';
1112    $defaults->{CategoryNameNodash}{default} = '__CATEGORY_NAME_NODASH__';
1113    $defaults->{PublishCharset}{default} = '__PUBLISH_CHARSET__';
1114
1115    push @Components, $c;
1116    return 1;
1117}
1118
1119sub init {
1120    my $mt    = shift;
1121    my %param = @_;
1122
1123    $mt->bootstrap() unless $MT_DIR;
1124    $mt->{mt_dir}     = $MT_DIR;
1125    $mt->{config_dir} = $CFG_DIR;
1126    $mt->{app_dir}    = $APP_DIR;
1127
1128    $mt->init_callbacks();
1129
1130    ## Initialize the language to the default in case any errors occur in
1131    ## the rest of the initialization process.
1132    $mt->init_config( \%param ) or return;
1133    $mt->init_addons(@_)       or return;
1134    $mt->init_config_from_db( \%param ) or return;
1135    $mt->init_plugins(@_)       or return;
1136    $plugins_installed = 1;
1137    $mt->init_schema();
1138    $mt->init_permissions();
1139
1140    # Load MT::Log so constants are available
1141    require MT::Log;
1142
1143    $mt->run_callbacks('post_init', $mt, \%param);
1144    return $mt;
1145}
1146
1147sub init_callbacks {
1148    my $mt = shift;
1149    MT->_register_core_callbacks({
1150        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1151        'cms_upload_file' => \&core_upload_file_to_sync,
1152        'api_upload_file' => \&core_upload_file_to_sync,
1153    });
1154}
1155
1156sub core_upload_file_to_sync {
1157    my ($cb, %args) = @_;
1158    MT->upload_file_to_sync(%args);
1159}
1160
1161sub upload_file_to_sync {
1162    my $class = shift;
1163    my (%args) = @_;
1164
1165    # no need to do this unless we're syncing stuff.
1166    return unless MT->config('SyncTarget');
1167
1168    my $url = $args{url};
1169    my $file = $args{file};
1170    return unless -f $file;
1171
1172    my $blog = $args{blog};
1173    my $blog_id = $blog->id;
1174    return unless $blog->publish_queue;
1175
1176    require MT::FileInfo;
1177    my $base_url = $url;
1178    $base_url =~ s!^https?://[^/]+!!;
1179    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1180    if (!$fi) {
1181        $fi = new MT::FileInfo;
1182        $fi->blog_id($blog_id);
1183        $fi->url($base_url);
1184        $fi->file_path($file);
1185    } else {
1186        $fi->file_path($file);
1187    }
1188    $fi->save;
1189
1190    require MT::TheSchwartz;
1191    require TheSchwartz::Job;
1192    my $job = TheSchwartz::Job->new();
1193    $job->funcname('MT::Worker::Sync');
1194    $job->uniqkey( $fi->id );
1195    $job->coalesce( ( $fi->blog_id || 0 ) . ':' . $$ . ':' . ( time - ( time % 10 ) ) );
1196    MT::TheSchwartz->insert($job);
1197}
1198
1199sub init_addons {
1200    my $mt = shift;
1201    my $cfg = $mt->config;
1202    my @PluginPaths;
1203
1204    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1205    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1206}
1207
1208sub init_plugins {
1209    my $mt = shift;
1210
1211    # Load compatibility module for prior version
1212    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1213    require MT::Compat::v3;
1214
1215    require MT::Plugin;
1216    my $cfg          = $mt->config;
1217    my $use_plugins  = $cfg->UsePlugins;
1218    my @PluginPaths  = $cfg->PluginPath;
1219    my $PluginSwitch = $cfg->PluginSwitch || {};
1220    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1221}
1222
1223sub _init_plugins_core {
1224    my $mt = shift;
1225    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1226
1227    my $timer;
1228    if ($mt->config->PerformanceLogging) {
1229        $timer = $mt->get_timer();
1230    }
1231
1232    foreach my $PluginPath (@$PluginPaths) {
1233        my $plugin_lastdir = $PluginPath;
1234        $plugin_lastdir =~ s![\\/]$!!;
1235        $plugin_lastdir =~ s!.*[\\/]!!;
1236        local *DH;
1237        if ( opendir DH, $PluginPath ) {
1238            my @p = readdir DH;
1239          PLUGIN:
1240            for my $plugin (@p) {
1241                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1242
1243                my $load_plugin = sub {
1244                    my ( $plugin, $sig ) = @_;
1245                    die "Bad plugin filename '$plugin'"
1246                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1247                    local $plugin_sig      = $sig;
1248                    local $plugin_registry = {};
1249                    $plugin = $1;
1250                    if (
1251                        !$use_plugins
1252                        || ( exists $PluginSwitch->{$plugin_sig}
1253                            && !$PluginSwitch->{$plugin_sig} )
1254                      )
1255                    {
1256                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1257                        $Plugins{$plugin_sig}{enabled}   = 0;
1258                        return 0;
1259                    }
1260                    return 0 if exists $Plugins{$plugin_sig};
1261                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1262                    $timer->pause_partial if $timer;
1263                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire '$plugin';";
1264                    $timer->mark("Loaded plugin " . $sig) if $timer;
1265                    if ($@) {
1266                        $Plugins{$plugin_sig}{error} = $@;
1267                        # Issue MT log within another eval block in the
1268                        # event that the plugin error is happening before
1269                        # the database has been initialized...
1270                        eval {
1271                            # line __LINE__ __FILE__
1272                            require MT::Log;
1273                            $mt->log(
1274                                {
1275                                    message => $mt->translate(
1276                                        "Plugin error: [_1] [_2]", $plugin,
1277                                        $Plugins{$plugin_sig}{error}
1278                                    ),
1279                                    class => 'system',
1280                                    level => MT::Log::ERROR()
1281                                }
1282                            );
1283                        };
1284                        return 0;
1285                    }
1286                    else {
1287                        if ( my $obj = $Plugins{$plugin_sig}{object} ) {
1288                            $obj->init_callbacks();
1289                        }
1290                        else {
1291
1292                            # A plugin did not register itself, so
1293                            # create a dummy plugin object which will
1294                            # cause it to show up in the plugin listing
1295                            # by it's filename.
1296                            MT->add_plugin( {} );
1297                        }
1298                    }
1299                    $Plugins{$plugin_sig}{enabled} = 1;
1300                    return 1;
1301                };
1302                $plugin_full_path = File::Spec->catfile( $PluginPath, $plugin );
1303                if ( -f $plugin_full_path ) {
1304                    $plugin_envelope = $plugin_lastdir;
1305                    $load_plugin->( $plugin_full_path, $plugin )
1306                      if $plugin_full_path =~ /\.pl$/;
1307                }
1308                else {
1309                    my $plugin_dir = $plugin;
1310                    $plugin_envelope = "$plugin_lastdir/" . $plugin;
1311
1312                    # handle config.yaml
1313                    my $yaml =
1314                      File::Spec->catdir( $plugin_full_path, 'config.yaml' );
1315                    my $libdir;
1316                    ( unshift @INC, $libdir )
1317                      if -d ( $libdir =
1318                          File::Spec->catdir( $plugin_full_path, 'lib' ) );
1319                    if ( -f $yaml ) {
1320                        my $pclass =
1321                          $plugin_dir =~ m/\.pack$/
1322                          ? 'MT::Component'
1323                          : 'MT::Plugin';
1324
1325                        # Don't process disabled plugin config.yaml files.
1326                        if (
1327                            $pclass eq 'MT::Plugin'
1328                            && (
1329                                !$use_plugins
1330                                || ( exists $PluginSwitch->{$plugin_dir}
1331                                    && !$PluginSwitch->{$plugin_dir} )
1332                            )
1333                          )
1334                        {
1335                            $Plugins{$plugin_dir}{full_path} =
1336                              $plugin_full_path;
1337                            $Plugins{$plugin_dir}{enabled} = 0;
1338                            next;
1339                        }
1340                        my $id = lc $plugin_dir;
1341                        $id =~ s/\.\w+$//;
1342                        my $p = $pclass->new(
1343                            {
1344                                id       => $id,
1345                                path     => $plugin_full_path,
1346                                envelope => $plugin_envelope
1347                            }
1348                        );
1349
1350                        # rebless? based on config?
1351                        local $plugin_sig = $plugin_dir;
1352                        MT->add_plugin($p);
1353                        $p->init_callbacks()
1354                            if $pclass eq 'MT::Plugin';
1355                        next;
1356                    }
1357
1358                    opendir SUBDIR, $plugin_full_path;
1359                    my @plugins = readdir SUBDIR;
1360                    closedir SUBDIR;
1361                    for my $plugin (@plugins) {
1362                        next if $plugin !~ /\.pl$/;
1363                        my $plugin_file =
1364                          File::Spec->catfile( $plugin_full_path, $plugin );
1365                        if ( -f $plugin_file ) {
1366                            $load_plugin->(
1367                                $plugin_file, $plugin_dir . '/' . $plugin
1368                            );
1369                        }
1370                    }
1371                }
1372            }
1373            closedir DH;
1374        }
1375    }
1376
1377    # Reset the Text_filters hash in case it was preloaded by plugins by
1378    # calling all_text_filters (Markdown in particular does this).
1379    # Upon calling all_text_filters again, it will be properly loaded by
1380    # querying the registry.
1381    %Text_filters = ();
1382
1383    1;
1384}
1385
1386my %addons;
1387
1388sub find_addons {
1389    my $mt = shift;
1390    my ($type) = @_;
1391
1392    unless (%addons) {
1393        my $addon_path = File::Spec->catdir( $MT_DIR, 'addons' );
1394        local *DH;
1395        if ( opendir DH, $addon_path ) {
1396            my @p = readdir DH;
1397            foreach my $p (@p) {
1398                next if $p eq '.' || $p eq '..';
1399                my $full_path = File::Spec->catdir( $addon_path, $p );
1400                if ( -d $full_path ) {
1401                    if ( $p =~ m/^(.+)\.(\w+)$/ ) {
1402                        my $label = $1;
1403                        my $id    = lc $1;
1404                        my $type  = $2;
1405                        if ( $type eq 'pack' ) {
1406                            $label .= ' Pack';
1407                        }
1408                        elsif ( $type eq 'theme' ) {
1409                            $label .= ' Theme';
1410                        }
1411                        elsif ( $type eq 'plugin' ) {
1412                            $label .= ' Plugin';
1413                        }
1414                        push @{ $addons{$type} },
1415                          {
1416                            label    => $label,
1417                            id       => $id,
1418                            envelope => 'addons/' . $p . '/',
1419                            path     => $full_path,
1420                          };
1421                    }
1422                }
1423            }
1424        }
1425    }
1426    if ($type) {
1427        my $addons = $addons{$type} ||= [];
1428        return $addons;
1429    }
1430    return 1;
1431}
1432
1433*mt_dir = \&server_path;
1434sub server_path { $_[0]->{mt_dir} }
1435sub app_dir     { $_[0]->{app_dir} }
1436sub config_dir  { $_[0]->{config_dir} }
1437
1438sub component {
1439    my $mt = shift;
1440    my ($id) = @_;
1441    return $Components{ lc $id };
1442}
1443
1444sub publisher {
1445    my $mt = shift;
1446    $mt = $mt->instance unless ref $mt;
1447    unless ( $mt->{WeblogPublisher} ) {
1448        require MT::WeblogPublisher;
1449        $mt->{WeblogPublisher} = new MT::WeblogPublisher();
1450    }
1451    $mt->{WeblogPublisher};
1452}
1453
1454sub rebuild {
1455    my $mt = shift;
1456    $mt->publisher->rebuild(@_)
1457      or return $mt->error( $mt->publisher->errstr );
1458}
1459
1460sub rebuild_entry {
1461    my $mt = shift;
1462    $mt->publisher->rebuild_entry(@_)
1463      or return $mt->error( $mt->publisher->errstr );
1464}
1465
1466sub rebuild_indexes {
1467    my $mt = shift;
1468    $mt->publisher->rebuild_indexes(@_)
1469      or return $mt->error( $mt->publisher->errstr );
1470}
1471
1472sub rebuild_archives {
1473    my $mt = shift;
1474    $mt->publisher->rebuild_archives(@_)
1475      or return $mt->error( $mt->publisher->errstr );
1476}
1477
1478sub ping {
1479    my $mt    = shift;
1480    my %param = @_;
1481    my $blog;
1482    require MT::Entry;
1483    require MT::Util;
1484    unless ( $blog = $param{Blog} ) {
1485        my $blog_id = $param{BlogID};
1486        $blog = MT::Blog->load($blog_id)
1487          or return $mt->trans_error( "Load of blog '[_1]' failed: [_2]",
1488            $blog_id, MT::Blog->errstr );
1489    }
1490
1491    my (@res);
1492
1493    my $send_updates = 1;
1494    if ( exists $param{OldStatus} ) {
1495        ## If this is a new entry (!$old_status) OR the status was previously
1496        ## set to draft, and is now set to publish, send the update pings.
1497        my $old_status = $param{OldStatus};
1498        if ( $old_status && $old_status eq MT::Entry::RELEASE() ) {
1499            $send_updates = 0;
1500        }
1501    }
1502
1503    if ( $send_updates && !( MT->config->DisableNotificationPings ) ) {
1504        ## Send update pings.
1505        my @updates = $mt->update_ping_list($blog);
1506        for my $url (@updates) {
1507            require MT::XMLRPC;
1508            if ( MT::XMLRPC->ping_update( 'weblogUpdates.ping', $blog, $url ) )
1509            {
1510                push @res, { good => 1, url => $url, type => "update" };
1511            }
1512            else {
1513                push @res,
1514                  {
1515                    good  => 0,
1516                    url   => $url,
1517                    type  => "update",
1518                    error => MT::XMLRPC->errstr
1519                  };
1520            }
1521        }
1522        if ( $blog->mt_update_key ) {
1523            require MT::XMLRPC;
1524            if ( MT::XMLRPC->mt_ping($blog) ) {
1525                push @res,
1526                  {
1527                    good => 1,
1528                    url  => $mt->{cfg}->MTPingURL,
1529                    type => "update"
1530                  };
1531            }
1532            else {
1533                push @res,
1534                  {
1535                    good  => 0,
1536                    url   => $mt->{cfg}->MTPingURL,
1537                    type  => "update",
1538                    error => MT::XMLRPC->errstr
1539                  };
1540            }
1541        }
1542    }
1543
1544    my $cfg     = $mt->{cfg};
1545    my $send_tb = $cfg->OutboundTrackbackLimit;
1546    return \@res if $send_tb eq 'off';
1547
1548    my @tb_domains;
1549    if ( $send_tb eq 'selected' ) {
1550        @tb_domains = $cfg->OutboundTrackbackDomains;
1551    }
1552    elsif ( $send_tb eq 'local' ) {
1553        my $iter = MT::Blog->load_iter();
1554        while ( my $b = $iter->() ) {
1555            next if $b->id == $blog->id;
1556            push @tb_domains, MT::Util::extract_domains( $b->site_url );
1557        }
1558    }
1559    my $tb_domains;
1560    if (@tb_domains) {
1561        $tb_domains = '';
1562        my %seen;
1563        local $_;
1564        foreach (@tb_domains) {
1565            next unless $_;
1566            $_ = lc($_);
1567            next if $seen{$_};
1568            $tb_domains .= '|' if $tb_domains ne '';
1569            $tb_domains .= quotemeta($_);
1570            $seen{$_} = 1;
1571        }
1572        $tb_domains = '(' . $tb_domains . ')' if $tb_domains;
1573    }
1574
1575    ## Send TrackBack pings.
1576    if ( my $entry = $param{Entry} ) {
1577        my $pings = $entry->to_ping_url_list;
1578
1579        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1580        my $cats = $entry->categories;
1581        for my $cat (@$cats) {
1582            push @$pings, grep !$pinged{$_}, @{ $cat->ping_url_list };
1583        }
1584
1585        my $ua = MT->new_ua;
1586
1587        ## Build query string to be sent on each ping.
1588        my @qs;
1589        push @qs, 'title=' . MT::Util::encode_url( $entry->title );
1590        push @qs, 'url=' . MT::Util::encode_url( $entry->permalink );
1591        push @qs, 'excerpt=' . MT::Util::encode_url( $entry->get_excerpt );
1592        push @qs, 'blog_name=' . MT::Util::encode_url( $blog->name );
1593        my $qs = join '&', @qs;
1594
1595        ## Character encoding--best guess.
1596        my $enc = $mt->{cfg}->PublishCharset;
1597
1598        for my $url (@$pings) {
1599            $url =~ s/^\s*//;
1600            $url =~ s/\s*$//;
1601            my $url_domain;
1602            ($url_domain) = MT::Util::extract_domains($url);
1603            next if $tb_domains && lc($url_domain) !~ m/$tb_domains$/;
1604
1605            my $req = HTTP::Request->new( POST => $url );
1606            $req->content_type(
1607                "application/x-www-form-urlencoded; charset=$enc");
1608            $req->content($qs);
1609            my $res = $ua->request($req);
1610            if ( substr( $res->code, 0, 1 ) eq '2' ) {
1611                my $c = $res->content;
1612                my ( $error, $msg ) =
1613                  $c =~ m!<error>(\d+).*<message>(.+?)</message>!s;
1614                if ($error) {
1615                    push @res,
1616                      {
1617                        good  => 0,
1618                        url   => $url,
1619                        type  => 'trackback',
1620                        error => $msg
1621                      };
1622                }
1623                else {
1624                    push @res, { good => 1, url => $url, type => 'trackback' };
1625                }
1626            }
1627            else {
1628                push @res,
1629                  {
1630                    good  => 0,
1631                    url   => $url,
1632                    type  => 'trackback',
1633                    error => "HTTP error: " . $res->status_line
1634                  };
1635            }
1636        }
1637    }
1638    \@res;
1639}
1640
1641sub ping_and_save {
1642    my $mt    = shift;
1643    my %param = @_;
1644    if ( my $entry = $param{Entry} ) {
1645        my $results = MT::ping( $mt, @_ ) or return;
1646        my %still_ping;
1647        my $pinged = $entry->pinged_url_list;
1648        for my $res (@$results) {
1649            next if $res->{type} ne 'trackback';
1650            if ( !$res->{good} ) {
1651                $still_ping{ $res->{url} } = 1;
1652            }
1653            push @$pinged,
1654              $res->{url}
1655              . ( $res->{good}
1656                ? ''
1657                : ' ' . MT::I18N::encode_text( $res->{error} ) );
1658        }
1659        $entry->pinged_urls( join "\n", @$pinged );
1660        $entry->to_ping_urls( join "\n", keys %still_ping );
1661        $entry->save or return $mt->error( $entry->errstr );
1662        return $results;
1663    }
1664    1;
1665}
1666
1667sub needs_ping {
1668    my $mt    = shift;
1669    my %param = @_;
1670    my $blog  = $param{Blog};
1671    my $entry = $param{Entry};
1672    require MT::Entry;
1673    return unless $entry->status == MT::Entry::RELEASE();
1674    my $old_status = $param{OldStatus};
1675    my %list;
1676    ## If this is a new entry (!$old_status) OR the status was previously
1677    ## set to draft, and is now set to publish, send the update pings.
1678    if ( ( !$old_status || $old_status ne MT::Entry::RELEASE() )
1679        && !( MT->config->DisableNotificationPings ) )
1680    {
1681        my @updates = $mt->update_ping_list($blog);
1682        @list{@updates} = (1) x @updates;
1683        $list{ $mt->{cfg}->MTPingURL } = 1 if $blog && $blog->mt_update_key;
1684    }
1685    if ($entry) {
1686        @list{ @{ $entry->to_ping_url_list } } = ();
1687        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1688        my $cats = $entry->categories;
1689        for my $cat (@$cats) {
1690            @list{ grep !$pinged{$_}, @{ $cat->ping_url_list } } = ();
1691        }
1692    }
1693    my @list = keys %list;
1694    return unless @list;
1695    \@list;
1696}
1697
1698sub update_ping_list {
1699    my $mt = shift;
1700    my ($blog) = @_;
1701
1702    my @updates;
1703    if ( my $pings = MT->registry('ping_servers') ) {
1704        my $up = $blog->update_pings;
1705        if ($up) {
1706            foreach ( split ',', $up ) {
1707                next unless exists $pings->{$_};
1708                push @updates, $pings->{$_}->{url};
1709            }
1710        }
1711    }
1712    if ( my $others = $blog->ping_others ) {
1713        push @updates, split /\r?\n/, $others;
1714    }
1715    my %updates;
1716    for my $url (@updates) {
1717        for ($url) {
1718            s/^\s*//;
1719            s/\s*$//;
1720        }
1721        next unless $url =~ /\S/;
1722        $updates{$url}++;
1723    }
1724    keys %updates;
1725}
1726
1727{
1728    my $LH;
1729
1730    sub set_language {
1731        my $pkg = shift;
1732        require MT::L10N;
1733        $LH = MT::L10N->get_handle(@_);
1734
1735        # Clear any l10n_handles in request
1736        $pkg->request( 'l10n_handle', {} );
1737        return $LH;
1738    }
1739
1740    require MT::I18N;
1741
1742    sub translate {
1743        my $this = shift;
1744        my $app = ref($this) ? $this : $this->app;
1745        if ( $app->{component} ) {
1746            if ( my $c = $app->component( $app->{component} ) ) {
1747                local $app->{component} = undef;
1748                return $c->translate(@_);
1749            }
1750        }
1751        my ( $format, @args ) = @_;
1752        foreach (@args) {
1753            $_ = $_->() if ref($_) eq 'CODE';
1754        }
1755        my $enc = MT->instance->config('PublishCharset') || 'utf-8';
1756        return $LH->maketext( $format, @args ) if $enc =~ m/utf-?8/i;
1757        $format = MT::I18N::encode_text( $format, $enc, 'utf-8' );
1758        MT::I18N::encode_text(
1759            $LH->maketext(
1760                $format,
1761                map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
1762            ),
1763            'utf-8', $enc
1764        );
1765    }
1766
1767    sub translate_templatized {
1768        my $mt = shift;
1769        my $app = ref($mt) ? $mt : $mt->app;
1770        if ( $app->{component} ) {
1771            if ( my $c = $app->component( $app->{component} ) ) {
1772                local $app->{component} = undef;
1773                return $c->translate_templatized(@_);
1774            }
1775        }
1776        my @cstack;
1777        my ($text) = @_;
1778        while (1) {
1779            $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
1780            my($msg, $close, $section, %args) = ($1, $2, $3);
1781            while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
1782                $args{$1} = $3;
1783            }
1784            if ($section) {
1785                if ($close) {
1786                    $mt = pop @cstack;
1787                } else {
1788                    if ($args{component}) {
1789                        push @cstack, $mt;
1790                        $mt = MT->component($args{component})
1791                            or die "Bad translation component: $args{component}";
1792                    }
1793                    else {
1794                        die "__trans_section without a component argument";
1795                    }
1796                }
1797                '';
1798            }
1799            else {
1800                $args{params} = '' unless defined $args{params};
1801                my @p = map MT::Util::decode_html($_),
1802                        split /\s*%%\s*/, $args{params}, -1;
1803                @p = ('') unless @p;
1804                my $translation = $mt->translate($args{phrase}, @p);
1805                if (exists $args{escape}) {
1806                    if (lc($args{escape}) eq 'html') {
1807                        $translation = MT::Util::encode_html($translation);
1808                    } elsif (lc($args{escape}) eq 'url') {
1809                        $translation = MT::Util::encode_url($translation);
1810                    } else {
1811                        # fallback for js/javascript/singlequotes
1812                        $translation = MT::Util::encode_js($translation);
1813                    }
1814                }
1815                $translation;
1816            }
1817            !igem or last;
1818        }
1819        return $text;
1820    }
1821
1822    sub current_language { $LH->language_tag }
1823    sub language_handle  { $LH }
1824
1825    sub charset {
1826        my $mt = shift;
1827        $mt->{charset} = shift if @_;
1828        return $mt->{charset} if $mt->{charset};
1829        $mt->{charset} = $mt->config->PublishCharset
1830          || $mt->language_handle->encoding;
1831    }
1832}
1833
1834sub supported_languages {
1835    my $mt = shift;
1836    require MT::L10N;
1837    require File::Basename;
1838    ## Determine full path to lib/MT/L10N directory...
1839    my $lib =
1840      File::Spec->catdir( File::Basename::dirname( $INC{'MT/L10N.pm'} ),
1841        'L10N' );
1842    ## ... From that, determine full path to extlib/MT/L10N.
1843    ## To do that, we look for the last instance of the string 'lib'
1844    ## in $lib and replace it with 'extlib'. reverse is a nice tricky
1845    ## way of doing that.
1846    ( my $extlib = reverse $lib ) =~ s!bil!biltxe!;
1847    $extlib = reverse $extlib;
1848    my @dirs = ( $lib, $extlib );
1849    my %langs;
1850    for my $dir (@dirs) {
1851        opendir DH, $dir or next;
1852        for my $f ( readdir DH ) {
1853            my ($tag) = $f =~ /^(\w+)\.pm$/;
1854            next unless $tag;
1855            my $lh = MT::L10N->get_handle($tag);
1856            $langs{ $lh->language_tag } = $lh->language_name;
1857        }
1858        closedir DH;
1859    }
1860    \%langs;
1861}
1862
1863# For your convenience
1864sub trans_error {
1865    my $app = shift;
1866    $app->error( $app->translate(@_) );
1867}
1868
1869sub all_text_filters {
1870    unless (%Text_filters) {
1871        if ( my $filters = MT->registry('text_filters') ) {
1872            %Text_filters = %$filters if ref($filters) eq 'HASH';
1873        }
1874    }
1875    if (my $enabled_filters = MT->config('AllowedTextFilters')) {
1876        my %enabled = map { $_ => 1 } split /\s*,\s*/, $enabled_filters;
1877        %Text_filters = map { $_ => $Text_filters{$_} }
1878                        grep { exists $enabled{$_} }
1879                        keys %Text_filters;
1880    }
1881    return \%Text_filters;
1882}
1883
1884sub apply_text_filters {
1885    my $mt = shift;
1886    my ( $str, $filters, @extra ) = @_;
1887    my $all_filters = $mt->all_text_filters;
1888    for my $filter (@$filters) {
1889        my $f = $all_filters->{$filter} or next;
1890        my $code = $f->{code} || $f->{handler};
1891        unless ( ref($code) eq 'CODE' ) {
1892            $code = $mt->handler_to_coderef($code);
1893            $f->{code} = $code;
1894        }
1895        if ( !$code ) {
1896            warn "Bad text filter: $filter";
1897            next;
1898        }
1899        $str = $code->( $str, @extra );
1900    }
1901    return $str;
1902}
1903
1904sub static_path {
1905    my $app = shift;
1906    my $spath = $app->config->StaticWebPath;
1907    if (!$spath) {
1908        $spath = $app->config->CGIPath;
1909        $spath .= '/' unless $spath =~ m!/$!;
1910        $spath .= 'mt-static/';
1911    } else {
1912        $spath .= '/' unless $spath =~ m!/$!;
1913    }
1914    $spath;
1915}
1916
1917sub static_file_path {
1918    my $app = shift;
1919    return $app->{__static_file_path}
1920        if exists $app->{__static_file_path};
1921
1922    my $path = $app->config('StaticFilePath');
1923    return $app->{__static_file_path} = $path if defined $path;
1924
1925    # Attempt to derive StaticFilePath based on environment
1926    my $web_path = $app->config->StaticWebPath || 'mt-static';
1927    $web_path =~ s!^https?://[^/]+/!!;
1928    if ($app->can('document_root')) {
1929        my $doc_static_path = File::Spec->catdir($app->document_root(), $web_path);
1930        return $app->{__static_file_path} = $doc_static_path
1931            if -d $doc_static_path;
1932    }
1933    my $mtdir_static_path = File::Spec->catdir($app->mt_dir, 'mt-static');
1934    return $app->{__static_file_path} = $mtdir_static_path
1935        if -d $mtdir_static_path;
1936    return;
1937}
1938
1939sub template_paths {
1940    my $mt = shift;
1941    my @paths;
1942    my $path = $mt->config->TemplatePath;
1943    if ($mt->{plugin_template_path}) {
1944        if (File::Spec->file_name_is_absolute($mt->{plugin_template_path})) {
1945            push @paths, $mt->{plugin_template_path}
1946                if -d $mt->{plugin_template_path};
1947        } else {
1948            my $dir = File::Spec->catdir($mt->app_dir,
1949                                         $mt->{plugin_template_path});
1950            if (-d $dir) {
1951                push @paths, $dir;
1952            } else {
1953                $dir = File::Spec->catdir($mt->mt_dir,
1954                                          $mt->{plugin_template_path});
1955                push @paths, $dir if -d $dir;
1956            }
1957        }
1958    }
1959    if (my $alt_path = $mt->config->AltTemplatePath) {
1960        if (-d $alt_path) {    # AltTemplatePath is absolute
1961            push @paths, File::Spec->catdir($alt_path,
1962                                            $mt->{template_dir})
1963                if $mt->{template_dir};
1964            push @paths, $alt_path;
1965        }
1966    }
1967 
1968    for my $addon ( @{ $mt->find_addons('pack') } ) {
1969        push @paths, File::Spec->catdir($addon->{path}, 'tmpl', $mt->{template_dir})
1970            if $mt->{template_dir};
1971        push @paths, File::Spec->catdir($addon->{path}, 'tmpl');
1972    }
1973
1974    push @paths, File::Spec->catdir($path, $mt->{template_dir})
1975        if $mt->{template_dir};
1976    push @paths, $path;
1977 
1978    return @paths;
1979}
1980
1981sub find_file {
1982    my $mt = shift;
1983    my ($paths, $file) = @_;
1984    my $filename;
1985    foreach my $p (@$paths) {
1986        my $filepath = File::Spec->canonpath(File::Spec->catfile($p, $file));
1987        $filename = File::Spec->canonpath($filepath);
1988        return $filename if -f $filename;
1989    }
1990    undef;
1991}
1992
1993sub load_tmpl {
1994    my $mt = shift;
1995    if ( exists($mt->{component}) && ( $mt->{component} ne 'Core' ) ) {
1996        if (my $c = $mt->component($mt->{component})) {
1997            return $c->load_tmpl(@_);
1998        }
1999    }
2000
2001    my($file, @p) = @_;
2002    my $param;
2003    if (@p && (ref($p[$#p]) eq 'HASH')) {
2004        $param = pop @p;
2005    }
2006    my $cfg = $mt->config;
2007    require MT::Template;
2008    my $tmpl;
2009    my @paths = $mt->template_paths;
2010
2011    my $type = {'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref'}->{ref $file}
2012        || 'filename';
2013    $tmpl = MT::Template->new(
2014        type => $type, source => $file,
2015        path => \@paths,
2016        filter => sub {
2017            my ($str, $fname) = @_;
2018            if ($fname) {
2019                $fname = File::Basename::basename($fname);
2020                $fname =~ s/\.tmpl$//;
2021                $mt->run_callbacks("template_source.$fname", $mt, @_);
2022            } else {
2023                $mt->run_callbacks("template_source", $mt, @_);
2024            }
2025            return $str;
2026        },
2027        @p);
2028    return $mt->error(
2029        $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
2030    $mt->set_default_tmpl_params($tmpl);
2031    $tmpl->param($param) if $param;
2032    $tmpl;
2033}
2034
2035sub set_default_tmpl_params {
2036    my $mt = shift;
2037    my ($tmpl) = @_;
2038    my $param = {};
2039    $param->{mt_debug} = $MT::DebugMode;
2040    $param->{mt_beta} = 1 if MT->version_id =~ m/^\d+\.\d+(?:a|b|rc)/;
2041    $param->{static_uri} = $mt->static_path;
2042    $param->{mt_version} = MT->version_number;
2043    $param->{mt_version_id} = MT->version_id;
2044    $param->{mt_product_code} = MT->product_code;
2045    $param->{mt_product_name} = $mt->translate(MT->product_name);
2046    $param->{language_tag} = substr($mt->current_language, 0, 2);
2047    $param->{language_encoding} = $mt->charset;
2048    if ($mt->isa('MT::App')) {
2049        if (my $author = $mt->user) {
2050            $param->{author_id} = $author->id;
2051            $param->{author_name} = $author->name;
2052        }
2053        ## We do this in load_tmpl because show_error and login don't call
2054        ## build_page; so we need to set these variables here.
2055        require MT::Auth;
2056        $param->{can_logout} = MT::Auth->can_logout;
2057        $param->{script_url} = $mt->uri;
2058        $param->{mt_url} = $mt->mt_uri;
2059        $param->{script_path} = $mt->path;
2060        $param->{script_full_url} = $mt->base . $mt->uri;
2061        $param->{agent_mozilla} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /gecko/i;
2062        $param->{agent_ie} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /\bMSIE\b/;
2063    }
2064    if (!$tmpl->param('template_filename')) {
2065        if (my $fname = $tmpl->{__file}) {
2066            $fname =~ s!\\!/!g;
2067            $fname =~ s/\.tmpl$//;
2068            $param->{template_filename} = $fname;
2069        }
2070    }
2071    $tmpl->param($param);
2072}
2073
2074sub process_mt_template {
2075    my $mt = shift;
2076    my ($body) = @_;
2077    $body =~ s@<(?:_|MT)_ACTION\s+mode="([^"]+)"(?:\s+([^>]*))?>@
2078        my $mode = $1; my %args;
2079        %args = $2 =~ m/\s*(\w+)="([^"]*?)"\s*/g if defined $2; # "
2080        MT::Util::encode_html($mt->uri(mode => $mode, args => \%args));
2081    @geis;
2082    # Strip out placeholder wrappers to facilitate tmpl_* callbacks
2083    $body =~ s/<\/?MT_(\w+):(\w+)>//g;
2084    $body;
2085}
2086
2087sub build_page {
2088    my $mt = shift;
2089    my($file, $param) = @_;
2090    my $tmpl;
2091    my $mode = $mt->mode;
2092    $param->{"mode_$mode"} ||= 1;
2093    $param->{breadcrumbs} = $mt->{breadcrumbs};
2094    if ($param->{breadcrumbs}[-1]) {
2095        $param->{breadcrumbs}[-1]{is_last} = 1;
2096        $param->{page_titles} = [ reverse @{ $mt->{breadcrumbs} } ];
2097    }
2098    pop @{ $param->{page_titles} };
2099    if (my $lang_id = $mt->current_language) {
2100        $param->{local_lang_id} ||= lc $lang_id;
2101    }
2102    $param->{magic_token} = $mt->current_magic if $mt->user;
2103
2104    # List of installed packs in the application footer
2105    my @packs_installed;
2106    my $packs = $mt->find_addons('pack');
2107    if ($packs) {
2108        foreach my $pack (@$packs) {
2109            my $c = $mt->component(lc $pack->{id});
2110            if ($c) {
2111                my $label = $c->label || $pack->{label};
2112                $label = $label->() if ref($label) eq 'CODE';
2113                push @packs_installed, {
2114                    label => $label,
2115                    version => $c->version,
2116                    id => $c->id,
2117                };
2118            }
2119        }
2120    }
2121    @packs_installed = sort { $a->{label} cmp $b->{label} } @packs_installed;
2122    $param->{packs_installed} = \@packs_installed;
2123    $param->{portal_url} = $mt->translate("__PORTAL_URL__");
2124
2125    for my $config_field (keys %{ MT::ConfigMgr->instance->{__var} || {} }) {
2126        $param->{ $config_field . '_readonly' } = 1;
2127    }
2128
2129    my $tmpl_file = '';
2130    if (UNIVERSAL::isa($file, 'MT::Template')) {
2131        $tmpl = $file;
2132        $tmpl_file = (exists $file->{__file}) ? $file->{__file} : '';
2133    } else {
2134        $tmpl = $mt->load_tmpl($file) or return;
2135        $tmpl_file = $file unless ref($file);
2136    }
2137
2138    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2139        ($mt->{requires_login} && !$mt->user))) {
2140        ## If it's a login screen, direct the user to where they were going
2141        ## (query params including mode and all) unless they were logging in,
2142        ## logging out, or deleting something.
2143        my $q = $mt->{query};
2144        if ($mode) {
2145            my @query = map { { name => $_, value => scalar encode_text( $q->param($_) ) }; }
2146                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2147            $param->{query_params} = \@query;
2148        }
2149        $param->{login_again} = $mt->{login_again};
2150    }
2151
2152    my $blog = $mt->blog;
2153    $tmpl->context()->stash('blog', $blog) if $blog;
2154
2155    $tmpl->param($param) if $param;
2156
2157    if ($tmpl_file) {
2158        $tmpl_file = File::Basename::basename($tmpl_file);
2159        $tmpl_file =~ s/\.tmpl$//;
2160        $tmpl_file = '.' . $tmpl_file;
2161    }
2162    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2163
2164    my $output = $mt->build_page_in_mem($tmpl);
2165    return unless defined $output;
2166
2167    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2168    return $output;
2169}
2170
2171sub build_page_in_mem {
2172    my $mt = shift;
2173    my($tmpl, $param) = @_;
2174    $tmpl->param($param) if $param;
2175    my $out = $tmpl->output;
2176    return $mt->error($tmpl->errstr) unless defined $out;
2177    return $mt->translate_templatized($mt->process_mt_template($out));
2178}
2179
2180sub new_ua {
2181    my $class = shift;
2182    my ($opt) = @_;
2183    $opt ||= {};
2184    my $lwp_class = 'LWP::UserAgent';
2185    if ($opt->{paranoid}) {
2186        eval { require LWPx::ParanoidAgent; };
2187        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2188    }
2189    eval "require $lwp_class;";
2190    return undef if $@;
2191    my $cfg = $class->config;
2192    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2193    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2194    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2195    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2196    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2197    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2198
2199    if ( my $localaddr = $interface ) {
2200        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2201            LocalAddr => $localaddr,
2202            Reuse     => 1
2203        );
2204    }
2205
2206    my $ua = $lwp_class->new;
2207    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2208    $ua->agent( $agent );
2209    $ua->timeout( $timeout ) if defined $timeout;
2210    if ( defined $proxy ) {
2211        $ua->proxy( http => $proxy );
2212        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2213        $ua->no_proxy(@domains) if @domains;
2214    }
2215    return $ua;
2216}
2217
2218sub build_email {
2219    my $class = shift;
2220    my ( $file, $param ) = @_;
2221    my $mt = $class->instance;
2222
2223    # basically, try to load from database
2224    my $blog = $param->{blog} || undef;
2225    my $id = $file;
2226    $id =~ s/(\.tmpl|\.mtml)$//;
2227
2228    require MT::Template;
2229    my @tmpl = MT::Template->load(
2230        {
2231            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2232            identifier => $id,
2233            type       => 'email',
2234        }
2235    );
2236    my $tmpl =
2237      @tmpl
2238      ? (
2239        scalar @tmpl > 1
2240        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2241        : $tmpl[0]
2242      )
2243      : undef;
2244
2245    # try to load from file
2246    unless ($tmpl) {
2247        local $mt->{template_dir} = 'email';
2248        $tmpl = $mt->load_tmpl($file);
2249    }
2250    return unless $tmpl;
2251
2252    my $ctx = $tmpl->context;
2253    $ctx->stash( 'blog_id', $blog->id ) if $blog;
2254    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2255    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2256    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2257    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2258      if $param->{'commenter'};
2259    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2260    $ctx->stash( 'category', delete $param->{'category'} )
2261      if $param->{'category'};
2262    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2263
2264    foreach my $p (%$param) {
2265        if ( ref($p) ) {
2266            $tmpl->param( $p, $param->{$p} );
2267        }
2268    }
2269    return $mt->build_page_in_mem( $tmpl, $param );
2270}
2271
2272sub get_next_sched_post_for_user {
2273    my ( $author_id, @further_blog_ids ) = @_;
2274    require MT::Permission;
2275    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2276    my @blogs = @further_blog_ids;
2277    for my $perm (@perms) {
2278        next
2279          unless ( $perm->can_edit_config
2280            || $perm->can_publish_post
2281            || $perm->can_edit_all_posts );
2282        push @blogs, $perm->blog_id;
2283    }
2284    my $next_sched_utc = undef;
2285    require MT::Entry;
2286    for my $blog_id (@blogs) {
2287        my $blog           = MT::Blog->load($blog_id)
2288            or next;
2289        my $earliest_entry = MT::Entry->load(
2290            {
2291                status  => MT::Entry::FUTURE(),
2292                blog_id => $blog_id
2293            },
2294            { 'sort' => 'created_on' }
2295        );
2296        if ($earliest_entry) {
2297            my $entry_utc =
2298              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2299            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2300                $next_sched_utc = $entry_utc;
2301            }
2302        }
2303    }
2304    return $next_sched_utc;
2305}
2306
2307our %Commenter_Auth;
2308
2309sub init_commenter_authenticators {
2310    my $self = shift;
2311    my $auths = $self->registry("commenter_authenticators") || {};
2312    foreach my $auth ( keys %$auths ) {
2313        delete $auths->{$auth}
2314          if exists( $auths->{$auth}->{condition} )
2315          && !( $auths->{$auth}->{condition}->() );
2316    }
2317    %Commenter_Auth = %$auths;
2318    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2319}
2320
2321sub commenter_authenticator {
2322    my $self = shift;
2323    my ($key) = @_;
2324    %Commenter_Auth or $self->init_commenter_authenticators();
2325    return $Commenter_Auth{$key};
2326}
2327
2328sub commenter_authenticators {
2329    my $self = shift;
2330    %Commenter_Auth or $self->init_commenter_authenticators();
2331    return values %Commenter_Auth;
2332}
2333
2334sub _commenter_auth_params {
2335    my ( $key, $blog_id, $entry_id, $static ) = @_;
2336    my $params = {
2337        blog_id => $blog_id,
2338        static  => $static,
2339    };
2340    $params->{entry_id} = $entry_id if defined $entry_id;
2341    return $params;
2342}
2343
2344sub _openid_commenter_condition {
2345    eval "require Digest::SHA1;";
2346    return $@ ? 0 : 1;
2347}
2348
2349sub core_commenter_authenticators {
2350    return {
2351        'OpenID' => {
2352            class      => 'MT::Auth::OpenID',
2353            label      => 'OpenID',
2354            login_form => <<OpenID,
2355<form method="post" action="<mt:var name="script_url">">
2356<input type="hidden" name="__mode" value="login_external" />
2357<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2358<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2359<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2360<fieldset>
2361<mtapp:setting
2362    id="openid_display"
2363    label="<__trans phrase="OpenID URL">"
2364    hint="<__trans phrase="Sign in using your OpenID identity.">">
2365<input type="hidden" name="key" value="OpenID" />
2366<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%;" />
2367    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2368</mtapp:setting>
2369<img src="<mt:var name="static_uri">images/comment/openid_enabled.png" class="right" />
2370<div class="actions-bar actions-bar-login">
2371    <div class="actions-bar-inner pkg actions">
2372        <button
2373            type="submit"
2374            class="primary-button"
2375            ><__trans phrase="Sign in"></button>
2376    </div>
2377</div>
2378<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>
2379</fieldset>
2380</form>
2381OpenID
2382            login_form_params => \&_commenter_auth_params,
2383            condition         => \&_openid_commenter_condition,
2384            logo              => 'images/comment/signin_openid.png',
2385            logo_small        => 'images/comment/openid_logo.png',
2386        },
2387        'LiveJournal' => {
2388            class      => 'MT::Auth::LiveJournal',
2389            label      => 'LiveJournal',
2390            login_form => <<LiveJournal,
2391<form method="post" action="<mt:var name="script_url">">
2392<input type="hidden" name="__mode" value="login_external" />
2393<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2394<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2395<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2396<input type="hidden" name="key" value="LiveJournal" />
2397<fieldset>
2398<mtapp:setting
2399    id="livejournal_display"
2400    label="<__trans phrase="Your LiveJournal Username">"
2401    hint="<__trans phrase="Sign in using your Vox blog URL">">
2402<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%;" />
2403</mtapp:setting>
2404<div class="actions-bar actions-bar-login">
2405    <div class="actions-bar-inner pkg actions">
2406        <button
2407            type="submit"
2408            class="primary-button"
2409            ><__trans phrase="Sign in"></button>
2410    </div>
2411</div>
2412<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>
2413</fieldset>
2414</form>
2415LiveJournal
2416            login_form_params => \&_commenter_auth_params,
2417            condition         => \&_openid_commenter_condition,
2418            logo              => 'images/comment/signin_livejournal.png',
2419            logo_small        => 'images/comment/livejournal_logo.png',
2420        },
2421        'Vox' => {
2422            class      => 'MT::Auth::Vox',
2423            label      => 'Vox',
2424            login_form => <<Vox,
2425<form method="post" action="<mt:var name="script_url">">
2426<input type="hidden" name="__mode" value="login_external" />
2427<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2428<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2429<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2430<input type="hidden" name="key" value="Vox" />
2431<fieldset>
2432<mtapp:setting
2433    id="vox_display"
2434    label="<__trans phrase="Your Vox Blog URL">">
2435http:// <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
2436</mtapp:setting>
2437<div class="actions-bar actions-bar-login">
2438    <div class="actions-bar-inner pkg actions">
2439        <button
2440            type="submit"
2441            class="primary-button"
2442            ><__trans phrase="Sign in"></button>
2443    </div>
2444</div>
2445<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>
2446</fieldset>
2447</form>
2448Vox
2449            login_form_params => \&_commenter_auth_params,
2450            condition         => \&_openid_commenter_condition,
2451            logo              => 'images/comment/signin_vox.png',
2452            logo_small        => 'images/comment/vox_logo.png',
2453        },
2454        'TypeKey' => {
2455            class      => 'MT::Auth::TypeKey',
2456            label      => 'TypeKey',
2457            login_form => <<TypeKey,
2458<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>
2459<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>
2460TypeKey
2461            login_form_params => sub {
2462                my ( $key, $blog_id, $entry_id, $static ) = @_;
2463                my $entry = MT::Entry->load($entry_id) if $entry_id;
2464
2465                ## TypeKey URL
2466                require MT::Template::Context;
2467                my $ctx = MT::Template::Context->new;
2468                $ctx->stash( 'blog_id', $blog_id );
2469                my $blog = MT::Blog->load($blog_id);
2470                $ctx->stash( 'blog',  $blog );
2471                $ctx->stash( 'entry', $entry );
2472                my $params = {};
2473                $params->{tk_signin_url} =
2474                  MT::Template::Context::_hdlr_remote_sign_in_link( $ctx,
2475                    { static => $static } );
2476                return $params;
2477            },
2478            logo => 'images/comment/signin_typekey.png',
2479            logo_small        => 'images/comment/typekey_logo.png',
2480        },
2481    };
2482}
2483
2484our %Captcha_Providers;
2485
2486sub captcha_provider {
2487    my $self = shift;
2488    my ($key) = @_;
2489    $self->init_captcha_providers() unless %Captcha_Providers;
2490    return $Captcha_Providers{$key};
2491}
2492
2493sub captcha_providers {
2494    my $self = shift;
2495    $self->init_captcha_providers() unless %Captcha_Providers;
2496    my $def  = delete $Captcha_Providers{'mt_default'};
2497    my @vals = values %Captcha_Providers;
2498    if ( defined($def) && $def->{condition}->() ) {
2499        unshift @vals, $def;
2500    }
2501    @vals;
2502}
2503
2504sub core_captcha_providers {
2505    return {
2506        'mt_default' => {
2507            label     => 'Movable Type default',
2508            class     => 'MT::Util::Captcha',
2509            condition => sub {
2510                require MT::Util::Captcha;
2511                if ( my $error = MT::Util::Captcha->check_availability ) {
2512                    return 0;
2513                }
2514                1;
2515            },
2516        }
2517    };
2518}
2519
2520sub init_captcha_providers {
2521    my $self = shift;
2522    my $providers = $self->registry("captcha_providers") || {};
2523    foreach my $provider ( keys %$providers ) {
2524        delete $providers->{$provider}
2525          if exists( $providers->{$provider}->{condition} )
2526          && !( $providers->{$provider}->{condition}->() );
2527    }
2528    %Captcha_Providers = %$providers;
2529    $Captcha_Providers{$_}{key} ||= $_ for keys %Captcha_Providers;
2530}
2531
2532sub effective_captcha_provider {
2533    my $class = shift;
2534    my ($key) = @_;
2535    return undef unless $key;
2536    my $cp = $class->captcha_provider($key) or return;
2537    if ( exists $cp->{condition} ) {
2538        return undef unless $cp->{condition}->();
2539    }
2540    my $pkg = $cp->{class};
2541    $pkg =~ s/;//g;
2542    eval "require $pkg" or return;
2543    return $cp->{class};
2544}
2545
2546sub handler_to_coderef {
2547    my $pkg = shift;
2548    my ( $name, $delayed ) = @_;
2549
2550    return $name if ref($name) eq 'CODE';
2551    return undef unless defined $name && $name ne '';
2552
2553    my $code;
2554    if ( $name !~ m/->/ ) {
2555
2556        # check for Package::Routine first; if defined, return coderef
2557        no strict 'refs';
2558        $code = \&$name if defined &$name;
2559        return $code if $code;
2560    }
2561
2562    my $component;
2563    if ( $name =~ m!^\$! ) {
2564        if ( $name =~ s/^\$(\w+)::// ) {
2565            $component = $1;
2566        }
2567    }
2568    if ( $name =~ m/^\s*sub\s*\{/s ) {
2569        $code = eval $name or die $@;
2570
2571        if ($component) {
2572            return sub {
2573                my $mt_inst = MT->instance;
2574                local $mt_inst->{component} = $component;
2575                $code->(@_);
2576            };
2577        }
2578        else {
2579            return $code;
2580        }
2581    }
2582
2583    my $hdlr_pkg = $name;
2584    my $method;
2585    if ( $hdlr_pkg =~ s/(->|::)([^:]+)$// ) {    # strip routine name
2586        $method = $2 if $1 eq '->';
2587    }
2588    if ( !defined(&$name) && !$pkg->can( 'AUTOLOAD' ) ) {
2589
2590        # The delayed option will return a coderef that delays the loading
2591        # of the package holding the handler routine.
2592        if ($delayed) {
2593            if ($method) {
2594                return sub {
2595                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $hdlr_pkg;"
2596                      or Carp::confess(
2597                        "failed loading package $hdlr_pkg for routine $name: $@");
2598                    my $mt_inst = MT->instance;
2599                    local $mt_inst->{component} = $component
2600                      if $component;
2601                    return $hdlr_pkg->$method(@_);
2602                };
2603            }
2604            else {
2605                return sub {
2606                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $hdlr_pkg;"
2607                      or Carp::confess(
2608                        "failed loading package $hdlr_pkg for routine $name: $@");
2609                    my $mt_inst = MT->instance;
2610                    local $mt_inst->{component} = $component
2611                      if $component;
2612                    no strict 'refs';
2613                    my $hdlr = \&$name;
2614                    use strict 'refs';
2615                    return $hdlr->(@_);
2616                };
2617            }
2618        }
2619        else {
2620            eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $hdlr_pkg;"
2621              or Carp::confess(
2622                "failed loading package $hdlr_pkg for routine $name: $@");
2623        }
2624    }
2625    if ($method) {
2626        $code = sub {
2627            my $mt_inst = MT->instance;
2628            local $mt_inst->{component} = $component
2629              if $component;
2630            return $hdlr_pkg->$method(@_);
2631        };
2632    }
2633    else {
2634        if ($component) {
2635            $code = sub {
2636                no strict 'refs';
2637                my $hdlr = (
2638                    defined &$name ? \&$name
2639                    : ( $pkg->can( 'AUTOLOAD' ) ? \&$name
2640                        : undef )
2641                );
2642                use strict 'refs';
2643                if ($hdlr) {
2644                    my $mt_inst = MT->instance;
2645                    local $mt_inst->{component} = $component
2646                      if $component;
2647                    return $hdlr->(@_);
2648                }
2649                return undef;
2650              }
2651        }
2652        else {
2653            no strict 'refs';
2654            $code =
2655              (
2656                defined &$name
2657                ? \&$name
2658                : ( $hdlr_pkg->can( 'AUTOLOAD' ) ? \&$name : undef )
2659              );
2660        }
2661    }
2662    return $code;
2663}
2664
2665sub help_url {
2666    my $pkg = shift;
2667    my ( $append ) = @_;
2668
2669    my $url = $pkg->config->HelpURL;
2670    return $url if defined $url;
2671    $url = $pkg->translate('http://www.movabletype.org/documentation/');
2672    if ( $append ) {
2673        $url .= $append;
2674    }
2675    $url;
2676}
2677
2678sub register_refresh_cache_event {
2679    my $pkg = shift;
2680    my ($callback) = @_;
2681    return unless $callback;
2682
2683    MT->_register_core_callbacks({
2684        "$callback" => \&refresh_cache,
2685    });
2686}
2687
2688sub refresh_cache {
2689    my ($cb, %args) = @_;
2690
2691    require MT::Cache::Negotiate;
2692    my $cache_driver = MT::Cache::Negotiate->new();
2693    return unless $cache_driver;
2694
2695    $cache_driver->flush_all();
2696}
2697
2698sub DESTROY {
2699    # save_config here so not to miss any dirty config change to persist
2700    # particulary for those which does not construct MT::App.
2701    $_[0]->config->save_config();
2702}
2703
27041;
2705
2706__END__
2707
2708=head1 NAME
2709
2710MT - Movable Type
2711
2712=head1 SYNOPSIS
2713
2714    use MT;
2715    my $mt = MT->new;
2716    $mt->rebuild(BlogID => 1)
2717        or die $mt->errstr;
2718
2719=head1 DESCRIPTION
2720
2721The I<MT> class is the main high-level rebuilding/pinging interface in the
2722Movable Type library. It handles all rebuilding operations. It does B<not>
2723handle any of the application functionality--for that, look to I<MT::App> and
2724I<MT::App::CMS>, both of which subclass I<MT> to handle application requests.
2725
2726=head1 PLUGIN APPLICATIONS
2727
2728At any given time, the user of the Movable Type platform is
2729interacting with either the core Movable Type application, or a plugin
2730application (or "sub-application").
2731
2732A plugin application is a plugin with a user interface that inherits
2733functionality from Movable Type, and appears to the user as a
2734component of Movable Type. A plugin application typically has its own
2735templates displaying its own special features; but it inherits some
2736templates from Movable Type, such as the navigation chrome and error
2737pages.
2738
2739=head2 The MT Root and the Application Root
2740
2741To locate assets of the core Movable Type application and any plugin
2742applications, the platform uses two directory paths, C<mt_dir> and
2743C<app_dir>. These paths are returned by the MT class methods with the
2744same names, and some other methods return derivatives of these paths.
2745
2746Conceptually, mt_dir is the root of the Movable Type installation, and
2747app_dir is the root of the "currently running application", which
2748might be Movable Type or a plugin application. It is important to
2749understand the distinction between these two values and what each is
2750used for.
2751
2752The I<mt_dir> is the absolute path to the directory where MT itself is
2753located. Most importantly, the MT configuration file and the CGI scripts that
2754bootstrap an MT request are found here. This directory is also the
2755default base path under which MT's core templates are found (but this
2756can be overridden using the I<TemplatePath> configuration setting).
2757
2758Likewise, the I<app_dir> is the directory where the "current"
2759application's assets are rooted. The platform will search for
2760application templates underneath the I<app_dir>, but this search also
2761searches underneath the I<mt_dir>, allowing the application to make
2762use of core headers, footers, error pages, and possibly other
2763templates.
2764
2765In order for this to be useful, the plugin's templates and
2766code should all be located underneath the same directory. The relative
2767path from the I<app_dir> to the application's templates is
2768configurable. For details on how to indicate the location of your
2769plugin's templates, see L<MT::App>.
2770
2771=head2 Finding the Root Paths
2772
2773When a plugin application initializes its own application class (a
2774subclass of MT::App), the I<mt_dir> should be discovered and passed
2775constructor. This comes either from the C<Directory> parameter or the
2776C<Config> parameter.
2777
2778Since plugins are loaded from a descendent of the MT root directory,
2779the plugin bootstrap code can discover the MT configuration file (and thus
2780the MT root directory) by traversing the filesystem; the absolute path
2781to that file can be passed as the C<Config> parameter to
2782MT::App::new. Working code to do this can be found in the
2783examples/plugins/mirror/mt-mirror.cgi file.
2784
2785The I<app_dir>, on the other hand, always derives from the location of
2786the currently-running program, so it typically does not need to be
2787specified.
2788
2789=head1 USAGE
2790
2791I<MT> has the following interface. On failure, all methods return C<undef>
2792and set the I<errstr> for the object or class (depending on whether the
2793method is an object or class method, respectively); look below at the section
2794L<ERROR HANDLING> for more information.
2795
2796=head2 MT->new( %args )
2797
2798Constructs a new I<MT> instance and returns that object. Returns C<undef>
2799on failure.
2800
2801I<new> will also read your MT configuration file (provided that it can find it--if
2802you find that it can't, take a look at the I<Config> directive, below). It
2803will also initialize the chosen object driver; the default is the C<DBM>
2804object driver.
2805
2806I<%args> can contain:
2807
2808=over 4
2809
2810=item * Config
2811
2812Path to the MT configuration file.
2813
2814If you do not specify a path, I<MT> will try to find your MT configuration file
2815in the current working directory.
2816
2817=item * Directory
2818
2819Path to the MT home directory.
2820
2821If you do not specify a path, I<MT> will try to find the MT directory using
2822the discovered path of the MT configuration file.
2823
2824=back
2825
2826=head2 $mt->init
2827
2828Initializes the Movable Type instance, including registration of basic
2829resources and callbacks. This method also invokes the C<init_config>
2830and C<init_plugins> methods.
2831
2832=head2 MT->instance
2833
2834MT and all it's subclasses are now singleton classes, meaning you can only
2835have one instance per package. MT->instance() returns the active instance.
2836MT->new() is now an alias to instance_of.
2837
2838=head2 $class->instance_of
2839
2840Returns the singleton instance of the MT subclass identified by C<$class>.
2841
2842=head2 $class->construct
2843
2844Constructs a new instance of the MT subclass identified by C<$class>.
2845
2846=head2 MT->set_instance
2847
2848Assigns the active MT instance object. This value is returned when
2849C<MT-E<gt>instance> is invoked.
2850
2851=head2 $mt->find_config($params)
2852
2853Handles the discovery of the MT configuration file. The path and filename
2854for the configuration file is returned as the result. The C<$params>
2855parameter is a reference to the hash of settings passed to the MT
2856constructor.
2857
2858=head2 $mt->init_config($params)
2859
2860Reads the MT configuration settingss from the MT configuration file
2861and settings from database (L<MT::Config>).
2862
2863The C<$params> parameter is a reference to the hash of settings passed to
2864the MT constructor.
2865
2866=head2 $mt->init_plugins
2867
2868Loads any discoverable plugins that are available. This is called from
2869the C<init> method, after the C<init_config> method has loaded the
2870configuration settings.
2871
2872=head2 $mt->init_tasks
2873
2874Registers the standard set of periodic tasks that Movable Type provides
2875and then invokes the C<init_tasks> method for each available plugin.
2876
2877=head2 MT->run_tasks
2878
2879Initializes the tasks, running C<init_tasks> and invokes the task system
2880through L<MT::TaskMgr> to run any registered tasks that are pending
2881execution. See L<MT::TaskMgr> for further documentation.
2882
2883=head2 MT->unplug
2884
2885Removes the global reference to the MT instance.
2886
2887=head2 MT::log( $message ) or $mt->log( $message )
2888
2889Adds an entry to the application's log table. Also writes message to
2890STDERR which is typically routed to the web server's error log.
2891
2892=head2 $mt->server_path, $mt->mt_dir
2893
2894Both of these methods return the physical file path to the directory
2895that is the home of the MT installation. This would be the value of
2896the 'Directory' parameter given in the MT constructor, or would be
2897determined based on the path of the configuration file.
2898
2899=head2 $mt->app_dir
2900
2901Returns the physical file path to the active application directory. This
2902is determined by the directory of the active script.
2903
2904=head2 $mt->config_dir
2905
2906Returns the path to the MT configuration file.
2907
2908=head2 $mt->config([$setting[, $value]])
2909
2910This method is used to get and set configuration settings. When called
2911without any parameters, it returns the active MT::ConfigMgr instance
2912used by the application.
2913
2914Specifying the C<$setting> parameter will return the value for that setting.
2915When passing the C<$value> parameter, this will update the config object,
2916assigning that value for the named C<$setting>.
2917
2918=head2 $mt->user_class
2919
2920Returns the package name for the class used for user authentication.
2921This is typically L<MT::Author>.
2922
2923=head2 $mt->request([$element[,$data]])
2924
2925The request method provides a request-scoped storage object. It is an
2926access interface for the L<MT::Request> package. Calling without any
2927parameters will return the L<MT::Request> instance.
2928
2929When called with the C<$element> parameter, the data stored for that
2930element is returned (or undef, if it didn't exist). When called with
2931the C<$data> parameter, it will store the data into the specified
2932element in the request object.
2933
2934All values placed in the request object are lost at the end of the
2935request. If the running application is not a web-based application,
2936the request object exists for the lifetime of the process and is
2937released when the process ends.
2938
2939See the L<MT::Request> package for more information.
2940
2941=head2 MT->new_ua
2942
2943Returns a new L<LWP::UserAgent> instance that is configured according to the
2944Movable Type configuration settings (specifically C<HTTPInterface>, C<HTTPTimeout>, C<HTTPProxy> and C<HTTPNoProxy>). The agent string is set
2945to "MovableType/(version)" and is also limited to receiving a response of
2946100,000 bytes by default (you can override this by using the 'max_size'
2947method on the returned instance). Using this method is recommended for
2948any HTTP requests issued by Movable Type since it uses the MT configuration
2949settings to prepare the UserAgent object.
2950
2951=head2 $mt->ping( %args )
2952
2953Sends all configured XML-RPC pings as a way of notifying other community
2954sites that your blog has been updated.
2955
2956I<%args> can contain:
2957
2958=over 4
2959
2960=item * Blog
2961
2962An I<MT::Blog> object corresponding to the blog for which you would like to
2963send the pings.
2964
2965Either this or C<BlogID> is required.
2966
2967=item * BlogID
2968
2969The ID of the blog for which you would like to send the pings.
2970
2971Either this or C<Blog> is required.
2972
2973=back
2974
2975=head2 $mt->ping_and_save( %args )
2976
2977Handles the task of issuing any pending ping operations for a given
2978entry and then saving that entry back to the database.
2979
2980The I<%args> hash should contain an element named C<Entry> that is a
2981reference to a L<MT::Entry> object.
2982
2983=head2 $mt->needs_ping(%param)
2984
2985Returns a list of URLs that have not been pinged for a given entry. Named
2986parameters for this method are:
2987
2988=over 4
2989
2990=item Entry
2991
2992The L<MT::Entry> object to examine.
2993
2994=item Blog
2995
2996The L<MT::Blog> object that is the parent of the entry given.
2997
2998=back
2999
3000The return value is an array reference of URLs that have not been pinged
3001for the given entry.
3002
3003An empty list is returned for entries that have a non 'RELEASE' status.
3004
3005=head2 $mt->update_ping_list($blog)
3006
3007Returns a list of URLs for ping services that have been configured to
3008be notified when posting new entries.
3009
3010=head2 $mt->set_language($tag)
3011
3012Loads the localization plugin for the language specified by I<$tag>, which
3013should be a valid and supported language tag--see I<supported_languages> to
3014obtain a list of supported languages.
3015
3016The language is set on a global level, and affects error messages and all
3017text in the administration system.
3018
3019This method can be called as either a class method or an object method; in
3020other words,
3021
3022    MT->set_language($tag)
3023
3024will also work. However, the setting will still be global--it will not be
3025specified to the I<$mt> object.
3026
3027The default setting--set when I<MT::new> is called--is U.S. English. If a
3028I<DefaultLanguage> is set in the MT configuration file, the default is then
3029set to that language.
3030
3031=head2 MT->translate($str[, $param, ...])
3032
3033Translates I<$str> into the currently-set language (set by I<set_language>),
3034and returns the translated string. Any parameters following I<$str> are
3035passed through to the C<maketext> method of the active localization module.
3036
3037=head2 MT->translate_templatized($str)
3038
3039Translates a string that has embedded E<lt>MT_TRANSE<gt> tags. These
3040tags identify the portions of the string that require localization.
3041Each tag is processed separately and passed through the MT->translate
3042method. Examples (used in your application's HTML::Template templates):
3043
3044    <p><MT_TRANS phrase="Hello, world"></p>
3045
3046and
3047
3048    <p><MT_TRANS phrase="Hello, [_1]" params="<TMPL_VAR NAME=NAME>"></p>
3049
3050=head2 $mt->trans_error( $str[, $arg1, $arg2] )
3051
3052Translates I<$str> into the currently-set language (set by I<set_language>),
3053and assigns it as the active error for the MT instance. It returns undef,
3054which is the usual return value upon generating an error in the application.
3055So when an error occurs, the typical return result would be:
3056
3057    if ($@) {
3058        return $app->trans_error("An error occurred: [_1]", $@);
3059    }
3060
3061The optional I<$arg1> (and so forth) parameters are passed as parameters to
3062any parameterized error message.
3063
3064=head2 $mt->current_language
3065
3066Returns the language tag for the currently-set language.
3067
3068=head2 MT->supported_languages
3069
3070Returns a reference to an associative array mapping language tags to their
3071proper names. For example:
3072
3073    use MT;
3074    my $langs = MT->supported_languages;
3075    print map { $_ . " => " . $langs->{$_} . "\n" } keys %$langs;
3076
3077=head2 MT->language_handle
3078
3079Returns the active MT::L10N language instance for the active language.
3080
3081=head2 MT->add_plugin($plugin)
3082
3083Adds the plugin described by $plugin to the list of plugins displayed
3084on the welcome page. The argument should be an object of the
3085I<MT::Plugin> class.
3086
3087=head2 MT->all_text_filters
3088
3089Returns a reference to a hash containing the registry of text filters.
3090
3091=head2 MT->apply_text_filters($str, \@filters)
3092
3093Applies the set of filters I<\@filters> to the string I<$str> and returns
3094the result (the filtered string).
3095
3096I<\@filters> should be a reference to an array of filter keynames--these
3097are the short names passed in as the first argument to I<add_text_filter>.
3098I<$str> should be a scalar string to be filtered.
3099
3100If one of the filters listed in I<\@filters> is not found in the list of
3101registered filters (that is, filters added through I<add_text_filter>),
3102it will be skipped silently. Filters are executed in the order in which they
3103appear in I<\@filters>.
3104
3105As it turns out, the I<MT::Entry::text_filters> method returns a reference
3106to the list of text filters to be used for that entry. So, for example, to
3107use this method to apply filters to the main entry text for an entry
3108I<$entry>, you would use
3109
3110    my $out = MT->apply_text_filters($entry->text, $entry->text_filters);
3111
3112=head2 MT->add_callback($meth, $priority, $plugin, $code)
3113
3114Registers a new callback handler for a particular registered callback.
3115
3116The first parameter is the name of the callback method. The second
3117parameter is a priority (a number in the range of 1-10) which will control
3118the order that the handler is executed in relation to other handlers. If
3119two handlers register with the same priority, they will be executed in
3120the order that they registered. The third parameter is a C<MT::Plugin> object
3121reference that is associated with the handler (this parameter is optional).
3122The fourth parameter is a code reference that is invoked to handle the
3123callback. For example:
3124
3125    MT->add_callback('BuildFile', 1, undef, \&rebuild_file_hdlr);
3126
3127The code reference should expect to receive an object of type
3128L<MT::Callback> as its first argument. This object is used to
3129communicate errors to the caller:
3130
3131    sub rebuild_file_hdlr {
3132        my ($cb, ...) = @_;
3133        if (something bad happens) {
3134            return $cb->error("Something bad happened!");
3135        }
3136    }
3137
3138Other parameters to the callback function depend on the callback point.
3139
3140The treatment of the error string depends on the callback point.
3141Typically, either it is ignored or the user's action fails and the
3142error message is displayed.
3143
3144The value returned from this method is the new L<MT::Callback> object.
3145
3146=head2 MT->remove_callback($callback)
3147
3148Removes a callback that was previously registered.
3149
3150=head2 MT->register_callbacks([...])
3151
3152Registers several callbacks simultaneously. Each element in the array
3153parameter given should be a hashref containing these elements: C<name>,
3154C<priority>, C<plugin> and C<code>.
3155
3156=head2 MT->run_callbacks($meth[, $arg1, $arg2, ...])
3157
3158Invokes a particular callback, running any associated callback handlers.
3159
3160The first parameter is the name of the callback to execute. This is one
3161of the global callback methods (see L<Callbacks> section) or can be
3162a class-specific method that includes the package name associated with
3163the callback.
3164
3165The remaining arguments are passed through to any callback handlers that
3166are invoked.
3167
3168For "Filter"-type callbacks, this routine will return a 0 if any of the
3169handlers return a false result. If all handlers return a true result,
3170a value of 1 is returned.
3171
3172Example:
3173
3174    MT->run_callbacks('MyClass::frobnitzes', \@whirlygigs);
3175
3176Which would execute any handlers that registered in this fashion:
3177
3178    MT->add_callback('MyClass::frobnitzes', 4, $plugin, \&frobnitz_hdlr);
3179
3180=head2 MT->run_callback($cb[, $arg1, $arg2, ...])
3181
3182An internal routine used by C<run_callbacks> to invoke a single
3183L<MT::Callback>.
3184
3185=head2 callback_error($str)
3186
3187This routine is used internally by C<MT::Callback> to set any error response
3188that comes from invoking a callback.
3189
3190=head2 callback_errstr
3191
3192This internal routine returns the error response stored using the
3193C<callback_error> routine.
3194
3195=head2 MT->product_code
3196
3197The product code identifying the Movable Type product that is installed.
3198This is either 'MTE' for Movable Type Enterprise or 'MT' for the
3199non-Enterprise product.
3200
3201=head2 MT->product_name
3202
3203The name of the Movable Type product that is installed. This is either
3204'Movable Type Enterprise' or 'Movable Type Publishing Platform'.
3205
3206=head2 MT->product_version
3207
3208The version number of the product. This is different from the C<version_id>
3209and C<version_number> methods as they report the API version information.
3210
3211=head2 MT->version_id
3212
3213Returns the API version of MT (including any beta/alpha designations).
3214
3215=head2 MT->version_number
3216
3217Returns the numeric API version of MT (without any beta/alpha designations).
3218For example, if I<version_id> returned C<2.5b1>, I<version_number> would
3219return C<2.5>.
3220
3221=head2 MT->schema_version
3222
3223Returns the version of the MT database schema.
3224
3225=head2 MT->version_slug
3226
3227Returns a string of text that is appended to emails sent through the
3228C<build_email> method.
3229
3230=head2 $mt->publisher
3231
3232Returns the L<MT::WeblogPublisher> object that is used for managing the
3233MT publishing process. See L<MT::WeblogPublisher> for more information.
3234
3235=head2 $mt->rebuild
3236
3237An alias to L<MT::WeblogPublisher::rebuild>. See L<MT::WeblogPublisher>
3238for documentation of this method.
3239
3240=head2 $mt->rebuild_entry
3241
3242An alias to L<MT::WeblogPublisher::rebuild_entry>. See L<MT::WeblogPublisher>
3243for documentation of this method.
3244
3245=head2 $mt->rebuild_indexes
3246
3247An alias to L<MT::WeblogPublisher::rebuild_indexes>. See
3248L<MT::WeblogPublisher> for documentation of this method.
3249
3250=head2 $mt->build_email($file, $param)
3251
3252Loads a template from the application's 'email' template directory and
3253processes it as a HTML::Template. The C<$param> argument is a hash reference
3254of parameter data for the template. The return value is the output of the
3255template.
3256
3257=head2 MT::get_next_sched_post_for_user($author_id, @blog_ids)
3258
3259This is an internal routine used by L<MT::XMLRPCServer> and the
3260getNextScheduled XMLRPC method to determine the timestamp for the next
3261entry that is scheduled for publishing. The return value is the timestamp
3262in UTC time in the format "YYYY-MM-DDTHH:MM:SSZ".
3263
3264=head1 ERROR HANDLING
3265
3266On an error, all of the above methods return C<undef>, and the error message
3267can be obtained by calling the method I<errstr> on the class or the object
3268(depending on whether the method called was a class method or an instance
3269method).
3270
3271For example, called on a class name:
3272
3273    my $mt = MT->new or die MT->errstr;
3274
3275Or, called on an object:
3276
3277    $mt->rebuild(BlogID => $blog_id)
3278        or die $mt->errstr;
3279
3280=head1 DEBUGGING
3281
3282MT has a package variable C<$MT::DebugMode> which is assigned through
3283your MT configuration file (DebugMode setting). If this is set to
3284any non-zero value, MT applications will display any C<warn>'d
3285statements to a panel that is displayed within the app.
3286
3287The DebugMode is a bit-wise setting and offers the following options:
3288
3289    1 - Display debug messages
3290    2 - Display a stack trace for messages captured
3291    4 - Lists queries issued by Data::ObjectDriver
3292    8 - Reports on MT templates that take more than 1/4 second to build*
3293    128 - Outputs app-level request/response information to STDERR.
3294
3295These can be combined, so if you want to display queries and debug messages,
3296use a DebugMode of 5 for instance.
3297
3298You may also use the local statement to temporarily apply a particular bit,
3299if you want to scope the debug messages you receive to a block of code:
3300
3301    local $MT::DebugMode |= 4;  # show me the queries for the following
3302    my $obj = MT::Entry->load({....});
3303
3304*DebugMode bit 8 actually outputs it's messages to STDERR (which typically
3305is sent to your web server's error log).
3306
3307=head1 CALLBACKS
3308
3309Movable Type has a variety of hook points at which a plugin can attach
3310a callback.
3311
3312In each case, the first parameter is an L<MT::Callback> object which
3313can be used to pass error information back to the caller.
3314
3315The app-level callbacks related to rebuilding are documented
3316in L<MT::WeblogPublisher>. The specific apps document the callbacks
3317which they invoke.
3318
3319=head2 NewUserProvisioning($cb, $user)
3320
3321This callback is invoked when a user is being added to Movable Type.
3322Movable Type itself registers for this callback (with a priority of 5)
3323to provision the user with a new weblog if the system has been configured
3324to do so.
3325
3326=head2 post_init($cb, \%param)
3327
3328This callback is invoked when MT is initialized and ready to run.
3329This callback is invoked after MT initialized addons, plugins, schema
3330and permissions.  The arguments passed to initialize MT is passed
3331through to the callback.
3332
3333=head1 LICENSE
3334
3335The license that applies is the one you agreed to when downloading
3336Movable Type.
3337
3338=head1 AUTHOR & COPYRIGHT
3339
3340Except where otherwise noted, MT is Copyright 2001-2008 Six Apart.
3341All rights reserved.
3342
3343=cut
Note: See TracBrowser for help on using the browser.