package Text::Wigwam;

# This class represents the front-end user interface.

# Latest Wigwam version and documentation are available at
# http://www.wigwamhq.org

# Config options handled by the common interface:
#        modules
#        plugins
#        engine
#        default_engine
#        directive_path
#        directive_root
#        config_open
#        config_term
#        escape_var

use 5.008;
use strict;
use warnings;
our $VERSION = '0.02';

use base qw(
    Text::Wigwam::Api
    Text::Wigwam::Expression
);

use Text::Wigwam::Globals;
use Text::Wigwam::Stash;
use Text::Wigwam::Dtree;
use Text::Wigwam::Beautify::Text;
use Text::Wigwam::Beautify::Html;
use Text::Wigwam::Loader;
use Text::Wigwam::Config;
use Text::Wigwam::Paths;
use Text::Wigwam::Debug;
use Text::Wigwam::Fetch;
use Text::Wigwam::Virtual;
use Text::Wigwam::Overload;

use Scalar::Util 1.08 ( qw/blessed reftype/ );
use File::Spec::Functions(qw/catfile/);

our $ERROR;    # Holds the most recent error message.

# The $plugins variable is used for caching the code
# references that are used to initialize engines and plug-ins.
my $plugins = {};

# The $beautifiers variable is used to cache loaded beautifiers.
our $beautifiers = {};

sub new {
    my ( $class, $type, $docu, %uopts ) = @_;
    local $_;
    $ERROR = '';
    unless ( defined $docu ) {
        $ERROR = "A required argument is missing";
        return;
    }
    my $opts = {};
    map { $opts->{ lc $_ } = $uopts{$_} } keys %uopts;

#        $opts->{lc $_} = $uopts{$_} for keys %uopts;
    my $wwroot;
    unless ( ref($class) ) {
        unless ( ($wwroot) = __FILE__ =~ /^(.*)\..*$/ ) {
            $ERROR = "Unable to locate Wigwam library";
            return;
        }

        my $paths = Text::Wigwam::Paths->new(
          qw/
            module
            plugin
            engine
            template
            beautifier
            perlmod
          /
        );
        $paths->set( module     => catfile( $wwroot, q/Modules/  ) );
        $paths->set( plugin     => catfile( $wwroot, q/Plugins/  ) );
        $paths->set( engine     => catfile( $wwroot, q/Engine/   ) );
        $paths->set( beautifier => catfile( $wwroot, q/Beautify/ ) );
        $paths->set( perlmod    => @INC );
        $paths->pre( template   => catfile( $wwroot, q/Templates/  ) );

        return $class->_new(
            $type => $docu,
            $class->_default_config($opts),
            $paths,
            $class->_init_globals($opts->{global}),
            $opts->{varspace}
        );
    }

     # Merge new global values with existing global values
    if( $opts->{global} ) {
        my $global_hash
            = $class->globals->get_global( q/global/ )
           || $class->globals->set_global( global => {} );
         # give presidence to existing values
        %$global_hash = (
            %{$opts->{global}||{}},
            %$global_hash,
        );
    }

    return $class->_new(
        $type => $docu,
        $class->_default_config($opts),
        $class->paths,
        $class->globals,
        $opts->{varspace} || $class->{varspace},
    );
}

sub spawn {
    # Spawn a child template
    my ( $self, @args ) = @_;
    return ( "Spawn must be called on a blessed reference" )
        unless ref $self;
    local ( $_ );
    return ( ${$self->globals->get_global( q/_DIE/ )} )
        unless $self->root_expr;
    my $obj;
    return $self->{engine}->spawn(@args);
}

sub error {
    my ($class) = @_;
    return ref($class)
           ? $class->{ERROR}
           : $ERROR
    ;
}

sub text    { return $_[0]->{text} }
sub _export { $_[0]->{export} ||= {} }

sub execute {
    my ( $self, $Args ) = @_;
    local( $_ );

    $self->{ERROR} = undef;
    ( my $globals = $self->globals )->reset_eflags;

    return ( $self->{ERROR} = ${$globals->get_global( q/_DIE/ )} )
        unless ( my $root_expr = $self->root_expr() );

    my ($err, $text)
      = $root_expr->execute( $self->{engine}, $Args );

    return ($err, $self->{text} = $text) if wantarray;
    return $self->{text} = $text;
}

sub virtual {
    my ( $self, $Args ) = @_;
    unless ( exists $self->{engine} ) {
        my ($err) = $self->execute($Args);
        die $err if $err;
    }
    return Text::Wigwam::Virtual->new($self);
}

sub debug {
    my ($self, $beau, $tdebug) = @_;
    local ( $ERROR, $_ );

    unless ( $self->_valid_beautifier($beau) ) {
        warn 'Invalid beautifier class: '
            . ( ref $beau || $beau )
            . ' - Using default beautifier.';
        $beau = $self->new_beautifier('Text::Wigwam::Beautify::Text');
    }
    my $deftemp = $beau->can('default_template')
         ? $beau->default_template
         : "No default template exists for the "
           . ( ref($beau) || $beau )
           . " beautifier class."
    ;
    unless ( blessed($tdebug) && $tdebug->isa(q/Text::Wigwam/) ) {
        $tdebug = $deftemp
            || $self->default_template() or return( $ERROR );
    }

    unless ( exists $self->{engine} ) {
        return (
            'Debug is only useful after the execute method has been invoked.'
        );
        return ( $self->{ERROR} = $ERROR )
            unless $self->root_expr;
    }
    my $bugs  = $self->get_global( q/_BUGS/ )
             || Text::Wigwam::Debug->new;

    my ( $error, $eflag );
    $eflag = $self->eflag
        and $error = "$eflag: " . ${$self->get_global($eflag)};

    my $debug = {
        docu => $self->doc,
        text => $self->text,
        size => $self->root_expr->size,
        beau => $self->beautify( $beau->new() ),
        erro => $error,
        bugs => [],
    };
    my $id = 0;
    foreach my $bug ( @{$bugs->get} ) {
        push(
            @{ $debug->{bugs} },
            {   docu => $bug->doc,
                engn => $bug->API->name,
                text => $self->text,
                size => $bug->expr->size,
                comm => $bug->get_comments,
                erro => $bug->error,
                opts => $bug->options,
                beau => $bug->expr->beautify(
                    $bug->API,
                    $beau->new(
                        $bug->addr, $bug->error, $bug->get_comments, $id,
                    )
                ),
                uniq => $id++,
            }
        );
    }
    return $tdebug->execute( { DEBUG => $debug, TEMPLATE => $deftemp } );
}

sub doc  { $_[0]->{document} }
sub size { $_[0]->root_expr->size }
sub paths { $_[0]->{paths} }
sub config { $_[0]->{config} }
sub engine { $_[0]->root_expr->engine }
sub globals { $_[0]->{globals} }
sub stash { $_[0]->{stash} }
sub beautify {
    my ( $self, $beau ) = @_;
    local ( $_, $ERROR );

    unless ( $self->_valid_beautifier($beau) ) {
        warn 'Invalid beautifier class: '
            . ( ref $beau || $beau )
            . ' - Using default beautifier.';
        $beau = $self->new_beautifier('Text');
    }
    return ( $self->{ERROR} = $ERROR ) unless $self->root_expr;
    return $self->root_expr->beautify( $self->{engine},
        ref $beau ? $beau : $beau->new );
}

sub root_expr { return $_[0]->{engine}{root_expr} ||= $_[0]->_init }

sub prime {
    my ($self) = @_;
    $self->root_expr->prime( $self->{engine} );
    return $self;
}

sub version {
    no strict 'refs';
    my ($self) = @_;
    my $pkg = ref $self || $self;
    return ${"${pkg}::VERSION"};
}

sub _new {
    no strict 'refs';
    my ( $class, $type, $doc, $config, $paths, $globals, $u_vspace ) = @_;
    my $self = bless {}, ref($class) || $class;
    $type = lc $type;
    @$self{qw/ config paths globals /}
        = ( $config, $paths, $globals );

#    return ( undef, "Unsupported template retrieval method: $type" )
#        unless Text::Wigwam::Fetch->can($type);
#    my $fetcher = "Text::Wigwam::Fetch::$type";
#    ( $ERROR, $self->{document}, $self->{template} )
#        = $fetcher->( $self, $doc, $paths->finder(q/template/) );

    return ( undef, "Unsupported template retrieval method: $type" )
        unless Text::Wigwam::Fetch->can($type);
    ( $ERROR, $self->{document}, $self->{template} )
        = Text::Wigwam::Fetch->$type($self, $doc);

    return if $ERROR;

    # We need to peek at the parameters early in order to determine
    # what config tag delimiters to look for within the template.
    my $restrict = $config->crank(
        qw/
            restrict
            options
            settings
            defaults
        /
    );

    $self->{template} = $config->parse_config(
        $self->{template},
        $restrict->{config_open},
        $restrict->{config_term},
    );

    $config->cache( options => qw/restrict options settings defaults/ );

    $self->{stash} = Text::Wigwam::Stash->new(
        varspace => $u_vspace,
        globals  => $globals,
    );

    return $self;
}

sub _default_config {
    my ( $self, $opts ) = @_;
    my $wwconfig = Text::Wigwam::Config->new(
        restrict => {
            config_open    => '<<',
            config_term    => '>>',
            default_engine => 'Fusion',
        },

        # Preset root template settings
        settings => { plugins => 'DirectiveSet', },

        # Preset global defaults
        defaults => {},
        options  => undef,
        aliases  => undef,
    );

    # Use presets for the following classes only when user settings are
    # not provided.
    $wwconfig->concede(qw/settings/);

    # Confine the following class parameters to the current template
    # only.
    $wwconfig->confine(qw/ settings options /);

    # Give priority to inherited settings over conftag settings for the
    # specified classes.
    $wwconfig->promote(qw/restrict/);

    # Exclude the following classes' conftag parameters when generating
    # an options hash.
    $wwconfig->exclude(qw/restrict defaults settings/);

    $wwconfig->inherit(
        restrict => $opts->{restrict},
        defaults => $opts->{defaults},
        settings => $opts->{settings},
        aliases  => $opts->{aliases},
        options  => {},
    );
    return $wwconfig;
}

sub _valid_beautifier {
    no strict 'refs';
    my ( $self, $pkg ) = @_;
    unless ( ref($pkg) ) {
        return unless $pkg && length($pkg);
        return $pkg ne 'Text::Wigwam::Beautifier'
            && $pkg->isa(q/Text::Wigwam::Beautifier/);
    }
    return unless blessed $pkg;
    return $pkg->isa('Text::Wigwam::Beautifier');
}

sub _init_globals {
    my ( $class, $uglobals ) = @_;
    my $globals = Text::Wigwam::Globals->new();

    $globals->new_fatal(  GLOBAL => q/_DIE/ );
    $globals->new_global( GLOBAL => q/args/ );
    $globals->new_global( GLOBAL => global  => $uglobals || {} );
#    $globals->new_global( GLOBAL => template => {} );
    $globals->new_global( GLOBAL => _BUGS   => Text::Wigwam::Debug->new() );
#    $globals->new_global( GLOBAL => plugins => $plugins );
    return $globals;
}

sub _init {
    my ( $self ) = @_;
    no warnings q/uninitialized/;
    local $_;
    my $defaults = $self->config->crank(q/defaults/);
    my $options  = $self->config->cache(q/options/);

    if ( my @plugins = split( /\s*,\s*/, $self->get_options(qw/plugins/) ) ) {
          my $err = Text::Wigwam::Directives->load_up(
            $plugins,    # Plugin init cache
            $self->config->cache(q/aliases/),
            Text::Wigwam::ApiJr->new( $self->globals ),
            $self->paths->finder(q/plugins/),
            @plugins,
          );
#          $self->set_global( _DIE => $err )
          $self->set_global( _DIE => \($self->doc . " - " . $err) )
            if $err;
    }
    if ( my @modules = split( /\s*,\s*/, $self->get_options(qw/modules/) ) ) {
          my $err = Text::Wigwam::Directives->load_up(
            {},          # Pass in a dummy cache hash ref
            {},          # Ditto - no alias definitions allowed here
            Text::Wigwam::ApiJr->new( $self->globals ),
            $self->paths->finder(q/modules/),
            @modules,
          );
          $self->set_global( _DIE => \($self->doc . " - " . $err) )
#          $self->set_global( _DIE => $err )
            if $err;
    }
    return $self->{engine}->init( $self->{template} )
      if $self->_init_engine;
    return;
}

sub _init_engine {    # Engine/API init routine
    no strict 'refs';
    no warnings 'uninitialized';
    my ($self) = @_;

    my $defaults = $self->config->crank(q/defaults/);
    my $options  = $self->config->cache(q/options/);

     # Ignore duplicate engine names
    my %done;
    my @engines = grep { ++$done{ucfirst lc $_} == 1 } (
        split( /\s*,\s*/, $options->{engine} ),
        split( /\s*,\s*/, $options->{default_engine} ),
    );

    foreach my $eng (@engines) {
        $options->{engine} = $eng = ucfirst lc $eng;
        if ( my $pkg = $self->_is_loaded($eng) ) {
            my $eng_defaults = ($plugins->{$pkg} || sub{ {} })->();
#            my $eng_defaults = $plugins->{$pkg}->() || {};
            if( ref $eng_defaults eq 'HASH' ){
                %$defaults = ( %$eng_defaults, %$defaults );
                %$options  = ( %$eng_defaults, %$options );
            }

            my $engine = $pkg->new(

                # Exclusive Engine data
                Dtree => Text::Wigwam::Dtree->new(
                    q/Text::Wigwam/,
                    q/Directives/,
                    $options->{directive_root},
                    [ split( /\s*,\s*/, $options->{directive_path} ) ],
                    ( $options->{drip_cache} & 1 ),
                ),

                # Common API/Engine data
                Doc     => $self->doc,
                Globals => $self->globals,
                Stash   => $self->stash,
                Modtime => $self->{mod_time},
                Config  => $self->config,
                Paths   => $self->paths,
                Export  => $self->_export,

                # Exclusive API data
            );
            return $self->{engine} = $engine;
        }
    }
    $self->globals->set_global(
      _DIE => \("Unable to initialize Wigwam engine: " . join( "; ", @engines ))
    );
    return;
}

sub _is_loaded {
    no strict 'refs';
    my ( $self, $engine ) = @_;

    return if $engine =~ /^\s*$/;

    my $pkg = "Text::Wigwam::Engine::$engine";
    return $pkg if $pkg->isa(q/Text::Wigwam::Engine/);

    my $engfile = $self->paths->find_file( engines => "$engine.pm" )
        or return;

    my ($engdir) = $engfile =~ /^(.*)\.pm/;
    local @INC = ( $engdir, @INC ) if -d $engdir;

    local $@;
    $plugins->{$pkg} ||= eval { require $engfile };

    if ($@){
        $self->globals->set_global( _DIE => \$@ );
    }
    else {
        $plugins->{$pkg} = sub { }
            unless ref( $plugins->{$pkg} ) eq 'CODE';
        return $pkg
          if $pkg->isa(q/Text::Wigwam::Engine/);
    }
    delete $plugins->{$pkg};
    return;
}

sub new_beautifier {
    my ( $self, $beauname ) = @_;
    $beauname = ucfirst lc $beauname;
    my $beaut = $beautifiers->{$beauname}
        ||= $self->fetch_beautifier($beauname)
          or return ( $ERROR );

    return $beaut->new;
      # if ref $beaut && blessed $beaut && $beaut->can( 'new' );
}

sub fetch_beautifier {
    my ( $self, @blist ) = @_;
    my @loaded = eval {
        Text::Wigwam::Loader->fetch_package(
            $beautifiers,
            Text::Wigwam::ApiJr->new( $self->globals ),
            $self->paths->finder(q/beautifier/), @blist,
        );
    };
    $ERROR = $@ and return;
    for my $rval (@loaded) {
        if ( ref($rval) eq 'CODE' ) {
            $rval = $rval->();
#            $rval = eval { $rval->() };
#            die $@ if $@;
        }

        # $fname =~ s{/}{::}g;
    }
    return wantarray ? @loaded : $loaded[0]
        unless $@;
    $ERROR = $@;
    return;
}

sub default_template {
    return Text::Wigwam->new(
        find     => '/Core/Beautify/Text',
        restrict => {
            config_open    => q/<</,
            config_term    => q/>>/,
            default_engine => q/Totem, Fusion/,
        },
        defaults => {
            strict_tags    => 1,
            text_open      => q/!!>/,
            text_term      => q/<!!/,
            code_open      => q/[!!/,
            code_term      => q/!!]/,
            text_open_trim => q/~!>/,
            text_term_trim => q/<!~/,
            code_open_trim => q/[!~/,
            code_term_trim => q/~!]/,
        },
        settings => {
            plugins  => 'DirectiveSet',
        },
    ) or die $Text::Wigwam::ERROR;
}

1;