File Coverage

blib/lib/Class/Scaffold/App.pm
Criterion Covered Total %
statement 53 61 86.8
branch 4 10 40.0
condition 2 4 50.0
subroutine 14 16 87.5
pod 4 4 100.0
total 77 95 81.0


line stmt bran cond sub pod time code
1 2     2   1595 use 5.008;
  2         8  
  2         87  
2 2     2   14 use warnings;
  2         4  
  2         78  
3 2     2   11 use strict;
  2         4  
  2         114  
4              
5             package Class::Scaffold::App;
6             BEGIN {
7 2     2   44 $Class::Scaffold::App::VERSION = '1.102280';
8             }
9              
10             # ABSTRACT: Base class for framework applications
11 2     2   31 use Class::Scaffold::Environment;
  2         4  
  2         13  
12 2     2   58 use Property::Lookup;
  2         2  
  2         11  
13 2     2   56 use Error ':try';
  2         3  
  2         17  
14 2     2   432 use parent 'Class::Scaffold::Storable';
  2         5  
  2         18  
15             __PACKAGE__->mk_boolean_accessors(qw(initialized));
16 2     2   2504 use IO::Handle;
  2         20103  
  2         171  
17             STDOUT->autoflush;
18             STDERR->autoflush;
19 2     2   20 use constant CONTEXT => 'generic/generic';
  2         4  
  2         1721  
20              
21             sub app_init {
22 2     2 1 5 my $self = shift;
23 2 50       21 return if $self->initialized; # See POD
24 2         22 $self->initialized(1);
25 2         17 my $configurator = Property::Lookup->instance;
26              
27             # If a subclass added a getopt configurator, we can ask it for the
28             # location of the conf file, in case the user specified '--conf' on the
29             # command line. If a filename is given, we'll use that conf file. If the
30             # special string "local" is given, we try to find the conf file.
31             # Otherwise use the one given in an environment variable.
32 2   50     40 my $conf_file_spec = $configurator->conf || $ENV{CF_CONF} || '';
33              
34             # make a note of the configuration file spec in the configurator
35 2         221 $configurator->default_layer->hash(conf_file_spec => $conf_file_spec);
36 2         47 for my $conf_file (split /[:;]/, $conf_file_spec) {
37 2 50       9 if ($conf_file eq 'local') {
38              
39             # only load if needed
40 2         1243 require Class::Scaffold::Introspect;
41 2         10 $conf_file = Class::Scaffold::Introspect::find_conf_file();
42             }
43 2         17 $configurator->add_layer(file => $conf_file);
44             }
45 2   50     59833 $self->log->max_level(1 + ($configurator->verbose || 0));
46              
47             # Now that we have both a getopt and a file configurator, the log file
48             # name can come from either the command line (preferred) or the conf file.
49 2 50       525 $self->log->filename($configurator->logfile)
50             if defined $configurator->logfile;
51              
52             # This class subclasses Class::Scaffold::Base, which returns
53             # Class::Scaffold::Environment->getenv as the default delegate. So set the
54             # proper environment here and then pass the newly formed delegate the
55             # configurator. The environment will make use of it in its methods.
56 2         258 Class::Scaffold::Environment->setenv($configurator->environment);
57 2         63 $self->delegate->setup;
58 2         1745 $self->delegate->configurator($configurator);
59 2         32 $self->delegate->context(
60             Class::Scaffold::Context->new->parse_context($self->CONTEXT));
61 2 50       64 if ($configurator->dryrun) {
62 0         0 $self->log->clear_timestamp;
63 0         0 $self->delegate->set_rollback_mode;
64             }
65             }
66 0     0 1 0 sub app_finish { 1 }
67 2     2 1 5 sub app_code { }
68              
69             sub run_app {
70 2     2 1 31 my $self = shift;
71 2         18 $self->app_init;
72 2         355 $Error::Debug++; # to get a stacktrace
73             try {
74 2     2   78 $self->app_code;
75             }
76             catch Error with {
77 0     0   0 my $E = shift;
78 0 0       0 $self->log->info($E->{statement})
79             if ref $E eq 'Error::Hierarchy::Internal::DBI::DBH';
80 0         0 $self->log->info('Application exception: %s', $E);
81 0         0 $self->log->info('%s', $E->stacktrace);
82              
83 0         0 $self->delegate->set_rollback_mode;
84 2         30 };
85 2         6352 $self->app_finish;
86             }
87             1;
88              
89              
90             __END__