root/branches/release-33/lib/MT.pm.pre @ 1716

Revision 1716, 104.8 kB (checked in by fumiakiy, 20 months ago)

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