App-CELL
view release on metacpan or search on metacpan
lib/App/CELL/Status.pm view on Meta::CPAN
# Copyright (c) 2014-2020, SUSE LLC
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# 3. Neither the name of SUSE LLC nor the names of its contributors may be
# used to endorse or promote products derived from this software without
# specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# *************************************************************************
package App::CELL::Status;
use strict;
use warnings;
use 5.012;
use App::CELL::Log qw( $log );
use App::CELL::Util qw( stringify_args );
use Data::Dumper;
use Params::Validate qw( :all );
use Storable qw( dclone );
use Scalar::Util qw( blessed );
use Try::Tiny;
=head1 NAME
App::CELL::Status - class for return value objects
=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
This module inherits from C<App::CELL::Message>
=cut
use parent qw( App::CELL::Message );
=head1 DESCRIPTION
An App::CELL::Status object is a reference to a hash containing some or
all of the following keys (attributes):
=over
=item C<level> - the status level (see L</new>, below)
=item C<message> - message explaining the status
=item C<caller> - an array reference containing the three-item list
generated by the C<caller> function
=back
The typical use cases for this object are:
=over
=item As a return value from a function call
=item To trigger a higher-severity log message
=back
All calls to C<< App::CELL::Status->new >> with a status other than OK
trigger a log message.
=head1 PUBLIC METHODS
This module provides the following public methods:
=head2 new
Construct a status object and trigger a log message if the level is anything
other than "OK". Always returns a status object. If no level is specified, the
level will be 'ERR'. If no code is given, the code will be undefined (I think).
lib/App/CELL/Status.pm view on Meta::CPAN
} elsif ( $action eq "fd" ) {
print $fh _prep_dump_string(
level => $self->level,
code => $self->code,
text => $self->text,
), "\n";
} else {
die "App::CELL->Status->dump() doing nothing (bad things happening)";
}
return 1;
}
sub _prep_dump_string {
my %ARGS = validate( @_, {
'level' => 1,
'code' => 0,
'text' => 1,
} );
my $prepped_string = "$ARGS{'level'}: ";
if ( $ARGS{'code'} and $ARGS{'code'} ne $ARGS{'text'} ) {
$prepped_string .= "($ARGS{'code'}) ";
}
$prepped_string .= "$ARGS{'text'}";
return $prepped_string;
}
=head2 ok
If the first argument is blessed, assume we're being called as an
instance method: return true if status is OK, false otherwise.
Otherwise, assume we're being called as a class method: return a
new OK status object with optional payload (optional parameter to the
method call, must be a scalar).
=cut
sub ok {
my ( $self, $payload ) = @_;
my $ARGS = {};
if ( blessed $self )
{ # instance method
return 1 if ( $self->level eq 'OK' );
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';
$ARGS->{payload} = $payload if $payload;
$ARGS->{caller} = [ CORE::caller() ];
return bless $ARGS, __PACKAGE__;
}
=head2 level
Accessor method, returns level of status object in ALL-CAPS. All status
objects must have a level attribute.
=cut
sub level {
my $self = shift;
$self->{'level'} = $_[0] if @_;
return $self->{'level'};
}
=head2 code
Accesor method, returns code of status object, or "C<< <NONE> >>" if none
present.
=cut
sub code {
my $self = shift;
$self->{'code'} = $_[0] if @_;
return $self->{'code'} || "<NONE>";
}
=head2 args
Accessor method - returns value of the 'args' property.
=cut
sub args {
my $self = shift;
$self->{'args'} = $_[0] if @_;
return $self->{'args'};
}
=head2 text
Accessor method, returns text of status object, or the code if no text
( run in 0.529 second using v1.01-cache-2.11-cpan-39bf76dae61 )