view release on metacpan or  search on metacpan

lib/Class/Scaffold/App.pm  view on Meta::CPAN

use 5.008;
use warnings;
use strict;

package Class::Scaffold::App;
BEGIN {
  $Class::Scaffold::App::VERSION = '1.102280';
}

# ABSTRACT: Base class for framework applications
use Class::Scaffold::Environment;
use Property::Lookup;
use Error ':try';
use parent 'Class::Scaffold::Storable';
__PACKAGE__->mk_boolean_accessors(qw(initialized));
use IO::Handle;
STDOUT->autoflush;
STDERR->autoflush;
use constant CONTEXT => 'generic/generic';

sub app_init {
    my $self = shift;
    return if $self->initialized;    # See POD
    $self->initialized(1);
    my $configurator = Property::Lookup->instance;

    # If a subclass added a getopt configurator, we can ask it for the
    # location of the conf file, in case the user specified '--conf' on the
    # command line. If a filename is given, we'll use that conf file. If the
    # special string "local" is given, we try to find the conf file.
    # Otherwise use the one given in an environment variable.
    my $conf_file_spec = $configurator->conf || $ENV{CF_CONF} || '';

    # make a note of the configuration file spec in the configurator
    $configurator->default_layer->hash(conf_file_spec => $conf_file_spec);
    for my $conf_file (split /[:;]/, $conf_file_spec) {
        if ($conf_file eq 'local') {

            # only load if needed
            require Class::Scaffold::Introspect;
            $conf_file = Class::Scaffold::Introspect::find_conf_file();
        }
        $configurator->add_layer(file => $conf_file);
    }
    $self->log->max_level(1 + ($configurator->verbose || 0));

    # Now that we have both a getopt and a file configurator, the log file
    # name can come from either the command line (preferred) or the conf file.
    $self->log->filename($configurator->logfile)
      if defined $configurator->logfile;

    # This class subclasses Class::Scaffold::Base, which returns
    # Class::Scaffold::Environment->getenv as the default delegate. So set the
    # proper environment here and then pass the newly formed delegate the
    # configurator. The environment will make use of it in its methods.
    Class::Scaffold::Environment->setenv($configurator->environment);
    $self->delegate->setup;
    $self->delegate->configurator($configurator);
    $self->delegate->context(
        Class::Scaffold::Context->new->parse_context($self->CONTEXT));
    if ($configurator->dryrun) {
        $self->log->clear_timestamp;
        $self->delegate->set_rollback_mode;
    }
}
sub app_finish { 1 }
sub app_code   { }

sub run_app {
    my $self = shift;
    $self->app_init;
    $Error::Debug++;    # to get a stacktrace
    try {
        $self->app_code;
    }
    catch Error with {
        my $E = shift;
        $self->log->info($E->{statement})
          if ref $E eq 'Error::Hierarchy::Internal::DBI::DBH';
        $self->log->info('Application exception: %s', $E);
        $self->log->info('%s',                        $E->stacktrace);

        $self->delegate->set_rollback_mode;
    };
    $self->app_finish;
}
1;


__END__
=pod

=head1 NAME

Class::Scaffold::App - Base class for framework applications

=head1 VERSION

version 1.102280

=head1 SYNOPSIS

    use parent 'Class::Scaffold::App';

    sub app_code {
        my $self = shift;
        $self->SUPER::app_code(@_);
        # ... application-specific tasks ...
    }

    main->new->run_app;

=head1 DESCRIPTION

This is the base class for applications built with the L<Class::Scaffold>
framework, be they command-line applications or server-based applications.