App-CELL
view release on metacpan or search on metacpan
0.107 2014-05-24 10:19
- Load.pm: add sanity check to constructor (ticket #21)
- config/: fix spelling of params, add params for sanity check
- Message.pm: tell Data::Dumper to not include any newlines
0.108 2014-05-24 12:26
- Load.pm: suppress caller info in "parsed message" $log->debug call,
generate more useful warnings/errors in find_files
- Log.pm: expand AUTOLOAD routine, improve caller handling, eliminate ok
and not_ok wrappers
- Message.pm: improve caller handling in constructor
- Status.pm: improve caller handling in constructor, make 'caller' accessor
return array ref instead of array
- t/070-config.t: turn on debug_mode
- Config.pm, CELL_Message_en.conf: add value to CELL_OVERWRITE_META_PARAM,
remove unused error/warning messages
0.109 2014-05-24 15:18
- Config.pm: cleanup 'get_param'
- Log.pm: work on POD, fix AUTOLOAD so it passes all calls through to
MIGHT IMPLEMENT SOMEDAY
20140526 release.sh process multiple arguments (ATM it takes only one)
20140529 Status.pm: 'ok' and 'not_ok' methods are almost identical - use a
"subroutine factory" to generate them
20140529 Guide.pm: write verbiage about how statuses are for handling
expected errors. It's still OK to croak if something unexpected
happens.
20140609 If sitedir is passed to load routine by argument or environment
variable, return an error status if sitedir not loaded
20140610 Clarify that messages cannot be overwritten
20140610 Implement Status.pm->dump (currently just a stub)
20140610 Change debug_mode to log_level (for finer granularity of control)
20140613 Log.pm: add a check for (caller)[0] -- if being called from
lib/App/CELL.pm view on Meta::CPAN
Constructor for 'FATAL' status objects
=head3 status_info
Constructor for 'INFO' status objects
=head3 status_inform
Constructor for 'INFORM' status objects
=head3 status_not_ok
Constructor for 'NOT_OK' status objects
=head3 status_notice
Constructor for 'NOTICE' status objects
=head3 status_ok
Constructor for 'OK' status objects
lib/App/CELL.pm view on Meta::CPAN
=head2 msg
Construct a message object (wrapper for App::CELL::Message::new)
=cut
sub msg {
my ( $self, $code, @ARGS ) = @_;
my $status = App::CELL::Message->new( code => $code, args => [ @ARGS ] );
return if $status->not_ok; # will return undef in scalar mode
return $status->payload if blessed $status->payload;
return;
}
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2014-2020, SUSE LLC
lib/App/CELL/Config.pm view on Meta::CPAN
=head2 set
Use this function to set new params (meta/core/site) or change existing
ones (meta only). Takes two arguments: parameter name and new value.
Returns a status object.
=cut
sub set {
my ( $self, $param, $value ) = @_;
return App::CELL::Status->not_ok if not blessed $self;
my %ARGS = (
level => 'OK',
caller => [ CORE::caller() ],
);
if ( $self->{'CELL_CONFTYPE'} eq 'meta' ) {
if ( exists $meta->{$param} ) {
%ARGS = (
%ARGS,
code => 'CELL_OVERWRITE_META_PARAM',
args => [ $param, ( defined( $value ) ? $value : 'undef' ) ],
lib/App/CELL/Guide.pm view on Meta::CPAN
message file in the sitedir with a code like DISP_OUT_OF_RANGE.)
On success, C<foo_dis> could return an 'OK' status with the gidget
displacement value in the payload:
return $CELL->status_ok( payload => $displacement );
The calling function could check the return value like this:
my $status = foo_dis();
return $status if $status->not_ok;
my $displacement = $status->payload;
For details, see L<App::CELL::Status> and L<App::CELL::Message>.
CELL's error-handling logic is inspired by brian d foy's article "Return
error objects instead of throwing exceptions"
L<http://www.effectiveperlprogramming.com/2011/10/return-error-objects-instead-of-throwing-exceptions/>
lib/App/CELL/Load.pm view on Meta::CPAN
=head1 SYNOPSIS
use App::CELL::Load;
# Load App::CELL's internal messages and config params and then
# attempt to load the application's messages and config params
$status = App::CELL::Load::init();
return $status if $status->not_ok;
# attempt to determine the site configuration directory
my $resulthash = App::CELL::Load::get_sitedir();
# get a reference to a list of configuration files (full paths) of a
# given type under a given directory
my $metafiles = App::CELL::Load::find_files( '/etc/CELL', 'meta' );
# load messages from all message file in a given directory and all its
# subdirectories
lib/App/CELL/Load.pm view on Meta::CPAN
code => "Attempt to load while in taint mode (-T)" );
}
# look up sharedir
if ( not $sharedir ) {
my $tmp_sharedir = File::ShareDir::dist_dir('App-CELL');
if ( ! is_directory_viable( $tmp_sharedir ) ) {
return App::CELL::Status->new(
level => 'ERR',
code => 'CELL_SHAREDIR_NOT_VIABLE',
args => [ $tmp_sharedir, $App::CELL::Util::not_viable_reason ],
);
}
$log->info( "Found viable CELL configuration directory " .
$tmp_sharedir . " in App::CELL distro", cell => 1 ) if $meta->CELL_META_LOAD_VERBOSE;
$site->set( 'CELL_SHAREDIR_FULLPATH', $tmp_sharedir );
$sharedir = $tmp_sharedir;
}
# walk sharedir
if ( $sharedir and not $sharedir_loaded ) {
my $status = message_files( $sharedir );
my $load_status = _report_load_status( $sharedir, 'sharedir', 'message', $status );
return $load_status if $load_status->not_ok;
$status = meta_core_site_files( $sharedir );
$load_status = _report_load_status( $sharedir, 'sharedir', 'config params', $status );
return $load_status if $load_status->not_ok;
$site->set( 'CELL_SHAREDIR_LOADED', 1 );
$sharedir_loaded = 1;
}
if ( $meta->CELL_META_LOAD_VERBOSE ) {
if ( @sitedir ) {
$log->debug( "sitedir package variable contains ->" .
join( ':', @sitedir ) . "<-", cell => 1 );
} else {
$log->debug( "sitedir package variable is empty", cell => 1 );
lib/App/CELL/Load.pm view on Meta::CPAN
my ( $sitedir, $log_message, $status );
GET_CANDIDATE_DIR: {
# look in paramhash for sitedir
$log->debug( "SITEDIR SEARCH, ROUND 1 (sitedir parameter):", cell => 1 );
if ( $sitedir = $paramhash{sitedir} ) {
$log_message = "Viable sitedir passed as argument";
last GET_CANDIDATE_DIR if is_directory_viable( $sitedir );
$reason = "CELL load routine received 'sitedir' argument ->$sitedir<- " .
"but this is not a viable directory ($App::CELL::Util::not_viable_reason)";
$log->err( $reason, cell => 1 );
return App::CELL::Status->new( level => 'ERR', code => $reason );
}
$log->debug( "looked at function arguments but they do not " .
"contain a literal site dir path", cell => 1 );
# look in paramhash for name of environment variable
$log->debug( "SITEDIR SEARCH, ROUND 2 (enviro parameter):", cell => 1 );
if ( $paramhash{enviro} )
{
if ( $sitedir = $ENV{ $paramhash{enviro} } ) {
$log_message = "Found viable sitedir in " . $paramhash{enviro}
. " environment variable";
last GET_CANDIDATE_DIR if is_directory_viable( $sitedir );
$reason = "CELL load routine received 'enviro' argument ->$paramhash{enviro}<- " .
"which expanded to ->$sitedir<- but this is not a viable directory " .
"($App::CELL::Util::not_viable_reason)";
return App::CELL::Status->new( level => 'ERR', code => $reason );
} else {
$reason = "CELL load routine: enviro argument contained ->$paramhash{enviro}<- " .
"but no such variable found in the environment";
return App::CELL::Status->new( level => 'ERR', code => $reason );
}
}
# fall back to hard-coded environment variable
$log->debug( "SITEDIR SEARCH, ROUND 3 (fallback to CELL_SITEDIR " .
"environment variable):", cell => 1 );
$sitedir = undef;
if ( $sitedir = $ENV{ 'CELL_SITEDIR' } ) {
$log_message = "Found viable sitedir in CELL_SITEDIR environment variable";
last GET_CANDIDATE_DIR if is_directory_viable( $sitedir );
$reason = "CELL load routine: no 'sitedir', 'enviro' arguments specified; " .
"fell back to CELL_SITEDIR environment variable, which exists " .
"with value ->$sitedir<- but this is not a viable directory" .
"($App::CELL::Util::not_viable_reason)";
if ( $meta->CELL_META_SITEDIR_LOADED ) {
$log->warn( $reason, cell => 1 );
$log->notice( "The following sitedirs have been loaded already " .
join( ' ', @{ $meta->CELL_META_SITEDIR_LIST }),
cell => 1 );
return App::CELL::Status->ok;
}
return App::CELL::Status->new( level => 'WARN', code => $reason );
}
lib/App/CELL/Log.pm view on Meta::CPAN
# do not append filename and line number of caller
$log->init( show_caller => 0 );
# log messages at different log levels
my $level = 'warn' # can be any of the levels provided by Log::Any
$log->$level ( "Foobar log message" );
# the following App::CELL-specific levels are supported as well
$log->ok ( "Info-level message prefixed with 'OK: '");
$log->not_ok ( "Info-level message prefixed with 'NOT_OK: '");
# by default, the caller's filename and line number are appended
# to suppress this for an individual log message:
$log->debug ( "Debug-level message", suppress_caller => 1 );
# Log a status object (happens automatically when object is
# constructed)
$log->status_obj( $status_obj );
# Log a message object
lib/App/CELL/Status.pm view on Meta::CPAN
=head1 SYNOPSIS
use App::CELL::Status;
# simplest usage
my $status = App::CELL::Status->ok;
print "ok" if ( $status->ok );
$status = App::CELL::Status->not_ok;
print "NOT ok" if ( $status->not_ok );
# as a return value: in the caller
my $status = $XYZ( ... );
return $status if not $status->ok; # handle failure
my $payload = $status->payload; # handle success
=head1 INHERITANCE
lib/App/CELL/Status.pm view on Meta::CPAN
return 0;
}
$ARGS->{level} = 'OK';
$ARGS->{payload} = $payload if $payload;
$ARGS->{caller} = [ CORE::caller() ];
return bless $ARGS, __PACKAGE__;
}
=head2 not_ok
Similar method to 'ok', except it handles 'NOT_OK' status.
When called as an instance method, returns a true value if the status level
is anything other than 'OK'. Otherwise false.
When called as a class method, returns a 'NOT_OK' status object.
Optionally, a payload can be supplied as an argument.
=cut
sub not_ok {
my ( $self, $payload ) = @_;
my $ARGS = {};
if ( blessed $self )
{ # instance method
return 1 if $self->{level} ne 'OK';
return 0;
}
$ARGS->{level} = 'NOT_OK';
lib/App/CELL/Util.pm view on Meta::CPAN
=head1 SYNOPSIS
use App::CELL::Util qw( utc_timestamp is_directory_viable );
# utc_timestamp
print "UTC time is " . utc_timestamp() . "\n";
# is_directory_viable
my $status = is_directory_viable( $dir_foo );
print "$dir_foo is a viable directory" if $status->ok;
if ( $status->not_ok ) {
my $problem = $status->payload;
print "$dir_foo is not viable because $problem\n";
}
=cut
=head1 EXPORTS
This module provides the following public functions:
lib/App/CELL/Util.pm view on Meta::CPAN
use Exporter qw( import );
our @EXPORT_OK = qw( is_directory_viable stringify_args utc_timestamp );
=head1 PACKAGE VARIABLES
=cut
our $not_viable_reason = '';
=head1 FUNCTIONS
=head2 is_directory_viable
Run viability checks on a directory. Takes: full path to directory. Returns
true (directory viable) or false (directory not viable). If the directory
is not viable, it sets the package variable
C<< $App::CELL::Util::not_viable_reason >>.
=cut
sub is_directory_viable {
my $confdir = shift;
my $problem = '';
CRIT_CHECK: {
if ( not -e $confdir ) {
lib/App/CELL/Util.pm view on Meta::CPAN
$problem = "exists but not a directory";
last CRIT_CHECK;
}
if ( not -r $confdir or not -x $confdir ) {
$problem = "directory exists but insufficient permissions";
last CRIT_CHECK;
}
} # CRIT_CHECK
if ( $problem ) {
$not_viable_reason = $problem;
return 0;
}
return 1;
}
=head2 stringify_args
Convert args (or any data structure) into a string -- useful for error
t/001-log.t view on Meta::CPAN
$log->err ( "ERR log message" );
$log->contains_only_ok( "ERR log message", 'err works' );
$log->crit ( "CRIT log message" );
$log->contains_only_ok( "CRIT log message", 'crit works' );
$log->alert ( "ALERT log message" );
$log->contains_only_ok( "ALERT log message", 'alert works' );
$log->emergency ( "EMERGENCY log message" );
$log->contains_only_ok( "EMERGENCY log message", 'emergency works' );
$log->ok ( "OK log message" );
$log->contains_only_ok( "OK log message", 'ok works' );
$log->not_ok ( "NOT_OK log message" );
$log->contains_only_ok( "NOT_OK log message", 'not_ok works' );
my $status = App::CELL::Load::init( verbose => 1 );
is( $status->level, "WARN", "Messages from sharedir loaded" );
$log->clear();
$log->init( debug_mode => 0 );
$status = App::CELL::Status->new( level => 'NOTICE',
code => 'CELL_TEST_MESSAGE' );
# diag( $status->dump() );
$log->contains_only_ok( 'NOTICE: \(CELL_TEST_MESSAGE\) This is a test message', "NOTICE test message ok" );
t/002-util.t view on Meta::CPAN
File::Spec->rootdir(),
);
#diag( "Testing directory $test_dir" );
$status = is_directory_viable( $test_dir );
ok( $status, "Root directory is viable" );
# App::CELL::Util::is_directory_viable with a non-viable directory
$test_dir = "###foobarbazblat342###";
#diag( "Testing directory $test_dir" );
$status = is_directory_viable( $test_dir );
#diag( $App::CELL::Util::not_viable_reason ) unless $status;
ok( ! $status, "Invalid directory is not viable" );
is( $App::CELL::Util::not_viable_reason, "does not exist",
"Invalid directory is not viable for the right reason" );
done_testing;
t/005-message.t view on Meta::CPAN
is_deeply( App::CELL::Message::supported_languages(), [ 'en' ],
"Hard-coded list of supported languages consists of just 'en'" );
ok( App::CELL::Message::language_supported( 'en' ),
"English is a supported language" );
# N.B.: App::CELL is not initialized at this point, so no messages or
# config params have been loaded
my $status = App::CELL::Message->new();
#diag( Dumper $status );
ok( $status->not_ok, "Message->new with no code is not OK");
ok( $status->level eq 'ERR', "Message->new with no code returns ERR status");
is( $status->code, 'CELL_MESSAGE_NO_CODE', "Error message code is correct" );
is( $status->text, 'CELL_MESSAGE_NO_CODE', "Error message text is correct" );
#diag( $message->stringify );
$status = App::CELL::Message->new( code => undef );
ok( $status->not_ok, "Message->new with no code is not OK");
ok( $status->level eq 'ERR', "Message->new with no code returns ERR status");
is( $status->code, 'CELL_MESSAGE_CODE_UNDEFINED', "Error message code is correct" );
is( $status->text, 'CELL_MESSAGE_CODE_UNDEFINED', "Error message text is correct" );
$status = App::CELL::Message->new( code => 'UNGHGHASDF!*' );
ok( $status->ok, "Message->new with unknown code is OK");
my $message = $status->payload();
is( $message->code, 'UNGHGHASDF!*', "Unknown message codes are passed through" );
#diag( "Text of " . $message->code . " message is ->" . $message->text . "<-" );
t/030-status.t view on Meta::CPAN
use Test::Warnings;
my $status;
$log->init( ident => 'CELLtest' );
$log->info("------------------------------------------------- ");
$log->info("--- 030-status.t ---");
$log->info("------------------------------------------------- ");
$status = App::CELL::Status->ok;
ok( $status->ok, "OK status is OK" );
ok( ! $status->not_ok, "OK status is not not_ok" );
is( $status->level, "OK", "level returns OK" );
is( $status->code, "<NONE>", "No code");
my $caller = $status->caller;
is( scalar @$caller , 3, "Caller is present" );
is( @$caller[0], "main", "First element of caller is 'main'" );
$status = App::CELL::Status->ok( "My payload" );
is( $status->payload, "My payload", "OK status can take a payload" );
$status = App::CELL::Status->not_ok;
ok( $status->not_ok, "NOT_OK status is not_ok" );
ok( ! $status->ok, "NOT_OK status is not ok" );
is( $status->level, "NOT_OK", "level returns NOT_OK" );
is( $status->code, "<NONE>", "No code");
$caller = $status->caller;
is( scalar @$caller , 3, "Caller is present" );
is( @$caller[0], "main", "First element of caller is 'main'" );
$status = App::CELL::Status->not_ok( "Not my payload" );
is( $status->payload, "Not my payload", "NOT_OK status can take a payload" );
$status = App::CELL::Status->new( level => 'OK' );
ok( $status->ok, "OK status via new is OK" );
ok( ! $status->not_ok, "OK status via new is not not_ok" );
is( $status->level, "OK", "level returns OK" );
is( $status->code, "<NONE>", "No code");
$caller = $status->caller;
is( scalar @$caller , 3, "Caller is present" );
is( @$caller[0], "main", "First element of caller is 'main'" );
$status = App::CELL::Status->new( level => 'NOT_OK' );
ok( $status->not_ok, "NOT_OK status via new is not OK" );
ok( ! $status->ok, "NOT_OK status via new is not OK" );
is( $status->level, "NOT_OK", "level returns NOT_OK" );
is( $status->code, "<NONE>", "No code");
$caller = $status->caller;
is( scalar @$caller , 3, "Caller is present" );
is( @$caller[0], "main", "First element of caller is 'main'" );
$status = App::CELL::Status->new( level => 'DEBUG', code => 'Bugs galore' );
ok( $status->not_ok, "DEBUG status is not OK" );
is( $status->level, "DEBUG", "level returns DEBUG" );
is( $status->code, 'Bugs galore', "Has the right code" );
is( @$caller[0], "main", "First element of caller is 'main'" );
$status = App::CELL::Status->new( level => 'FOOBAR', code => 'Bugs flying',
payload => "Obstinate" );
is( $status->level, "ERR", "Attempt to create status with non-existent level defaults to ERR level");
is( $status->code, "Bugs flying", "Code is there");
is( @$caller[0], "main", "First element of caller is 'main'" );
is( $status->payload, "Obstinate", "FOOBAR-level status can take a payload" );
$status = App::CELL::Status->new( level => 'INFO' );
is( $status->level, "INFO", "INFO level is INFO" );
ok( $status->not_ok, "INFO status is not OK" );
ok( ! $status->ok, "INFO status is not OK in another way" );
$status = App::CELL::Status->new( level => 'NOTICE', foobar => 44 );
is( $status->level, "NOTICE", "NOTICE level is NOTICE" );
ok( $status->not_ok, "NOTICE status is not OK" );
is( $status->{foobar}, 44, "Value of undocumented attribute obtainable by cheating" );
$status = App::CELL::Status->new( level => 'WARN' );
ok( $status->not_ok, "WARN status is not OK" );
$status = App::CELL::Status->new( level => 'ERR' );
ok( $status->not_ok, "ERR status is not OK" );
$status = App::CELL::Status->new( level => 'CRIT' );
ok( $status->not_ok, "CRIT status is not OK" );
$status = App::CELL::Status->new( level => 'OK',
payload => [ 0, 'foo' ] );
ok( $status->ok, "OK status object with payload is OK" );
is_deeply( $status->payload, [ 0, 'foo' ], "Payload is retrievable" );
$status = App::CELL::Status->new(
level => 'NOTICE',
code => "Pre-init notice w/arg ->%s<-",
args => [ "CONTENT" ],
);
ok( ! $status->ok, "Our pre-init status is not OK" );
ok( $status->not_ok, "Our pre-init status is not_ok" );
is( $status->msgobj->text, "Pre-init notice w/arg ->CONTENT<-", "Access message object through the status object" );
$status = App::CELL::Status->new(
level => 'CRIT',
code => "This is just a test. Don't worry; be happy.",
payload => "FOOBARBAZ",
);
is( $status->payload, "FOOBARBAZ", "Payload accessor function returns the right value" );
is( $status->level, "CRIT", "Level accessor function returns the right value" );
t/100-cell.t view on Meta::CPAN
$status = $CELL->status_fatal( 'CELL_TEST_MESSAGE' );
ok( $status->level eq 'FATAL' );
$status = $CELL->status_info( 'CELL_TEST_MESSAGE' );
ok( $status->level eq 'INFO' );
$status = $CELL->status_inform( 'CELL_TEST_MESSAGE' );
ok( $status->level eq 'INFORM' );
$status = $CELL->status_not_ok( 'CELL_TEST_MESSAGE' );
ok( $status->level eq 'NOT_OK' );
$status = $CELL->status_notice( 'CELL_TEST_MESSAGE' );
ok( $status->level eq 'NOTICE' );
$status = $CELL->status_ok( 'CELL_TEST_MESSAGE' );
ok( $status->level eq 'OK' );
$status = $CELL->status_trace( 'CELL_TEST_MESSAGE' );
ok( $status->level eq 'TRACE' );
t/111-site.t view on Meta::CPAN
$log->info("------------------------------------------------------- ");
$log->info("--- 111-site.t ---");
$log->info("------------------------------------------------------- ");
is( $CELL->loaded, 0, "\$CELL->loaded is zero before anything is loaded" );
ok( ! defined( $meta->CELL_META_SITEDIR_LOADED ), "Meta param undefined before load");
my $sitedir = 'NON-EXISTENT-FOO-BAR-DIRECTORY';
ok( ! -e $sitedir, "Non-existent foo bar directory does not exist" );
$status = $CELL->load( sitedir => $sitedir );
is( $CELL->loaded, "SHARE", "\$CELL->loaded is SHARE after unsuccessful call to \$CELL->load" );
ok( $status->not_ok, "CELL initialization with non-existent sitedir NOT ok" );
is( $status->level, "ERR", "Status is ERR" );
like( $status->code, qr/\(does not exist\)/, "Status code contains expected string" );
$status = undef;
delete $ENV{'CELL_SITEDIR'};
$status = $CELL->load();
is( $status->level, 'WARN', "No arguments, no environment, no previous sitedir -> warning" );
$status = $CELL->load( enviro => 'FOO_BAR_ENVIRO_PARAM' );
ok( $status->not_ok, "Load with non-existent enviro param is NOT_OK" );
is( $status->level, 'ERR', "Load with non-existent enviro param yields ERR status" );
$ENV{'CELL_SITEDIR'} = 'NON-EXISTENT-FOO-BAR-DIRECTORY';
$status = undef;
$status = $CELL->load();
ok( $status->not_ok, "Load without arguments, with CELL_SITEDIR defined to a bad value, returns NOT_OK status" );
done_testing;
( run in 0.342 second using v1.01-cache-2.11-cpan-4d4bc49f3ae )