root/branches/release-34/lib/MT.pm.pre @ 1871

Revision 1871, 105.2 kB (checked in by bchoate, 20 months ago)

If PerformanceLogging is not enabled don't return a timer object from get_timer.
  • 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 "require $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        my $model = $pkg->registry( 'object_types', $k );
270        if ( ref($model) eq 'ARRAY' ) {
271
272            # First element of an array *should* be a scalar; in case it isn't,
273            # return undef.
274            $model = $model->[0];
275            return undef if ref $model;
276        }
277        elsif ( ref($model) eq 'HASH' ) {
278
279            # If all we have is a hash, this doesn't tell us the package for
280            # this object type, so it's undefined.
281            return undef;
282        }
283        return undef unless $model;
284
285        # Element in object type hash is scalar, so return it
286        no strict 'refs';
287        unless ( defined *{ $model . '::__properties' } ) {
288            use strict 'refs';
289            eval "require $model;";
290            if ( $@ && ( $k =~ m/^(.+)\./ ) ) {
291
292                # x.foo can't be found, so try loading x
293                if ( my $ppkg = $pkg->model($1) ) {
294
295                    # well now see if $model is defined
296                    no strict 'refs';
297                    unless ( defined *{ $model . '::__properties' } ) {
298
299                        # if not, use parent package instead
300                        $model = $ppkg;
301                    }
302                }
303            }
304        }
305        return $object_types{$k} = $model;
306    }
307
308    sub models {
309        my $pkg = shift;
310        my ($k) = @_;
311
312        my @matches;
313        my $model = $pkg->registry('object_types');
314        foreach my $m ( keys %$model ) {
315            if ( $m =~ m/^\Q$k\E\.?/ ) {
316                push @matches, $m;
317            }
318        }
319        return @matches;
320    }
321}
322
323sub registry {
324    my $pkg = shift;
325
326    # if (!ref $pkg) {
327    #     return $pkg->instance->registry(@_);
328    # }
329    require MT::Component;
330    my $regs = MT::Component->registry(@_);
331    my $r;
332    if ($regs) {
333        foreach my $cr (@$regs) {
334
335            # in the event that our registry request returns something
336            # other than an array of hashes, return it as is instead of
337            # merging it together.
338            return $regs unless ref($cr) eq 'HASH';
339
340            # next unless ref($cr) eq 'HASH';
341            delete $cr->{plugin} if exists $cr->{plugin};
342            __merge_hash( $r ||= {}, $cr );
343        }
344    }
345    return $r;
346}
347
348# merges contents of two hashes, giving preference to the right side
349# if $replace is true; otherwise it will always append to the left side.
350sub __merge_hash {
351    my ( $h1, $h2, $replace ) = @_;
352    for my $k ( keys(%$h2) ) {
353        if ( exists( $h1->{$k} ) && ( !$replace ) ) {
354            if ( ref $h1->{$k} eq 'HASH' ) {
355                __merge_hash( $h1->{$k}, $h2->{$k}, ( $replace || 0 ) + 1 );
356            }
357            elsif ( ref $h1->{$k} eq 'ARRAY' ) {
358                if ( ref $h2->{$k} eq 'ARRAY' ) {
359                    push @{ $h1->{$k} }, @{ $h2->{$k} };
360                }
361                else {
362                    push @{ $h1->{$k} }, $h2->{$k};
363                }
364            }
365            else {
366                $h1->{$k} = [ $h1->{$k}, $h2->{$k} ];
367            }
368        }
369        else {
370            $h1->{$k} = $h2->{$k};
371        }
372    }
373}
374
375# The above functions can all be used to make MT objects (and subobjects).
376# The difference between them is characterized by these assertions:
377#
378#  $mt = MT::App::Search->new();
379#  assert($mt->isa('MT::App::Search'))
380#
381#  $mt1 = MT->instance
382#  $mt2 = MT->instance
383#  assert($mt1 == $mt2);
384#
385#  $mt1 = MT::App::CMS->construct()
386#  $mt2 = MT::App::CMS->construct()
387#  assert($mt1 != $mt2);
388#
389# TBD: make a test script for these.
390
391sub unplug {
392}
393
394sub config {
395    my $mt = shift;
396    ref $mt or $mt = MT->instance;
397    unless ( $mt->{cfg} ) {
398        require MT::ConfigMgr;
399        weaken( $mt->{cfg} = MT::ConfigMgr->instance );
400    }
401    if (@_) {
402        my $setting = shift;
403        @_ ? $mt->{cfg}->set( $setting, @_ ) : $mt->{cfg}->get($setting);
404    }
405    else {
406        $mt->{cfg};
407    }
408}
409
410sub request {
411    my $pkg  = shift;
412    my $inst = ref($pkg) ? $pkg : $pkg->instance;
413    unless ( $inst->{request} ) {
414        require MT::Request;
415        $inst->{request} = MT::Request->instance;
416    }
417    if (@_) {
418        $inst->{request}->stash(@_);
419    }
420    else {
421        $inst->{request};
422    }
423}
424
425sub log {
426    my $mt = shift;
427    unless ($plugins_installed) {
428        # finish init_schema here since we have to log something
429        # to the database.
430        $mt->init_schema();
431    }
432    my $msg;
433    if ( !@_ ) {    # single parameter to log, so $mt must be message
434        $msg = $mt;
435        $mt  = MT->instance;
436    }
437    else {          # multiple parameters to log; second one is message
438        $msg = shift;
439    }
440    my $log_class = $mt->model('log');
441    my $log = $log_class->new();
442    if ( ref $msg eq 'HASH' ) {
443        $log->set_values($msg);
444    }
445    elsif ( ( ref $msg ) && ( UNIVERSAL::isa( $msg, 'MT::Log' ) ) ) {
446        $log = $msg;
447    }
448    else {
449        $log->message($msg);
450    }
451    $log->level( MT::Log::INFO() )
452      unless defined $log->level;
453    $log->class('system')
454      unless defined $log->class;
455    $log->save();
456    print STDERR MT->translate( "Message: [_1]", $log->message ) . "\n"
457      if $MT::DebugMode;
458}
459my $plugin_full_path;
460
461sub run_tasks {
462    my $mt = shift;
463    require MT::TaskMgr;
464    MT::TaskMgr->run_tasks(@_);
465}
466
467sub add_plugin {
468    my $class = shift;
469    my ($plugin) = @_;
470    if ( ref $plugin eq 'HASH' ) {
471        require MT::Plugin;
472        $plugin = new MT::Plugin($plugin);
473    }
474    $plugin->{name} ||= $plugin_sig;
475    $plugin->{plugin_sig} = $plugin_sig;
476
477    my $id = $plugin->id;
478    unless ($plugin_envelope) {
479        warn "MT->add_plugin improperly called outside of MT plugin load loop.";
480        return;
481    }
482    $plugin->envelope($plugin_envelope);
483    Carp::confess("You cannot register multiple plugin objects from a single script. $plugin_sig")
484      if exists( $Plugins{$plugin_sig} )
485      && ( exists $Plugins{$plugin_sig}{object} );
486
487    $Components{ lc $id } = $plugin if $id;
488    $Plugins{$plugin_sig}{object} = $plugin;
489    $plugin->{full_path}  = $plugin_full_path;
490    $plugin->path($plugin_full_path);
491    unless ( $plugin->{registry} && ( %{ $plugin->{registry} } ) ) {
492        $plugin->{registry} = $plugin_registry;
493    }
494    if ( $plugin->{registry} ) {
495        if ( my $settings = $plugin->{registry}{config_settings} ) {
496            $settings = $plugin->{registry}{config_settings} = $settings->()
497              if ref($settings) eq 'CODE';
498            $class->config->define($settings);
499        }
500    }
501    push @Components, $plugin;
502    1;
503}
504
505our %CallbackAlias;
506our $CallbacksEnabled = 1;
507my %CallbacksEnabled;
508my @Callbacks;
509
510sub add_callback {
511    my $class = shift;
512    my ( $meth, $priority, $plugin, $code ) = @_;
513    if ( $meth =~ m/^(.+::)?([^\.]+)(\..+)?$/ ) {
514
515        # Remap (whatever)::(name).(something)
516        if ( exists $CallbackAlias{$2} ) {
517            $meth = $CallbackAlias{$2};
518            $meth = $1 . $meth if $1;
519            $meth = $meth . $3 if $3;
520        }
521    }
522    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
523    my $internal = 0;
524    if ( ref $plugin ) {
525        if ( ( defined $mt_inst ) && ( $plugin == $mt_inst ) ) {
526            $plugin   = undef;
527            $internal = 1;
528        }
529        elsif ( !UNIVERSAL::isa( $plugin, "MT::Component" ) ) {
530            return $class->trans_error(
531"If present, 3rd argument to add_callback must be an object of type MT::Component or MT::Plugin"
532            );
533        }
534    }
535    if ( ( ref $code ) ne 'CODE' ) {
536        if ( ref $code ) {
537            return $class->trans_error(
538                '4th argument to add_callback must be a CODE reference.');
539        }
540        else {
541            # Defer until callback is used
542            # if ($plugin) {
543            #     $code = MT->handler_to_coderef($code);
544            # }
545        }
546    }
547
548    # 0 and 11 are exclusive.
549    if ( $priority == 0 || $priority == 11 ) {
550        if ( $Callbacks[$priority]->{$meth} ) {
551            return $class->trans_error("Two plugins are in conflict");
552        }
553    }
554    return $class->trans_error( "Invalid priority level [_1] at add_callback",
555        $priority )
556      if ( ( $priority < 0 ) || ( $priority > 11 ) );
557    require MT::Callback;
558    $CallbacksEnabled{$meth} = 1;
559    ## push @{$Plugins{$plugin_sig}{callbacks}}, "$meth Callback" if $plugin_sig;
560    my $cb = new MT::Callback(
561        plugin   => $plugin,
562        code     => $code,
563        priority => $priority,
564        internal => $internal,
565        method   => $meth
566    );
567    push @{ $Callbacks[$priority]->{$meth} }, $cb;
568    $cb;
569}
570
571sub remove_callback {
572    my $class    = shift;
573    my ($cb)     = @_;
574    my $priority = $cb->{priority};
575    my $method   = $cb->{method};
576    my $list     = $Callbacks[$priority];
577    return unless $list;
578    my $cbarr = $list->{$method};
579    return unless $cbarr;
580    @$cbarr = grep { $_ != $cb } @$cbarr;
581}
582
583# For use by MT internal code
584sub _register_core_callbacks {
585    my $class = shift;
586    my ($callback_table) = @_;
587    foreach my $name ( keys %$callback_table ) {
588        $class->add_callback( $name, 5, $mt_inst, $callback_table->{$name} )
589          || return;
590    }
591    1;
592}
593
594sub register_callbacks {
595    my $class = shift;
596    my ($callback_list) = @_;
597    foreach my $cb (@$callback_list) {
598        $class->add_callback( $cb->{name}, $cb->{priority}, $cb->{plugin},
599            $cb->{code} )
600          || return;
601    }
602    1;
603}
604
605our $CB_ERR;
606sub callback_error { $CB_ERR = $_[0]; }
607sub callback_errstr { $CB_ERR }
608
609sub run_callback {
610    my $class = shift;
611    my ( $cb, @args ) = @_;
612
613    $cb->error();    # reset the error string
614    my $result = eval { $cb->invoke(@args) };
615    if ( my $err = $@ ) {
616        $cb->error($err);
617        my $plugin = $cb->{plugin};
618        my $name;
619        if ( $cb->{internal} ) {
620            $name = "Internal callback";
621        }
622        elsif ( UNIVERSAL::isa( $plugin, 'MT::Plugin' ) ) {
623            $name = $plugin->name() || MT->translate("Unnamed plugin");
624        }
625        else {
626            $name = MT->translate("Unnamed plugin");
627        }
628        require MT::Log;
629        MT->log(
630            {
631                message => MT->translate( "[_1] died with: [_2]", $name, $err ),
632                class   => 'system',
633                category => 'callback',
634                level    => MT::Log::ERROR(),
635            }
636        );
637        return 0;
638    }
639    if ( $cb->errstr() ) {
640        return 0;
641    }
642    return $result;
643}
644
645# A callback should return a true/false value. The result of
646# run_callbacks is the logical AND of all the callback's return
647# values. Some hookpoints will ignore the return value: e.g. object
648# callbacks don't use it. By convention, those that use it have Filter
649# at the end of their names (CommentPostFilter, CommentThrottleFilter,
650# etc.)
651# Note: this composition is not short-circuiting. All callbacks are
652# executed even if one has already returned false.
653# ALSO NOTE: failure (dying or setting $cb->errstr) does not force a
654# "false" return.
655# THINK: are there cases where a true value should override all false values?
656# that is, where logical OR is the right way to compose multiple callbacks?
657sub run_callbacks {
658    my $class = shift;
659    my ( $meth, @args ) = @_;
660    return 1 unless $CallbacksEnabled && %CallbacksEnabled;
661    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
662    my @methods;
663
664    # execution:
665    #   Full::Name.<variant>
666    #   *::Name.<variant> OR Name.<variant>
667    #   Full::Name
668    #   *::Name OR Name
669    push @methods, $meth if $CallbacksEnabled{$meth};    # bleh::blah variant
670    if ( $meth =~ /::/ ) {    # presence of :: implies it's an obj. cb
671        my $name = $meth;
672        $name =~ s/^.*::([^:]*)$/$1/;
673        $name = $CallbackAlias{ '*::' . $name }
674          if exists $CallbackAlias{ '*::' . $name };
675        push @methods, '*::' . $name
676          if $CallbacksEnabled{ '*::' . $name };    # *::blah variant
677        push @methods, $name if $CallbacksEnabled{$name};    # blah variant
678    }
679    if ( $meth =~ /\./ ) {    # presence of ' ' implies it is a variant callback
680        my ($name) = split /\./, $meth, 2;
681        $name = $CallbackAlias{$name} if exists $CallbackAlias{$name};
682        push @methods, $name if $CallbacksEnabled{$name};    # bleh::blah
683        if ( $name =~ m/::/ ) {
684            my $name2 = $name;
685            $name2 =~ s/^.*::([^:]*)$/$1/;
686            $name2 = $CallbackAlias{ '*::' . $name2 }
687              if exists $CallbackAlias{ '*::' . $name2 };
688            push @methods, '*::' . $name2
689              if $CallbacksEnabled{ '*::' . $name2 };        # *::blah
690            push @methods, $name2 if $CallbacksEnabled{$name2};    # blah
691        }
692    }
693    return 1 unless @methods;
694
695    $CallbacksEnabled{$_} = 0 for @methods;
696    my @errors;
697    my $filter_value = 1;
698    my $first_error;
699
700    foreach my $callback_sheaf (@Callbacks) {
701        for my $meth (@methods) {
702            if ( my $set = $callback_sheaf->{$meth} ) {
703                for my $cb (@$set) {
704                    my $result = $class->run_callback( $cb, @args );
705                    $filter_value &&= $result;
706                    if ( !$result ) {
707                        if ( $cb->errstr() ) {
708                            push @errors, $cb->errstr();
709                        }
710                        if ( !defined($first_error) ) {
711                            $first_error = $cb->errstr();
712                        }
713                    }
714                }
715            }
716        }
717    }
718
719    callback_error( join( '', @errors ) );
720
721    $CallbacksEnabled{$_} = 1 for @methods;
722    if ( !$filter_value ) {
723        return $class->error($first_error);
724    }
725    else {
726        return $filter_value;
727    }
728}
729
730sub user_class {
731    shift->{user_class};
732}
733
734sub find_config {
735    my $mt = shift;
736    my ($param) = @_;
737
738    $param->{Config}    ||= $ENV{MT_CONFIG};
739    $param->{Directory} ||= $ENV{MT_HOME};
740    if ( !$param->{Directory} ) {
741        if ( $param->{Config} ) {
742            $param->{Directory} = dirname( $param->{Config} );
743        }
744        else {
745            $param->{Directory} = dirname($0) || $ENV{PWD} || '.';
746        }
747    }
748
749    # the directory is the more important parameter between it and
750    # the config parameter. if config is unreadable, then scan for
751    # a config file using the directory as a base.  we support
752    # either mt.cfg or mt-config.cgi for the config file name. the
753    # latter being a more secure choice since it is unreadable from
754    # a browser.
755    for my $cfg_file ( $param->{Config},
756        File::Spec->catfile( $param->{Directory}, 'mt-config.cgi' ),
757        'mt-config.cgi' )
758    {
759        return $cfg_file if $cfg_file && -r $cfg_file && -f $cfg_file;
760    }
761    return undef;
762}
763
764sub init_schema {
765    require MT::Object;
766    MT::Object->install_pre_init_properties();
767}
768
769sub init_permissions {
770    require MT::Permission;
771    MT::Permission->init_permissions;
772}
773
774sub init_config {
775    my $mt = shift;
776    my ($param) = @_;
777
778    my $cfg_file = $mt->find_config($param);
779    return $mt->error(
780"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
781    ) unless $cfg_file;
782    $cfg_file = File::Spec->rel2abs($cfg_file);
783
784    # translate the config file's location to an absolute path, so we
785    # can use that directory as a basis for calculating other relative
786    # paths found in the config file.
787    my $config_dir = $mt->{config_dir} = dirname($cfg_file);
788
789    # store the mt_dir (home) as an absolute path; fallback to the config
790    # directory if it isn't set.
791    $mt->{mt_dir} =
792      $param->{Directory}
793      ? File::Spec->rel2abs( $param->{Directory} )
794      : $mt->{config_dir};
795    $mt->{mt_dir} ||= dirname($0);
796
797    # also make note of the active application path; this is derived by
798    # checking the PWD environment variable, the dirname of $0,
799    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
800    $mt->{app_dir} = $ENV{PWD} || "";
801    $mt->{app_dir} = dirname($0)
802      if !$mt->{app_dir}
803      || !File::Spec->file_name_is_absolute( $mt->{app_dir} );
804    $mt->{app_dir} = dirname( $ENV{SCRIPT_FILENAME} )
805      if $ENV{SCRIPT_FILENAME}
806      && ( !$mt->{app_dir}
807        || ( !File::Spec->file_name_is_absolute( $mt->{app_dir} ) ) );
808    $mt->{app_dir} ||= $mt->{mt_dir};
809    $mt->{app_dir} = File::Spec->rel2abs( $mt->{app_dir} );
810
811    my $cfg = $mt->config;
812    $cfg->define( $mt->registry('config_settings') );
813    $cfg->read_config($cfg_file) or return $mt->error( $cfg->errstr );
814    $mt->{cfg_file} = $cfg_file;
815
816    my @mt_paths = $cfg->paths;
817    for my $meth (@mt_paths) {
818        my $path = $cfg->get( $meth, undef );
819        my $type = $cfg->type($meth);
820        if ( defined $path ) {
821            if ( $type eq 'ARRAY' ) {
822                my @paths = $cfg->get($meth);
823                local $_;
824                foreach (@paths) {
825                    next if File::Spec->file_name_is_absolute($_);
826                    $_ = File::Spec->catfile( $config_dir, $_ );
827                }
828                $cfg->$meth( \@paths );
829            }
830            else {
831                if ( !File::Spec->file_name_is_absolute($path) ) {
832                    $path = File::Spec->catfile( $config_dir, $path );
833                    $cfg->$meth($path);
834                }
835            }
836        }
837        else {
838            next if $type eq 'ARRAY';
839            my $path = $cfg->default($meth);
840            if ( defined $path ) {
841                $cfg->$meth( File::Spec->catfile( $config_dir, $path ) );
842            }
843        }
844    }
845
846    return $mt->trans_error("Bad ObjectDriver config")
847      unless $cfg->ObjectDriver;
848
849    if ( $MT::DebugMode = $cfg->DebugMode ) {
850        require Data::Dumper;
851        $Data::Dumper::Terse    = 1;
852        $Data::Dumper::Maxdepth = 4;
853        $Data::Dumper::Sortkeys = 1;
854        $Data::Dumper::Indent   = 1;
855    }
856
857    if ($cfg->PerformanceLogging && $cfg->ProcessMemoryCommand) {
858        $mt->log_times();
859    }
860
861    $mt->set_language( $cfg->DefaultLanguage );
862
863    my $cgi_path = $cfg->CGIPath;
864    if ( !$cgi_path || $cgi_path =~ m!http://www\.example\.com/! ) {
865        return $mt->trans_error("Bad CGIPath config");
866    }
867
868    $mt->{cfg} = $cfg;
869
870    1;
871}
872
873{
874my ($memory_start);
875sub log_times {
876    my $pkg = shift;
877
878    my $timer = $pkg->get_timer;
879    return unless $timer;
880
881    my $memory;
882    my $cmd = $pkg->config->ProcessMemoryCommand;
883    if ($cmd) {
884        my $re;
885        if (ref($cmd) eq 'HASH') {
886            $re = $cmd->{regex};
887            $cmd = $cmd->{command};
888        }
889        $cmd =~ s/\$\$/$$/g;
890        $memory = `$cmd`;
891        if ($re) {
892            if ($memory =~ m/$re/) {
893                $memory = $1;
894                $memory =~ s/\D//g;
895            }
896        } else {
897            $memory =~ s/\s+//gs;
898        }
899    }
900
901    # Called at the start of the process; so we're only recording
902    # the memory usage at the start of the app right now.
903    unless ($timer->{elapsed}) {
904        $memory_start = $memory;
905        return;
906    }
907
908    my $log_file;
909
910    # Log filename calcluation; changes daily, so we don't cache this
911    require File::Spec;
912    my $dir = File::Spec->catdir( MT->instance->static_file_path,
913        'support', 'logs');
914    if (! -d $dir) {
915        require File::Path;
916        eval { File::Path::mkpath([$dir], 0, 0777) };
917        if ($@) {
918            $log_file = 0;
919            return;
920        }
921    }
922    my @time = localtime(time);
923    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
924    $log_file = File::Spec->catfile( $dir, $file );
925
926    my $first_write = ! -f $log_file;
927
928    local *PERFLOG;
929    open PERFLOG, ">>$log_file";
930    require Fcntl;
931    flock(PERFLOG, Fcntl::LOCK_EX());
932
933    if ($first_write) {
934        require Config;
935        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
936        print PERFLOG "# Operating System: $osname/$osvers\n";
937        print PERFLOG "# Platform: $^O\n";
938        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
939        print PERFLOG "# Perl Version: $ver\n";
940        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
941        require MT::Object;
942        my $driver = MT::Object->driver;
943        if ($driver) {
944            my $dbh = $driver->r_handle;
945            if ($dbh) {
946                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
947                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
948                if ($dbname && $dbver) {
949                    print PERFLOG "# Database: $dbname/$dbver\n";
950                }
951            }
952        }
953        my ($drname, $drh) = each %DBI::installed_drh;
954        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
955        if ($ENV{MOD_PERL}) {
956            print PERFLOG "# App Mode: mod_perl\n";
957        }
958        elsif ($ENV{FAST_CGI}) {
959            print PERFLOG "# App Mode: FastCGI\n";
960        }
961        else {
962            print PERFLOG "# App Mode: CGI\n";
963        }
964    }
965
966    if ($memory) {
967        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
968    } else {
969        print PERFLOG $timer->dump_line();
970    }
971
972    close PERFLOG;
973}
974}
975
976sub get_timer {
977    my $mt = shift;
978    $mt = MT->instance unless ref $mt;
979    my $timer = $mt->request('timer');
980    unless (defined $timer) {
981        if (MT->config('PerformanceLogging')) {
982            my $uri;
983            if ($mt->isa('MT::App')) {
984                $uri = $mt->uri( args => { $mt->param_hash } );
985            }
986            require MT::Util::ReqTimer;
987            $timer = MT::Util::ReqTimer->new( $uri );
988        } else {
989            $timer = 0;
990        }
991        $mt->request('timer', $timer);
992    }
993    return $timer;
994}
995
996sub time_this {
997    my $mt = shift;
998    my ($str, $code) = @_;
999    my $timer = $mt->get_timer();
1000    my $ret;
1001    if ($timer) {
1002        $timer->pause_partial();
1003        $ret = $code->();
1004        $timer->mark($str);
1005    } else {
1006        $ret = $code->();
1007    }
1008    return $ret;
1009}
1010
1011sub init_config_from_db {
1012    my $mt = shift;
1013    my ($param) = @_;
1014    my $cfg = $mt->config;
1015    $cfg->read_config_db();
1016
1017    # Tell any instantiated drivers to reconfigure themselves as necessary
1018    MT::ObjectDriverFactory->configure;
1019
1020    1;
1021}
1022
1023sub bootstrap {
1024    my $pkg = shift;
1025    $pkg->init_paths() or return;
1026    $pkg->init_core()  or return;
1027}
1028
1029sub init_paths {
1030    my $mt = shift;
1031    my ($param) = @_;
1032
1033    # determine MT directory
1034    my ($orig_dir);
1035    require File::Spec;
1036    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1037        if ( $0 =~ m!(.*([/\\]))! ) {
1038            $orig_dir = $MT_DIR = $1;
1039            my $slash = $2;
1040            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1041            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1042        }
1043        else {
1044
1045            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1046            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1047        }
1048        unless ($MT_DIR) {
1049            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1050            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1051        }
1052        $ENV{MT_HOME} = $MT_DIR;
1053    }
1054    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1055    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1056      if $orig_dir && ( $orig_dir ne $MT_DIR );
1057
1058    $mt->set_language('__BUILD_LANGUAGE__');
1059
1060    if ( my $cfg_file = $mt->find_config($param) ) {
1061        $cfg_file = File::Spec->rel2abs($cfg_file);
1062        $CFG_FILE = $cfg_file;
1063    }
1064    else {
1065        return $mt->trans_error(
1066"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1067        ) if ref($mt);
1068    }
1069
1070    # store the mt_dir (home) as an absolute path; fallback to the config
1071    # directory if it isn't set.
1072    $MT_DIR ||=
1073      $param->{directory}
1074      ? File::Spec->rel2abs( $param->{directory} )
1075      : $CFG_DIR;
1076    $MT_DIR ||= dirname($0);
1077
1078    # also make note of the active application path; this is derived by
1079    # checking the PWD environment variable, the dirname of $0,
1080    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1081    $APP_DIR = $ENV{PWD} || "";
1082    $APP_DIR = dirname($0)
1083      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1084    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1085      if $ENV{SCRIPT_FILENAME}
1086      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1087    $APP_DIR ||= $MT_DIR;
1088    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1089
1090    return 1;
1091}
1092
1093sub init_core {
1094    my $mt = shift;
1095    return if exists $Components{'core'};
1096    require MT::Core;
1097    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1098      or die MT::Core->errstr;
1099    $Components{'core'} = $c;
1100
1101    # Additional locale-specific defaults
1102    my $defaults = $c->{registry}{config_settings};
1103    $defaults->{DefaultLanguage}{default} = '__BUILD_LANGUAGE__';
1104    $defaults->{NewsboxURL}{default} = '__NEWSBOX_URL__';
1105    $defaults->{LearningNewsURL}{default} = '__LEARNINGNEWS_URL__';
1106    $defaults->{SupportURL}{default} = '__SUPPORT_URL__';
1107    $defaults->{NewsURL}{default} = '__NEWS_URL__';
1108    #$defaults->{HelpURL}{default} = '__HELP_URL__';
1109    $defaults->{DefaultTimezone}{default} = '__DEFAULT_TIMEZONE__';
1110    $defaults->{TimeOffset}{default} = '__DEFAULT_TIMEZONE__';
1111    $defaults->{MailEncoding}{default} = '__MAIL_ENCODING__';
1112    $defaults->{ExportEncoding}{default} = '__EXPORT_ENCODING__';
1113    $defaults->{LogExportEncoding}{default} = '__LOG_EXPORT_ENCODING__';
1114    $defaults->{CategoryNameNodash}{default} = '__CATEGORY_NAME_NODASH__';
1115    $defaults->{PublishCharset}{default} = '__PUBLISH_CHARSET__';
1116
1117    push @Components, $c;
1118    return 1;
1119}
1120
1121sub init {
1122    my $mt    = shift;
1123    my %param = @_;
1124
1125    $mt->bootstrap() unless $MT_DIR;
1126    $mt->{mt_dir}     = $MT_DIR;
1127    $mt->{config_dir} = $CFG_DIR;
1128    $mt->{app_dir}    = $APP_DIR;
1129
1130    $mt->init_callbacks();
1131
1132    ## Initialize the language to the default in case any errors occur in
1133    ## the rest of the initialization process.
1134    $mt->init_config( \%param ) or return;
1135    $mt->init_addons(@_)       or return;
1136    $mt->init_config_from_db( \%param ) or return;
1137    $mt->init_plugins(@_)       or return;
1138    $plugins_installed = 1;
1139    $mt->init_schema();
1140    $mt->init_permissions();
1141
1142    # Load MT::Log so constants are available
1143    require MT::Log;
1144
1145    return $mt;
1146}
1147
1148sub init_callbacks {
1149    my $mt = shift;
1150    MT->_register_core_callbacks({
1151        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1152        'cms_upload_file' => \&core_upload_file_to_sync,
1153        'api_upload_file' => \&core_upload_file_to_sync,
1154    });
1155}
1156
1157sub core_upload_file_to_sync {
1158    my ($cb, %args) = @_;
1159    MT->upload_file_to_sync(%args);
1160}
1161
1162sub upload_file_to_sync {
1163    my $class = shift;
1164    my (%args) = @_;
1165
1166    # no need to do this unless we're syncing stuff.
1167    return unless MT->config('SyncTarget');
1168
1169    my $url = $args{url};
1170    my $file = $args{file};
1171    return unless -f $file;
1172
1173    my $blog = $args{blog};
1174    my $blog_id = $blog->id;
1175    return unless $blog->publish_queue;
1176
1177    require MT::FileInfo;
1178    my $base_url = $url;
1179    $base_url =~ s!^https?://[^/]+!!;
1180    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1181    if (!$fi) {
1182        $fi = new MT::FileInfo;
1183        $fi->blog_id($blog_id);
1184        $fi->url($base_url);
1185        $fi->file_path($file);
1186    } else {
1187        $fi->file_path($file);
1188    }
1189    $fi->save;
1190
1191    require MT::TheSchwartz;
1192    require TheSchwartz::Job;
1193    my $job = TheSchwartz::Job->new();
1194    $job->funcname('MT::Worker::Sync');
1195    $job->uniqkey( $fi->id );
1196    $job->coalesce( ( $fi->blog_id || 0 ) . ':' . $$ . ':' . ( time - ( time % 10 ) ) );
1197    MT::TheSchwartz->insert($job);
1198}
1199
1200sub init_addons {
1201    my $mt = shift;
1202    my $cfg = $mt->config;
1203    my @PluginPaths;
1204
1205    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1206    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1207}
1208
1209sub init_plugins {
1210    my $mt = shift;
1211
1212    # Load compatibility module for prior version
1213    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1214    require MT::Compat::v3;
1215
1216    require MT::Plugin;
1217    my $cfg          = $mt->config;
1218    my $use_plugins  = $cfg->UsePlugins;
1219    my @PluginPaths  = $cfg->PluginPath;
1220    my $PluginSwitch = $cfg->PluginSwitch || {};
1221    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1222}
1223
1224sub _init_plugins_core {
1225    my $mt = shift;
1226    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1227
1228    my $timer;
1229    if ($mt->config->PerformanceLogging) {
1230        $timer = $mt->get_timer();
1231    }
1232
1233    foreach my $PluginPath (@$PluginPaths) {
1234        my $plugin_lastdir = $PluginPath;
1235        $plugin_lastdir =~ s![\\/]$!!;
1236        $plugin_lastdir =~ s!.*[\\/]!!;
1237        local *DH;
1238        if ( opendir DH, $PluginPath ) {
1239            my @p = readdir DH;
1240          PLUGIN:
1241            for my $plugin (@p) {
1242                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1243
1244                my $load_plugin = sub {
1245                    my ( $plugin, $sig ) = @_;
1246                    die "Bad plugin filename '$plugin'"
1247                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1248                    local $plugin_sig      = $sig;
1249                    local $plugin_registry = {};
1250                    $plugin = $1;
1251                    if (
1252                        !$use_plugins
1253                        || ( exists $PluginSwitch->{$plugin_sig}
1254                            && !$PluginSwitch->{$plugin_sig} )
1255                      )
1256                    {
1257                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1258                        $Plugins{$plugin_sig}{enabled}   = 0;
1259                        return 0;
1260                    }
1261                    return 0 if exists $Plugins{$plugin_sig};
1262                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1263                    $timer->pause_partial if $timer;
1264                    eval { require $plugin };
1265                    $timer->mark("Loaded plugin " . $sig) if $timer;
1266                    if ($@) {
1267                        $Plugins{$plugin_sig}{error} = $@;
1268                        # Issue MT log within another eval block in the
1269                        # event that the plugin error is happening before
1270                        # the database has been initialized...
1271                        eval {
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 ($mt->{component}) {
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',   delete $param->{'blog'} )   if $param->{'blog'};
2254    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2255    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2256    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2257      if $param->{'commenter'};
2258    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2259    $ctx->stash( 'category', delete $param->{'category'} )
2260      if $param->{'category'};
2261    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2262
2263    foreach my $p (%$param) {
2264        if ( ref($p) ) {
2265            $tmpl->param( $p, $param->{$p} );
2266        }
2267    }
2268    return $mt->build_page_in_mem( $tmpl, $param );
2269}
2270
2271sub get_next_sched_post_for_user {
2272    my ( $author_id, @further_blog_ids ) = @_;
2273    require MT::Permission;
2274    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2275    my @blogs = @further_blog_ids;
2276    for my $perm (@perms) {
2277        next
2278          unless ( $perm->can_edit_config
2279            || $perm->can_publish_post
2280            || $perm->can_edit_all_posts );
2281        push @blogs, $perm->blog_id;
2282    }
2283    my $next_sched_utc = undef;
2284    require MT::Entry;
2285    for my $blog_id (@blogs) {
2286        my $blog           = MT::Blog->load($blog_id)
2287            or next;
2288        my $earliest_entry = MT::Entry->load(
2289            {
2290                status  => MT::Entry::FUTURE(),
2291                blog_id => $blog_id
2292            },
2293            { 'sort' => 'created_on' }
2294        );
2295        if ($earliest_entry) {
2296            my $entry_utc =
2297              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2298            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2299                $next_sched_utc = $entry_utc;
2300            }
2301        }
2302    }
2303    return $next_sched_utc;
2304}
2305
2306our %Commenter_Auth;
2307
2308sub init_commenter_authenticators {
2309    my $self = shift;
2310    my $auths = $self->registry("commenter_authenticators") || {};
2311    foreach my $auth ( keys %$auths ) {
2312        delete $auths->{$auth}
2313          if exists( $auths->{$auth}->{condition} )
2314          && !( $auths->{$auth}->{condition}->() );
2315    }
2316    %Commenter_Auth = %$auths;
2317    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2318}
2319
2320sub commenter_authenticator {
2321    my $self = shift;
2322    my ($key) = @_;
2323    %Commenter_Auth or $self->init_commenter_authenticators();
2324    return $Commenter_Auth{$key};
2325}
2326
2327sub commenter_authenticators {
2328    my $self = shift;
2329    %Commenter_Auth or $self->init_commenter_authenticators();
2330    return values %Commenter_Auth;
2331}
2332
2333sub _commenter_auth_params {
2334    my ( $key, $blog_id, $entry_id, $static ) = @_;
2335    my $params = {
2336        blog_id => $blog_id,
2337        static  => $static,
2338    };
2339    $params->{entry_id} = $entry_id if defined $entry_id;
2340    return $params;
2341}
2342
2343sub _openid_commenter_condition {
2344    eval "require Digest::SHA1;";
2345    return $@ ? 0 : 1;
2346}
2347
2348sub core_commenter_authenticators {
2349    return {
2350        'OpenID' => {
2351            class      => 'MT::Auth::OpenID',
2352            label      => 'OpenID',
2353            login_form => <<OpenID,
2354<form method="post" action="<mt:var name="script_url">">
2355<input type="hidden" name="__mode" value="login_external" />
2356<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2357<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2358<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2359<fieldset>
2360<mtapp:setting
2361    id="openid_display"
2362    label="<__trans phrase="OpenID URL">"
2363    hint="<__trans phrase="Sign in using your OpenID identity.">">
2364<input type="hidden" name="key" value="OpenID" />
2365<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%;" />
2366    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2367</mtapp:setting>
2368
2369<div class="pkg">
2370<div class="left"><input type="submit" name="submit" value="<__trans phrase="Sign In">" /></div>
2371<div class="right"><img src="<mt:var name="static_uri">images/comment/openid_enabled.png" /></div>
2372</div>
2373<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>
2374</fieldset>
2375</form>
2376OpenID
2377            login_form_params => \&_commenter_auth_params,
2378            condition         => \&_openid_commenter_condition,
2379            logo              => 'images/comment/signin_openid.png',
2380            logo_small        => 'images/comment/openid_logo.png',
2381        },
2382        'LiveJournal' => {
2383            class      => 'MT::Auth::LiveJournal',
2384            label      => 'LiveJournal',
2385            login_form => <<LiveJournal,
2386<form method="post" action="<mt:var name="script_url">">
2387<input type="hidden" name="__mode" value="login_external" />
2388<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2389<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2390<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2391<input type="hidden" name="key" value="LiveJournal" />
2392<fieldset>
2393<mtapp:setting
2394    id="livejournal_display"
2395    label="<__trans phrase="Your LiveJournal Username">"
2396    hint="<__trans phrase="Sign in using your Vox blog URL">">
2397<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%;" />
2398</mtapp:setting>
2399<div class="actions-bar actions-bar-login">
2400    <div class="actions-bar-inner pkg actions">
2401        <button
2402            type="submit"
2403            class="primary-button"
2404            ><__trans phrase="Sign in"></button>
2405    </div>
2406</div>
2407<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>
2408</fieldset>
2409</form>
2410LiveJournal
2411            login_form_params => \&_commenter_auth_params,
2412            condition         => \&_openid_commenter_condition,
2413            logo              => 'images/comment/signin_livejournal.png',
2414            logo_small        => 'images/comment/livejournal_logo.png',
2415        },
2416        'Vox' => {
2417            class      => 'MT::Auth::Vox',
2418            label      => 'Vox',
2419            login_form => <<Vox,
2420<form method="post" action="<mt:var name="script_url">">
2421<input type="hidden" name="__mode" value="login_external" />
2422<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2423<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2424<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2425<input type="hidden" name="key" value="Vox" />
2426<fieldset>
2427<mtapp:setting
2428    id="vox_display"
2429    label="<__trans phrase="Your Vox Blog URL">">
2430http:// <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
2431</mtapp:setting>
2432<div class="actions-bar actions-bar-login">
2433    <div class="actions-bar-inner pkg actions">
2434        <button
2435            type="submit"
2436            class="primary-button"
2437            ><__trans phrase="Sign in"></button>
2438    </div>
2439</div>
2440<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>
2441</fieldset>
2442</form>
2443Vox
2444            login_form_params => \&_commenter_auth_params,
2445            condition         => \&_openid_commenter_condition,
2446            logo              => 'images/comment/signin_vox.png',
2447            logo_small        => 'images/comment/vox_logo.png',
2448        },
2449        'TypeKey' => {
2450            class      => 'MT::Auth::TypeKey',
2451            label      => 'TypeKey',
2452            login_form => <<TypeKey,
2453<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>
2454<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>
2455TypeKey
2456            login_form_params => sub {
2457                my ( $key, $blog_id, $entry_id, $static ) = @_;
2458                my $entry = MT::Entry->load($entry_id) if $entry_id;
2459
2460                ## TypeKey URL
2461                require MT::Template::Context;
2462                my $ctx = MT::Template::Context->new;
2463                $ctx->stash( 'blog_id', $blog_id );
2464                my $blog = MT::Blog->load($blog_id);
2465                $ctx->stash( 'blog',  $blog );
2466                $ctx->stash( 'entry', $entry );
2467                my $params = {};
2468                $params->{tk_signin_url} =
2469                  MT::Template::Context::_hdlr_remote_sign_in_link( $ctx,
2470                    { static => $static } );
2471                return $params;
2472            },
2473            logo => 'images/comment/signin_typekey.png',
2474            logo_small        => 'images/comment/typekey_logo.png',
2475        },
2476    };
2477}
2478
2479our %Captcha_Providers;
2480
2481sub captcha_provider {
2482    my $self = shift;
2483    my ($key) = @_;
2484    $self->init_captcha_providers() unless %Captcha_Providers;
2485    return $Captcha_Providers{$key};
2486}
2487
2488sub captcha_providers {
2489    my $self = shift;
2490    $self->init_captcha_providers() unless %Captcha_Providers;
2491    my $def  = delete $Captcha_Providers{'mt_default'};
2492    my @vals = values %Captcha_Providers;
2493    if ( defined($def) && $def->{condition}->() ) {
2494        unshift @vals, $def;
2495    }
2496    @vals;
2497}
2498
2499sub core_captcha_providers {
2500    return {
2501        'mt_default' => {
2502            label     => 'Movable Type default',
2503            class     => 'MT::Util::Captcha',
2504            condition => sub {
2505                require MT::Util::Captcha;
2506                if ( my $error = MT::Util::Captcha->check_availability ) {
2507                    return 0;
2508                }
2509                1;
2510            },
2511        }
2512    };
2513}
2514
2515sub init_captcha_providers {
2516    my $self = shift;
2517    my $providers = $self->registry("captcha_providers") || {};
2518    foreach my $provider ( keys %$providers ) {
2519        delete $providers->{$provider}
2520          if exists( $providers->{$provider}->{condition} )
2521          && !( $providers->{$provider}->{condition}->() );
2522    }
2523    %Captcha_Providers = %$providers;
2524    $Captcha_Providers{$_}{key} ||= $_ for keys %Captcha_Providers;
2525}
2526
2527sub effective_captcha_provider {
2528    my $class = shift;
2529    my ($key) = @_;
2530    return undef unless $key;
2531    my $cp = $class->captcha_provider($key) or return;
2532    if ( exists $cp->{condition} ) {
2533        return undef unless $cp->{condition}->();
2534    }
2535    my $pkg = $cp->{class};
2536    $pkg =~ s/;//g;
2537    eval "require $pkg" or return;
2538    return $cp->{class};
2539}
2540
2541sub handler_to_coderef {
2542    my $pkg = shift;
2543    my ( $name, $delayed ) = @_;
2544
2545    return $name if ref($name) eq 'CODE';
2546    return undef unless defined $name && $name ne '';
2547
2548    my $code;
2549    if ( $name !~ m/->/ ) {
2550
2551        # check for Package::Routine first; if defined, return coderef
2552        no strict 'refs';
2553        $code = \&$name if defined &$name;
2554        return $code if $code;
2555    }
2556
2557    my $component;
2558    if ( $name =~ m!^\$! ) {
2559        if ( $name =~ s/^\$(\w+)::// ) {
2560            $component = $1;
2561        }
2562    }
2563    if ( $name =~ m/^\s*sub\s*\{/s ) {
2564        $code = eval $name or die $@;
2565
2566        if ($component) {
2567            return sub {
2568                my $mt_inst = MT->instance;
2569                local $mt_inst->{component} = $component;
2570                $code->(@_);
2571            };
2572        }
2573        else {
2574            return $code;
2575        }
2576    }
2577
2578    my $hdlr_pkg = $name;
2579    my $method;
2580    if ( $hdlr_pkg =~ s/(->|::)([^:]+)$// ) {    # strip routine name
2581        $method = $2 if $1 eq '->';
2582    }
2583    if ( !defined(&$name) && !$pkg->can( 'AUTOLOAD' ) ) {
2584
2585        # The delayed option will return a coderef that delays the loading
2586        # of the package holding the handler routine.
2587        if ($delayed) {
2588            if ($method) {
2589                return sub {
2590                    eval "require $hdlr_pkg;"
2591                      or Carp::confess(
2592                        "failed loading package $hdlr_pkg for routine $name: $@");
2593                    my $mt_inst = MT->instance;
2594                    local $mt_inst->{component} = $component
2595                      if $component;
2596                    return $hdlr_pkg->$method(@_);
2597                };
2598            }
2599            else {
2600                return sub {
2601                    eval "require $hdlr_pkg;"
2602                      or Carp::confess(
2603                        "failed loading package $hdlr_pkg for routine $name: $@");
2604                    my $mt_inst = MT->instance;
2605                    local $mt_inst->{component} = $component
2606                      if $component;
2607                    no strict 'refs';
2608                    my $hdlr = \&$name;
2609                    use strict 'refs';
2610                    return $hdlr->(@_);
2611                };
2612            }
2613        }
2614        else {
2615            eval "require $hdlr_pkg;"
2616              or Carp::confess(
2617                "failed loading package $hdlr_pkg for routine $name: $@");
2618        }
2619    }
2620    if ($method) {
2621        $code = sub {
2622            my $mt_inst = MT->instance;
2623            local $mt_inst->{component} = $component
2624              if $component;
2625            return $hdlr_pkg->$method(@_);
2626        };
2627    }
2628    else {
2629        if ($component) {
2630            $code = sub {
2631                no strict 'refs';
2632                my $hdlr = (
2633                    defined &$name ? \&$name
2634                    : ( $pkg->can( 'AUTOLOAD' ) ? \&$name
2635                        : undef )
2636                );
2637                use strict 'refs';
2638                if ($hdlr) {
2639                    my $mt_inst = MT->instance;
2640                    local $mt_inst->{component} = $component
2641                      if $component;
2642                    return $hdlr->(@_);
2643                }
2644                return undef;
2645              }
2646        }
2647        else {
2648            no strict 'refs';
2649            $code =
2650              (
2651                defined &$name
2652                ? \&$name
2653                : ( $hdlr_pkg->can( 'AUTOLOAD' ) ? \&$name : undef )
2654              );
2655        }
2656    }
2657    return $code;
2658}
2659
2660sub help_url {
2661    my $pkg = shift;
2662    my ( $append ) = @_;
2663
2664    my $url = $pkg->config->HelpURL;
2665    return $url if defined $url;
2666    $url = $pkg->translate('http://www.movabletype.org/documentation/');
2667    if ( $append ) {
2668        $url .= $append;
2669    }
2670    $url;
2671}
2672
2673sub register_refresh_cache_event {
2674    my $pkg = shift;
2675    my ($callback) = @_;
2676    return unless $callback;
2677
2678    MT->_register_core_callbacks({
2679        "$callback" => \&refresh_cache,
2680    });
2681}
2682
2683sub refresh_cache {
2684    my ($cb, %args) = @_;
2685
2686    require MT::Cache::Negotiate;
2687    my $cache_driver = MT::Cache::Negotiate->new();
2688    return unless $cache_driver;
2689
2690    $cache_driver->flush_all();
2691}
2692
2693sub DESTROY {
2694    # save_config here so not to miss any dirty config change to persist
2695    # particulary for those which does not construct MT::App.
2696    $_[0]->config->save_config();
2697}
2698
26991;
2700
2701__END__
2702
2703=head1 NAME
2704
2705MT - Movable Type
2706
2707=head1 SYNOPSIS
2708
2709    use MT;
2710    my $mt = MT->new;
2711    $mt->rebuild(BlogID => 1)
2712        or die $mt->errstr;
2713
2714=head1 DESCRIPTION
2715
2716The I<MT> class is the main high-level rebuilding/pinging interface in the
2717Movable Type library. It handles all rebuilding operations. It does B<not>
2718handle any of the application functionality--for that, look to I<MT::App> and
2719I<MT::App::CMS>, both of which subclass I<MT> to handle application requests.
2720
2721=head1 PLUGIN APPLICATIONS
2722
2723At any given time, the user of the Movable Type platform is
2724interacting with either the core Movable Type application, or a plugin
2725application (or "sub-application").
2726
2727A plugin application is a plugin with a user interface that inherits
2728functionality from Movable Type, and appears to the user as a
2729component of Movable Type. A plugin application typically has its own
2730templates displaying its own special features; but it inherits some
2731templates from Movable Type, such as the navigation chrome and error
2732pages.
2733
2734=head2 The MT Root and the Application Root
2735
2736To locate assets of the core Movable Type application and any plugin
2737applications, the platform uses two directory paths, C<mt_dir> and
2738C<app_dir>. These paths are returned by the MT class methods with the
2739same names, and some other methods return derivatives of these paths.
2740
2741Conceptually, mt_dir is the root of the Movable Type installation, and
2742app_dir is the root of the "currently running application", which
2743might be Movable Type or a plugin application. It is important to
2744understand the distinction between these two values and what each is
2745used for.
2746
2747The I<mt_dir> is the absolute path to the directory where MT itself is
2748located. Most importantly, the MT configuration file and the CGI scripts that
2749bootstrap an MT request are found here. This directory is also the
2750default base path under which MT's core templates are found (but this
2751can be overridden using the I<TemplatePath> configuration setting).
2752
2753Likewise, the I<app_dir> is the directory where the "current"
2754application's assets are rooted. The platform will search for
2755application templates underneath the I<app_dir>, but this search also
2756searches underneath the I<mt_dir>, allowing the application to make
2757use of core headers, footers, error pages, and possibly other
2758templates.
2759
2760In order for this to be useful, the plugin's templates and
2761code should all be located underneath the same directory. The relative
2762path from the I<app_dir> to the application's templates is
2763configurable. For details on how to indicate the location of your
2764plugin's templates, see L<MT::App>.
2765
2766=head2 Finding the Root Paths
2767
2768When a plugin application initializes its own application class (a
2769subclass of MT::App), the I<mt_dir> should be discovered and passed
2770constructor. This comes either from the C<Directory> parameter or the
2771C<Config> parameter.
2772
2773Since plugins are loaded from a descendent of the MT root directory,
2774the plugin bootstrap code can discover the MT configuration file (and thus
2775the MT root directory) by traversing the filesystem; the absolute path
2776to that file can be passed as the C<Config> parameter to
2777MT::App::new. Working code to do this can be found in the
2778examples/plugins/mirror/mt-mirror.cgi file.
2779
2780The I<app_dir>, on the other hand, always derives from the location of
2781the currently-running program, so it typically does not need to be
2782specified.
2783
2784=head1 USAGE
2785
2786I<MT> has the following interface. On failure, all methods return C<undef>
2787and set the I<errstr> for the object or class (depending on whether the
2788method is an object or class method, respectively); look below at the section
2789L<ERROR HANDLING> for more information.
2790
2791=head2 MT->new( %args )
2792
2793Constructs a new I<MT> instance and returns that object. Returns C<undef>
2794on failure.
2795
2796I<new> will also read your MT configuration file (provided that it can find it--if
2797you find that it can't, take a look at the I<Config> directive, below). It
2798will also initialize the chosen object driver; the default is the C<DBM>
2799object driver.
2800
2801I<%args> can contain:
2802
2803=over 4
2804
2805=item * Config
2806
2807Path to the MT configuration file.
2808
2809If you do not specify a path, I<MT> will try to find your MT configuration file
2810in the current working directory.
2811
2812=item * Directory
2813
2814Path to the MT home directory.
2815
2816If you do not specify a path, I<MT> will try to find the MT directory using
2817the discovered path of the MT configuration file.
2818
2819=back
2820
2821=head2 $mt->init
2822
2823Initializes the Movable Type instance, including registration of basic
2824resources and callbacks. This method also invokes the C<init_config>
2825and C<init_plugins> methods.
2826
2827=head2 MT->instance
2828
2829MT and all it's subclasses are now singleton classes, meaning you can only
2830have one instance per package. MT->instance() returns the active instance.
2831MT->new() is now an alias to instance_of.
2832
2833=head2 $class->instance_of
2834
2835Returns the singleton instance of the MT subclass identified by C<$class>.
2836
2837=head2 $class->construct
2838
2839Constructs a new instance of the MT subclass identified by C<$class>.
2840
2841=head2 MT->set_instance
2842
2843Assigns the active MT instance object. This value is returned when
2844C<MT-E<gt>instance> is invoked.
2845
2846=head2 $mt->find_config($params)
2847
2848Handles the discovery of the MT configuration file. The path and filename
2849for the configuration file is returned as the result. The C<$params>
2850parameter is a reference to the hash of settings passed to the MT
2851constructor.
2852
2853=head2 $mt->init_config($params)
2854
2855Reads the MT configuration settingss from the MT configuration file
2856and settings from database (L<MT::Config>).
2857
2858The C<$params> parameter is a reference to the hash of settings passed to
2859the MT constructor.
2860
2861=head2 $mt->init_plugins
2862
2863Loads any discoverable plugins that are available. This is called from
2864the C<init> method, after the C<init_config> method has loaded the
2865configuration settings.
2866
2867=head2 $mt->init_tasks
2868
2869Registers the standard set of periodic tasks that Movable Type provides
2870and then invokes the C<init_tasks> method for each available plugin.
2871
2872=head2 MT->run_tasks
2873
2874Initializes the tasks, running C<init_tasks> and invokes the task system
2875through L<MT::TaskMgr> to run any registered tasks that are pending
2876execution. See L<MT::TaskMgr> for further documentation.
2877
2878=head2 MT->unplug
2879
2880Removes the global reference to the MT instance.
2881
2882=head2 MT::log( $message ) or $mt->log( $message )
2883
2884Adds an entry to the application's log table. Also writes message to
2885STDERR which is typically routed to the web server's error log.
2886
2887=head2 $mt->server_path, $mt->mt_dir
2888
2889Both of these methods return the physical file path to the directory
2890that is the home of the MT installation. This would be the value of
2891the 'Directory' parameter given in the MT constructor, or would be
2892determined based on the path of the configuration file.
2893
2894=head2 $mt->app_dir
2895
2896Returns the physical file path to the active application directory. This
2897is determined by the directory of the active script.
2898
2899=head2 $mt->config_dir
2900
2901Returns the path to the MT configuration file.
2902
2903=head2 $mt->config([$setting[, $value]])
2904
2905This method is used to get and set configuration settings. When called
2906without any parameters, it returns the active MT::ConfigMgr instance
2907used by the application.
2908
2909Specifying the C<$setting> parameter will return the value for that setting.
2910When passing the C<$value> parameter, this will update the config object,
2911assigning that value for the named C<$setting>.
2912
2913=head2 $mt->user_class
2914
2915Returns the package name for the class used for user authentication.
2916This is typically L<MT::Author>.
2917
2918=head2 $mt->request([$element[,$data]])
2919
2920The request method provides a request-scoped storage object. It is an
2921access interface for the L<MT::Request> package. Calling without any
2922parameters will return the L<MT::Request> instance.
2923
2924When called with the C<$element> parameter, the data stored for that
2925element is returned (or undef, if it didn't exist). When called with
2926the C<$data> parameter, it will store the data into the specified
2927element in the request object.
2928
2929All values placed in the request object are lost at the end of the
2930request. If the running application is not a web-based application,
2931the request object exists for the lifetime of the process and is
2932released when the process ends.
2933
2934See the L<MT::Request> package for more information.
2935
2936=head2 MT->new_ua
2937
2938Returns a new L<LWP::UserAgent> instance that is configured according to the
2939Movable Type configuration settings (specifically C<HTTPInterface>, C<HTTPTimeout>, C<HTTPProxy> and C<HTTPNoProxy>). The agent string is set
2940to "MovableType/(version)" and is also limited to receiving a response of
2941100,000 bytes by default (you can override this by using the 'max_size'
2942method on the returned instance). Using this method is recommended for
2943any HTTP requests issued by Movable Type since it uses the MT configuration
2944settings to prepare the UserAgent object.
2945
2946=head2 $mt->ping( %args )
2947
2948Sends all configured XML-RPC pings as a way of notifying other community
2949sites that your blog has been updated.
2950
2951I<%args> can contain:
2952
2953=over 4
2954
2955=item * Blog
2956
2957An I<MT::Blog> object corresponding to the blog for which you would like to
2958send the pings.
2959
2960Either this or C<BlogID> is required.
2961
2962=item * BlogID
2963
2964The ID of the blog for which you would like to send the pings.
2965
2966Either this or C<Blog> is required.
2967
2968=back
2969
2970=head2 $mt->ping_and_save( %args )
2971
2972Handles the task of issuing any pending ping operations for a given
2973entry and then saving that entry back to the database.
2974
2975The I<%args> hash should contain an element named C<Entry> that is a
2976reference to a L<MT::Entry> object.
2977
2978=head2 $mt->needs_ping(%param)
2979
2980Returns a list of URLs that have not been pinged for a given entry. Named
2981parameters for this method are:
2982
2983=over 4
2984
2985=item Entry
2986
2987The L<MT::Entry> object to examine.
2988
2989=item Blog
2990
2991The L<MT::Blog> object that is the parent of the entry given.
2992
2993=back
2994
2995The return value is an array reference of URLs that have not been pinged
2996for the given entry.
2997
2998An empty list is returned for entries that have a non 'RELEASE' status.
2999
3000=head2 $mt->update_ping_list($blog)
3001
3002Returns a list of URLs for ping services that have been configured to
3003be notified when posting new entries.
3004
3005=head2 $mt->set_language($tag)
3006
3007Loads the localization plugin for the language specified by I<$tag>, which
3008should be a valid and supported language tag--see I<supported_languages> to
3009obtain a list of supported languages.
3010
3011The language is set on a global level, and affects error messages and all
3012text in the administration system.
3013
3014This method can be called as either a class method or an object method; in
3015other words,
3016
3017    MT->set_language($tag)
3018
3019will also work. However, the setting will still be global--it will not be
3020specified to the I<$mt> object.
3021
3022The default setting--set when I<MT::new> is called--is U.S. English. If a
3023I<DefaultLanguage> is set in the MT configuration file, the default is then
3024set to that language.
3025
3026=head2 MT->translate($str[, $param, ...])
3027
3028Translates I<$str> into the currently-set language (set by I<set_language>),
3029and returns the translated string. Any parameters following I<$str> are
3030passed through to the C<maketext> method of the active localization module.
3031
3032=head2 MT->translate_templatized($str)
3033
3034Translates a string that has embedded E<lt>MT_TRANSE<gt> tags. These
3035tags identify the portions of the string that require localization.
3036Each tag is processed separately and passed through the MT->translate
3037method. Examples (used in your application's HTML::Template templates):
3038
3039    <p><MT_TRANS phrase="Hello, world"></p>
3040
3041and
3042
3043    <p><MT_TRANS phrase="Hello, [_1]" params="<TMPL_VAR NAME=NAME>"></p>
3044
3045=head2 $mt->trans_error( $str[, $arg1, $arg2] )
3046
3047Translates I<$str> into the currently-set language (set by I<set_language>),
3048and assigns it as the active error for the MT instance. It returns undef,
3049which is the usual return value upon generating an error in the application.
3050So when an error occurs, the typical return result would be:
3051
3052    if ($@) {
3053        return $app->trans_error("An error occurred: [_1]", $@);
3054    }
3055
3056The optional I<$arg1> (and so forth) parameters are passed as parameters to
3057any parameterized error message.
3058
3059=head2 $mt->current_language
3060
3061Returns the language tag for the currently-set language.
3062
3063=head2 MT->supported_languages
3064
3065Returns a reference to an associative array mapping language tags to their
3066proper names. For example:
3067
3068    use MT;
3069    my $langs = MT->supported_languages;
3070    print map { $_ . " => " . $langs->{$_} . "\n" } keys %$langs;
3071
3072=head2 MT->language_handle
3073
3074Returns the active MT::L10N language instance for the active language.
3075
3076=head2 MT->add_plugin($plugin)
3077
3078Adds the plugin described by $plugin to the list of plugins displayed
3079on the welcome page. The argument should be an object of the
3080I<MT::Plugin> class.
3081
3082=head2 MT->all_text_filters
3083
3084Returns a reference to a hash containing the registry of text filters.
3085
3086=head2 MT->apply_text_filters($str, \@filters)
3087
3088Applies the set of filters I<\@filters> to the string I<$str> and returns
3089the result (the filtered string).
3090
3091I<\@filters> should be a reference to an array of filter keynames--these
3092are the short names passed in as the first argument to I<add_text_filter>.
3093I<$str> should be a scalar string to be filtered.
3094
3095If one of the filters listed in I<\@filters> is not found in the list of
3096registered filters (that is, filters added through I<add_text_filter>),
3097it will be skipped silently. Filters are executed in the order in which they
3098appear in I<\@filters>.
3099
3100As it turns out, the I<MT::Entry::text_filters> method returns a reference
3101to the list of text filters to be used for that entry. So, for example, to
3102use this method to apply filters to the main entry text for an entry
3103I<$entry>, you would use
3104
3105    my $out = MT->apply_text_filters($entry->text, $entry->text_filters);
3106
3107=head2 MT->add_callback($meth, $priority, $plugin, $code)
3108
3109Registers a new callback handler for a particular registered callback.
3110
3111The first parameter is the name of the callback method. The second
3112parameter is a priority (a number in the range of 1-10) which will control
3113the order that the handler is executed in relation to other handlers. If
3114two handlers register with the same priority, they will be executed in
3115the order that they registered. The third parameter is a C<MT::Plugin> object
3116reference that is associated with the handler (this parameter is optional).
3117The fourth parameter is a code reference that is invoked to handle the
3118callback. For example:
3119
3120    MT->add_callback('BuildFile', 1, undef, \&rebuild_file_hdlr);
3121
3122The code reference should expect to receive an object of type
3123L<MT::Callback> as its first argument. This object is used to
3124communicate errors to the caller:
3125
3126    sub rebuild_file_hdlr {
3127        my ($cb, ...) = @_;
3128        if (something bad happens) {
3129            return $cb->error("Something bad happened!");
3130        }
3131    }
3132
3133Other parameters to the callback function depend on the callback point.
3134
3135The treatment of the error string depends on the callback point.
3136Typically, either it is ignored or the user's action fails and the
3137error message is displayed.
3138
3139The value returned from this method is the new L<MT::Callback> object.
3140
3141=head2 MT->remove_callback($callback)
3142
3143Removes a callback that was previously registered.
3144
3145=head2 MT->register_callbacks([...])
3146
3147Registers several callbacks simultaneously. Each element in the array
3148parameter given should be a hashref containing these elements: C<name>,
3149C<priority>, C<plugin> and C<code>.
3150
3151=head2 MT->run_callbacks($meth[, $arg1, $arg2, ...])
3152
3153Invokes a particular callback, running any associated callback handlers.
3154
3155The first parameter is the name of the callback to execute. This is one
3156of the global callback methods (see L<Callbacks> section) or can be
3157a class-specific method that includes the package name associated with
3158the callback.
3159
3160The remaining arguments are passed through to any callback handlers that
3161are invoked.
3162
3163For "Filter"-type callbacks, this routine will return a 0 if any of the
3164handlers return a false result. If all handlers return a true result,
3165a value of 1 is returned.
3166
3167Example:
3168
3169    MT->run_callbacks('MyClass::frobnitzes', \@whirlygigs);
3170
3171Which would execute any handlers that registered in this fashion:
3172
3173    MT->add_callback('MyClass::frobnitzes', 4, $plugin, \&frobnitz_hdlr);
3174
3175=head2 MT->run_callback($cb[, $arg1, $arg2, ...])
3176
3177An internal routine used by C<run_callbacks> to invoke a single
3178L<MT::Callback>.
3179
3180=head2 callback_error($str)
3181
3182This routine is used internally by C<MT::Callback> to set any error response
3183that comes from invoking a callback.
3184
3185=head2 callback_errstr
3186
3187This internal routine returns the error response stored using the
3188C<callback_error> routine.
3189
3190=head2 MT->product_code
3191
3192The product code identifying the Movable Type product that is installed.
3193This is either 'MTE' for Movable Type Enterprise or 'MT' for the
3194non-Enterprise product.
3195
3196=head2 MT->product_name
3197
3198The name of the Movable Type product that is installed. This is either
3199'Movable Type Enterprise' or 'Movable Type Publishing Platform'.
3200
3201=head2 MT->product_version
3202
3203The version number of the product. This is different from the C<version_id>
3204and C<version_number> methods as they report the API version information.
3205
3206=head2 MT->version_id
3207
3208Returns the API version of MT (including any beta/alpha designations).
3209
3210=head2 MT->version_number
3211
3212Returns the numeric API version of MT (without any beta/alpha designations).
3213For example, if I<version_id> returned C<2.5b1>, I<version_number> would
3214return C<2.5>.
3215
3216=head2 MT->schema_version
3217
3218Returns the version of the MT database schema.
3219
3220=head2 MT->version_slug
3221
3222Returns a string of text that is appended to emails sent through the
3223C<build_email> method.
3224
3225=head2 $mt->publisher
3226
3227Returns the L<MT::WeblogPublisher> object that is used for managing the
3228MT publishing process. See L<MT::WeblogPublisher> for more information.
3229
3230=head2 $mt->rebuild
3231
3232An alias to L<MT::WeblogPublisher::rebuild>. See L<MT::WeblogPublisher>
3233for documentation of this method.
3234
3235=head2 $mt->rebuild_entry
3236
3237An alias to L<MT::WeblogPublisher::rebuild_entry>. See L<MT::WeblogPublisher>
3238for documentation of this method.
3239
3240=head2 $mt->rebuild_indexes
3241
3242An alias to L<MT::WeblogPublisher::rebuild_indexes>. See
3243L<MT::WeblogPublisher> for documentation of this method.
3244
3245=head2 $mt->build_email($file, $param)
3246
3247Loads a template from the application's 'email' template directory and
3248processes it as a HTML::Template. The C<$param> argument is a hash reference
3249of parameter data for the template. The return value is the output of the
3250template.
3251
3252=head2 MT::get_next_sched_post_for_user($author_id, @blog_ids)
3253
3254This is an internal routine used by L<MT::XMLRPCServer> and the
3255getNextScheduled XMLRPC method to determine the timestamp for the next
3256entry that is scheduled for publishing. The return value is the timestamp
3257in UTC time in the format "YYYY-MM-DDTHH:MM:SSZ".
3258
3259=head1 ERROR HANDLING
3260
3261On an error, all of the above methods return C<undef>, and the error message
3262can be obtained by calling the method I<errstr> on the class or the object
3263(depending on whether the method called was a class method or an instance
3264method).
3265
3266For example, called on a class name:
3267
3268    my $mt = MT->new or die MT->errstr;
3269
3270Or, called on an object:
3271
3272    $mt->rebuild(BlogID => $blog_id)
3273        or die $mt->errstr;
3274
3275=head1 DEBUGGING
3276
3277MT has a package variable C<$MT::DebugMode> which is assigned through
3278your MT configuration file (DebugMode setting). If this is set to
3279any non-zero value, MT applications will display any C<warn>'d
3280statements to a panel that is displayed within the app.
3281
3282The DebugMode is a bit-wise setting and offers the following options:
3283
3284    1 - Display debug messages
3285    2 - Display a stack trace for messages captured
3286    4 - Lists queries issued by Data::ObjectDriver
3287    8 - Reports on MT templates that take more than 1/4 second to build*
3288    128 - Outputs app-level request/response information to STDERR.
3289
3290These can be combined, so if you want to display queries and debug messages,
3291use a DebugMode of 5 for instance.
3292
3293You may also use the local statement to temporarily apply a particular bit,
3294if you want to scope the debug messages you receive to a block of code:
3295
3296    local $MT::DebugMode |= 4;  # show me the queries for the following
3297    my $obj = MT::Entry->load({....});
3298
3299*DebugMode bit 8 actually outputs it's messages to STDERR (which typically
3300is sent to your web server's error log).
3301
3302=head1 CALLBACKS
3303
3304Movable Type has a variety of hook points at which a plugin can attach
3305a callback.
3306
3307In each case, the first parameter is an L<MT::Callback> object which
3308can be used to pass error information back to the caller.
3309
3310The app-level callbacks related to rebuilding are documented
3311in L<MT::WeblogPublisher>. The specific apps document the callbacks
3312which they invoke.
3313
3314=head2 NewUserProvisioning($cb, $user)
3315
3316This callback is invoked when a user is being added to Movable Type.
3317Movable Type itself registers for this callback (with a priority of 5)
3318to provision the user with a new weblog if the system has been configured
3319to do so.
3320
3321=head1 LICENSE
3322
3323The license that applies is the one you agreed to when downloading
3324Movable Type.
3325
3326=head1 AUTHOR & COPYRIGHT
3327
3328Except where otherwise noted, MT is Copyright 2001-2008 Six Apart.
3329All rights reserved.
3330
3331=cut
Note: See TracBrowser for help on using the browser.