# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: BigMed.pm 3335 2008-09-15 13:35:43Z josh $

package BigMed;
use strict;
use warnings;
use base qw(BigMed::Error);
use Carp;
use English qw( -no_match_vars );
use BigMed::Time;
use BigMed::Data;
use BigMed::Language;
use BigMed::DiskUtil qw(
  bm_check_space
  bm_write_file
  bm_set_file_chmod
  bm_set_datafile_chmod
  bm_set_dir_chmod
  bm_set_datadir_chmod
  bm_untaint_filepath
);
use 5.006_001; #anything less is miserable with unicode text

use vars qw( $VERSION $BMVERSION $BMYEAR $BMSETUP %SETTINGS );
$VERSION   = 2.008;
$BMVERSION = '2.0.8';
$BMYEAR    = '2008';
$BMSETUP   = 'bm-setup.pl';
%SETTINGS  = ();

my $DEFAULT_LANGUAGE = 'en-US';

#do some cleanup and untainting, per http://perldoc.perl.org/perlsec.html
#Don't reset path; makes things awkward for win32, especially
#with imagemagick-related routines
#$ENV{'PATH'} = '/bin:/usr/bin';
$ENV{PATH} = $1 if $ENV{PATH} =~ /\A(.*)\z/ms; #just untaint
delete @ENV{ 'IFS', 'CDPATH', 'ENV', 'BASH_ENV', 'SHELL' };

###########################################################
# CREATE BIGMED SYSTEM OBJECT
###########################################################

my $singleton;

sub new {
    my $class = shift;
    return $singleton if $singleton;
    $singleton = bless( {}, $class );
    return $singleton->initialize(@_);
}

sub initialize {
    my $bigmed = shift;
    @_ % 2 && croak 'Usage: $BM->initialize(%options)';
    my %param = @_;

    #get application class
    $bigmed->{_app} = $param{app};

    #environment variables from config file
    $bigmed->{_env} = {};
    if ( !$bigmed->load_config(%param) ) {
        $bigmed->set_error(
            head => 'BIGMED_ERR_HEAD_Big Medium Not Configured',
            text => 'BIGMED_ERR_TEXT_Big Medium Not Configured',
        );
        $bigmed->error_stop();
    }

    #load the language and immediately make it custom
    my $language = $bigmed->env('LANGUAGE') || $DEFAULT_LANGUAGE;

    $bigmed->{_lang} =
      BigMed::Language->get_handle($language)->customize_lang();

    BigMed::Data->set_driver( $bigmed->env('DRIVER'), $bigmed );

    #set file permission preferences
    if ( $bigmed->env('FILE_CHMOD') ) {
        bm_set_file_chmod( oct $bigmed->env('FILE_CHMOD') );
    }
    if ( $bigmed->env('DATAFILE_CHMOD') ) {
        bm_set_datafile_chmod( oct $bigmed->env('DATAFILE_CHMOD') );
    }
    if ( $bigmed->env('DIR_CHMOD') ) {
        bm_set_dir_chmod( oct $bigmed->env('DIR_CHMOD') );
    }
    if ( $bigmed->env('DATADIR_CHMOD') ) {
        bm_set_datadir_chmod( oct $bigmed->env('DATADIR_CHMOD') );
    }

    #check for update
    if ( $bigmed->env('VERSION') < $VERSION ) {
        require BigMed::Update;
        if ( !BigMed::Update->is_update( $bigmed, \%param, \%SETTINGS ) ) {
            $bigmed->error_stop();
        }
    }

    return $bigmed;
}

sub bigmed { return $_[0]->new() }

sub reload {
    my $class;
    if ( ref( $_[0] ) && $_[0]->isa(__PACKAGE__) ) {
        $class = ref(shift);
    }
    elsif ( $_[0]->isa(__PACKAGE__) ) {
        $class = shift;
    }
    else {
        $class = __PACKAGE__;
    }
    undef $singleton;
    return $class->new(@_);
}

###########################################################
# CONFIG LOAD/UNLOAD
###########################################################

sub load_config {
    my $bigmed = shift;
    my %param  = @_;
    $bigmed->{_env}    = {};
    $bigmed->{_config} = $param{config} || $BMSETUP;

    #fetch the %SETTINGS hash from defaults and config file
    undef %SETTINGS;
    my %defaults = (
        BATCHPROCESS     => '500',
        MENUNUMTODISPLAY => '30',
        ALLUSAGE         => 'on',
        ADMIN_DOCLIMIT   => '5120',
        SESSION_EXPIRE   => '+60m',
        LANGUAGE         => 'en-US',
        FILETYPES        => [
            'wk1',  'wk3',  'wk4',  'xls',  'xlw',  'doc',  'pps', 'ppt',
            'mpp',  'pub',  'wks',  'wps',  'wri',  'pdf',  'ra',  'ram',
            'rm',   'rtf',  'sda',  'sdc',  'sdd',  'sdp',  'sdw', 'sgl',
            'stcm', 'std',  'sti',  'stw',  'sxc',  'sxd',  'sxg', 'sxi',
            'sxm',  'sxw',  'asc',  'csv',  'txt',  'wpd',  'xml', 'bmp',
            'eps',  'gif',  'jfif', 'jpeg', 'jpg',  'png',  'psd', 'tif',
            'tiff', 'aac',  'm4p',  'aif',  'aifc', 'aiff', 'avi', 'mid',
            'midi', 'rmi',  'm4a',  'mp3',  'mpu',  'mp4',  'mpe', 'mpeg',
            'mpg',  'swf',  'moov', 'mov',  'qt',   'qtm',  'wma', 'wmv',
            'wav',  'hqx',  'gz',   'gzip', 'taz',  'tgz',  'bin', 'dmg',
            'sit',  'sitx', 'tar',  'zip'
        ],
        VERSION => $bigmed->VERSION,  #the "real" version, not display version
        PROXY   => q{},
        NO_PROXY    => ['localhost', '127.0.0.1'],
        BMSALT      => time,
        DOT         => q{.},
        BACKUP_FREQ => q{1},
        BACKUP_KEEP => q{0},
        BACKUP_HOUR => q{2},
    );
    eval { do $bigmed->{_config} };
    $bigmed->set_env( %defaults, %SETTINGS );
    undef %SETTINGS;

    my $no_config_ok =
        defined( $param{no_config_ok} ) ? $param{no_config_ok}
      : $bigmed->{_app}                 ? 0
      : 1;                            #no app, allow it
    my $not_configured = !$bigmed->env('MOXIEDATA') && !$no_config_ok;
    return $not_configured ? 0 : 1;
}

sub save_config {
    my $bigmed = shift;

    my $config_file = <<"SAVE_CONFIG";
package BigMed;
use utf8;
# Big Medium configuration file
# Big Medium web content management system v$BMVERSION
# Copyright (c) 2002-$BMYEAR Josh Clark and Global Moxie, LLC.
# All rights reserved.

\%SETTINGS = (
SAVE_CONFIG
    my %settings = $bigmed->all_env;
    foreach my $key ( sort keys %settings ) {
        next if !defined $settings{$key};
        $config_file .= "\t'$key' => ";
        if ( ref( $settings{$key} ) eq 'ARRAY' ) {
            my @array = _make_safe_for_config_file( @{ $settings{$key} } );
            my $array_string .= join( "',\n\t\t'", @array );
            $array_string = "\n\t\t'$array_string'\n\t" if $array_string;
            $config_file .= "[$array_string],\n";
        }
        else {
            $settings{$key} = _make_safe_for_config_file( $settings{$key} );
            $config_file .= "'$settings{$key}',\n";
        }
    }
    $config_file .= ");\n1;\n";

    #check disk space and write the file
    my $moxiedir = $bigmed->env('MOXIEDATA');
    if ( $moxiedir && -e $moxiedir ) {
        bm_check_space( $moxiedir, 10 ) or return;
    }
    $bigmed->{_config} ||= $BMSETUP;
    bm_write_file( $bigmed->{_config}, $config_file, { data => 1 } )
      or return;
    return $bigmed;
}

sub _make_safe_for_config_file {
    foreach my $item (@_) {
        next if !defined $item;
        $item =~ s/\\/\\\\/msxg;
        $item =~ s/'/\\'/msxg;
    }
    return wantarray ? @_ : $_[0];
}

###########################################################
# ENVIRONMENTAL VARIABLE ROUTINES
###########################################################

sub env {
    my $self = shift;
    $_[0] or croak 'No environment variable requested.';
    return wantarray
      ? @{ $self->{_env} }{ map { uc $_ } @_ }
      : $self->{_env}->{ uc( $_[0] ) };
}

sub all_env {
    return %{ $_[0]->{_env} };
}

sub set_env {
    my $self    = shift;
    my %env_var = @_;
    foreach my $var ( keys %env_var ) {
        $self->{_env}->{ uc($var) } = $env_var{$var};
    }
    return $self;
}

sub app {
    return $_[0]->{_app} ? $_[0]->{_app}->app_instance() : undef;
}

sub version { return $BMVERSION }

###########################################################
# LANGUAGE ROUTINES
###########################################################

sub language {

    #wrapper to BigMed::Language maketext routine via
    #language object stowed in the _lang key.
    my ( $bigmed, $key ) = @_;
    my @args = ref $key eq 'ARRAY' ? @{$key} : ($key);
    my $lang = $bigmed->{_lang}
      || BigMed::Language->get_handle($DEFAULT_LANGUAGE)->customize_lang();
    return $bigmed->_escape_localized( $lang->maketext(@args) );
}

sub language_list {
    my $bigmed = shift;
    my $lang   = $bigmed->{_lang}
      || BigMed::Language->get_handle($DEFAULT_LANGUAGE)->customize_lang();
    return $bigmed->_escape_localized( $lang->list(@_) );
}

sub _escape_localized {
    my $app  = $_[0]->app;
    my $text = $_[1];
    if ($app) {
        $text = $app->escape($text);
        $text =~ s{%BM([^%]+)%}{ $app->unescape($1) }msxge;
        $text =~ s{\|BM([^\|]+)\|}{ $app->unescape($1) }msxge;
    }
    else {
        $text =~ s{%BM([^%]+)%}{$1}msxg;
    }
    return $text;
}

###########################################################
# TIME MANAGEMENT ROUTINES
###########################################################

#wrappers to BigMed::Time

sub time_obj {
    my $self = shift;
    return BigMed::Time->new(@_);
}

sub bigmed_time {
    my $self = shift;
    my $time = BigMed::Time->new(@_);
    return $time->bigmed_time;
}

###########################################################
# MESSAGE/COMMUNICATION ROUTINES
###########################################################

sub message {
    my $self = shift;
    @_ % 2
      && croak q{Usage: $BM->message(head=>'headline key', text=>'text key')};
    my %message = @_;

    #localize the head and text
    foreach ( 'head', 'text' ) {
        $message{$_} = $message{$_} ? $self->language( $message{$_} ) : q{};
    }
    if ( my $app = $self->app() ) {
        return $app->basic_message(%message);
    }

    #otherwise, not running an application... do a simple format appropriate
    #for command line: strip out any html, moving links into regular body
    #of text
    foreach my $chunk ( 'head', 'text' ) {
        $message{$chunk} =~ s/<a href="([^"]+)"[^>]*>([^<]*)<\/a>/$2 ($1)/msg;
        $message{$chunk} =~ s/<li>/\n\* /msg;
        $message{$chunk} =~ s{<br\s*/?>}{\n}msg;
        $message{$chunk} =~ s/<[^>]+>//msg;
    }
    my $result = $message{head} ? $message{head} . "\n" : q{};
    $result .= $message{text} . "\n";
    return $result if $message{give_back};
    print $result;
    exit if $message{'exit'};
    return;
}

###########################################################
# USER AGENT ROUTINE
###########################################################

my $TIMEOUT = 20;    #seconds

sub user_agent {
    my $self = shift;
    my $ropt = shift || {};
    require LWP::UserAgent;
    my $agent = LWP::UserAgent->new(
        agent   => 'BigMedium/' . $self->version,
        timeout => $ropt->{timeout} || $TIMEOUT,
    );

    my $proxy = $self->env('PROXY');
    if ($proxy) {
        $agent->proxy( 'http', $proxy );
        my $rno_proxy_doms =
          $self->env('NO_PROXY') ? !{ $self->env('NO_PROXY') } : [];
        $agent->no_proxy( @{$rno_proxy_doms} );
    }
    return $agent;
}

###########################################################
# LOADING REQUIRED CLASSES
###########################################################

sub load_required_class {
    my $module_path = $_[1] or return;
    $module_path .= '.pm' if $module_path =~ s{::}{/}msg;    #module name
    $module_path = bm_untaint_filepath($module_path)
      or croak "Could not untaint path to required library: $module_path";
    require $module_path;
    return 1;
}

1;
__END__

=head1 NAME

BigMed - Big Medium system object.

=head1 SYNOPSIS

  use BigMed;
  my $BM = BigMed->new();

=head1 DESCRIPTION

BigMed objects hold the Big Medium system configuration and manage system-level
functions like time, localization and error messaging.
Big Medium applications plug into the BigMed singleton system object to
access these settings and methods.

=head1 USAGE

=head2 Constructor Methods

=head3 C<< BigMed->new(%options) >>

Returns a BigMed object, loaded with the current installation's
environmental variables. Some system initialization is done, too,
including loading the appropriate file driver and language localization
lexicon.

The BigMed object is a singleton, so additional calls to C<new> returns
the same object.

The method accepts two parameter options in the %options argument hash:

=over 4

=item * config => '/path/to/config/file'

Indicates the location of the Big Medium configuration file. If not
set, Big Medium will use bm-setup.pl in the current working directory.

=item * no_config_ok => 1

If true, Big Medium will not stop if it cannot find its configuration file
(this is really only desirable for certain testing situations or if you're
creating an interface to configure Big Medium for the first time).

=item * app => 'BigMed::App class'

Registers a BigMed::App class as the class to use for escaping/unescaping
strings and displaying messages. Big Medium will request the application
singleton object for the class when it needs to carry out those functions.

=back

=head3 C<< BigMed->reload(%options) >>

Forces the creation of a new BigMed singleton object, replacing the old
singleton. The %options parameter hash works the same way as the C<new>
method.

=head3 C<< BigMed->bigmed() >>

Returns the current singleton object. If it doesn't exist, a new BigMed
object is created.

=head2 Configuration and Environmental Variables

=head3 C<< $BM->env('var_name1', 'var_name2', ... ) >>

Returns the values of the environmental variable whose name(s) are
passed to the method. Multiple values can be requested by passing
multiple names to the method.

    my $moxiedir = $BM->env('MOXIEDATA');
    my ($bigmed_url, $org_name) = $BM->env ('MOXIEBIN', 'ORGNAME');

The following environmental variables are available:

=over 4

=item * MOXIEDATA

The path to the C<moxiedata> directory, where Big Medium stores all of
its data files.

=item * MOXIEBIN

The URL of the directory where Big Medium's Perl scripts are stored.

=item * BMADMINDIR

The directory path of the bmadmin directory where Big Medium's
supporting images, help files, javascript files and CSS files are stored.

=item * BMADMINURL

The URL of the bmadmin directory where Big Medium's supporting images,
help files, javascript files and CSS files are stored.

=item * SENDMAILPATH

The location of the sendmail program, if applicable.

=item * SMTPSERVER

The address of the SMTP server to use to send mail, if applicable.

=item * REGNUM

The registration number of this installation of Big Medium.

=item * ORGNAME

The name of the organization to whom this installation of Big Medium
is licensed.

=item * ADMINEMAIL

The e-mail address of the primary Big Medium administrator.

=item * BATCHPROCESS

The number of article files to process at a time, most commonly for
rebuilding article pages.

=item * MENUNUMTODISPLAY

The number of articles to display per page in the article editor menu.

=item * ALLUSAGE

Indicates whether the Big Medium power switch is 'on' or 'off'. If the
switch is off, then sites cannot be edited.

=item * ALLOFF

The message displayed to users when the power switch is off.

=item * DOT

The special character used to note Big Medium files (e.g. bm.pix, bm.doc,
etc.) Legacy versions use the tilde; the default is a period.

=item * ADMIN_DOCLIMIT

The maximum size allowed for file uploads, in kilobytes.

=item * SESSION_EXPIRE

The amount of time of user inactivity to allow before requiring the
user to sign in again, in minutes.

=item * LANGUAGE

The language tag to use to retrieve the appropriate BigMed::Language
object for localization. The default is 'en-US'.

=item * DRIVER

The name of the file driver to use. The default (and currently only)
value is: File

=item * FILETYPES

An array reference of all of the file extensions for files accepted for
upload.

=item * VERSION

The version number of the Big Medium system that generated this configuration
file. Can be compared to the version number returned by the C<version>
method to see if an update needs to be performed.

=item * PROXY

The name of the proxy server to use, if any, for web access via the
LWP::UserAgent object returned by the C<user_agent> method.

=item * NO_PROXY

An array reference of domains that should not be accessed via the proxy
server defined by the PROXY setting but should simply be accessed
directly.

=back

=head3 C<< $BM->all_env() >>

Returns a hash of all Big Medium environmental variables. The keys
are the variable names, and the values are the variable values.

    my %env_vars = $BM->all_env();

=head3 C<< $BM->set_env('variable_name' => 'value') >>

Sets the environmental variable named in the method to the specified
value. Multiple variables can be set at once.

Examples:

    $BM->set_env( 'ORGNAME'   => 'Global Moxie' );
    $BM->set_env( 'FILETYPES' => [qw(pdf doc rtf)] );

    $BM->set_env(
        'BMADMINURL' => 'http://www.example.com/bmadmin',
        'ADMINEMAIL'  => 'foo\@foobar.com'
    );

    my %variables;
    $variables{'ORGNAME'}     = "Global Moxie";
    $variables{'FILETYPES'}   = [qw(pdf doc rtf)];
    $variables{'BMADMINURL'} = "http://www.example.com/bmadmin";
    $variables{'ADMINEMAIL'}  = "foo\@foobar.com";
    $BM->set_env(%variables);

=back

=head3 C<< $BM->version >>

Returns the currently running version of Big Medium (if an upgrade
has recently been installed, this might not be the same as
C<< $BM->env('VERSION') >>).

=head3 C<< $BM->app >>

Returns the registered BigMed::App application object, if any.

=head3 C<< $BM->driver >>

Returns the registered BigMed::App application object, if any.

=head3 C<< $BM->load_config(\%options) >>

Erases any existing c<env> variables and loads a fresh set from
the configuration file. Returns true if it successfully loaded
a valid configuration file, otherwise false (in which case,
default configuration values are supplied).

This method is called automatically when new objects are being
initialized, but it can also be called later to reload variables
from the configuration file.

The method accepts an optional hash of option parameters, with these two
options available:

=over 4

=item * config => '/path/to/config/file'

Indicates the location of the Big Medium configuration file. If not
set, Big Medium will use bm-setup.pl in the current working directory.

=item * no_config_ok => 1

If true, Big Medium will not stop if it cannot find its configuration file
(this is really only desirable for certain testing situations or if you're
creating an interface to configure Big Medium for the first time).

=back

=head3 C<< $BM->save_config(\%options) >>

Saves all of the C<env> variables to the configuration file. The
configuration file will be in the same location as the file used
to load in C<load_config> (so, if you set a custom C<config>
value when C<load_config> was originally called, that's the location
where the file will be saved).

=head2 Messages

BigMed::App objects should handle the bulk of the user interface, but
Big Medium does provide a simple method to pipe messages -- usually
error messages -- to the user.

=head3 C<< $BM->message(head=>'headline', text=>'body text') >>

Generates a simple message screen. The message hash is passed along to the
BigMed::App application object's C<basic_message> method if an application
object has been registered. If not, the message is formatted and displayed
as plain text, suitable for the terminal.

The arguments are a hash with the following key/value pairs:

=over 4

=item * head => 'Headline'

The language key for the text to be displayed (this key will be passed
to the C<language> method to retrieve the text to display).

=item * text => 'Body text'

The language key for the text to be displayed (as with the C<head>
value, this key will be passed to the C<language> method to
retrieve the text to display).

=item * exit => 1

If true, should display the message and exit.

=item * give_back => 1

If true, the message will not be displayed, and the return value will
be the message itself.

=back

=head2 Localization

When a BigMed object is loaded, it internally loads a BigMed::Language
object, based on the LANGUAGE environment value in the configuration file
(the default is English).

These methods allow you to interact with that language object to
retrieve lexicon values in the appropriate language.

=over 4

=item $BM->language($lexicon_key);

Returns the (escaped) BigMed::Language string that is associated with the
lexicon key for the current language. Escaping uses the current
application's escape method.

If the key is an array reference, then the first element of the array
will be processed as the key, and the other values will be processed
as parameters to that key. If the first value in the array is a string
containing brackets, for example, the string is processed according
to Locale::Maketext's bracket notation. If the first value in the array
is a code reference, that code will be run with the BigMed::Language
object and the remaining array values as its arguments.

=item $BM->language_list(@lexicon_keys);

Accepts an array of lexicon keys (or references to key/parameter arrays)
and returns all of the translated values in a xhtml-formatted unordered
list. The strings inside the list are escaped.

=back

=head2 Time

=over 4

=item * C<time_obj>

    BigMed->time_obj(%options);
    $bm->time_obj(%options);

A wrapper to BigMed::Time->new(). Returns a BigMed::Time object.
See BigMed::Time documentation for details.

=item * C<bigmed_time>

    BigMed->bigmed_time(%options);
    $bm->bigmed_time(%options);
    
Returns a Big Medium formatted time string. Accepts an optional hash
of arguments that are passed along to BigMed::Time->new() to specify
the desired time (see BigMed::Time documentation for details). If
no arguments are specified, the current time is used.

=back

=head2 Web Access

=over 4

=item * $BM->user_agent(\%param);

Returns a LWP::UserAgent object with the appropriate proxy information
(based on the PROXY and NO_PROXY environmental variables). The method
accepts a single optional argument, a reference to a hash of parameters:

=over 4

=item * timeout => $seconds

Sets the connection timeout. Default is 20 seconds.

=back

=back

=head2 Utilities

=over 4

=item * $BM->load_required_class($class_or_filepath);

Loads a Perl library or module via C<require>. The argument can be either
a class name or a filepath. The method converts class names to paths
if necessary and untaints the path before requiring it. Returns a true
value.

=back

=head2 Error Methods

BigMed is a subclass of BigMed::Error and inherits all of that class's
error methods, allowing the BigMed class and objects to set and
retrieve error values shared by other BigMed modules. The methods:

=over 4

=item * BigMed->set_error(head=>$headline_key, text=>$text_key)

=item * BigMed->set_io_error($fh, $action, $filepath, $error)

=item * BigMed->error()

=item * BigMed->display_error()

=item * BigMed->error_html_hash()

=item * BigMed->clear_error()

=back

For more, see the BigMed::Error documentation.

=head1 AUTHOR & COPYRIGHTS

This module and all Big Medium modules are copyright Josh Clark
and Global Moxie. All rights reserved.

Use of this module and the Big Medium content
management system are governed by Global Moxie's software licenses
and may not be used outside of the terms and conditions outlined
there.

For more information, visit the Global Moxie website at
L<http://globalmoxie.com/>.

Big Medium and Global Moxie are service marks of Global Moxie
and Josh Clark. All rights reserved.

=cut