root/branches/release-32/lib/MT.pm.pre @ 1656

Revision 1656, 104.7 kB (checked in by mpaschal, 20 months ago)

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