view release on metacpan or  search on metacpan

lib/App/CELL/Status.pm  view on Meta::CPAN

    # if caller array not given, create it
    if ( not $ARGS{caller} ) {
        $ARGS{caller} = [ CORE::caller() ];
    }

    $ARGS{args} = [] if not defined( $ARGS{args} );
    $ARGS{called_from_status} = 1;

    if ( $ARGS{code} ) {
        # App::CELL::Message->new returns a status object
        my $status = $class->SUPER::new( %ARGS );
        if ( $status->ok ) {
            my $parent = $status->payload;
            $ARGS{msgobj} = $parent;
            $ARGS{code} = $parent->code;
            $ARGS{text} = $parent->text;
        } else {
            $ARGS{code} = $status->code;
            if ( $ARGS{args} ) {
               $ARGS{text} = $status->text . stringify_args( $ARGS{args} );
            } else {
               $ARGS{text} = $status->text;
            }
        }
    }

    # bless into objecthood
    $self = bless \%ARGS, 'App::CELL::Status';

    # Log the message
    $log->status_obj( $self, cell => ( $ARGS{cell} || 0 ) ) if ( $ARGS{level} ne 'OK' and $ARGS{level} ne 'NOT_OK' );

    # return the created object
    return $self;
}


=head2 dump

Dump an existing status object. Takes: PARAMHASH. Parameter 'to' determines
destination, which can be 'string' (default), 'log' or 'fd'.

    # dump object to string
    my $dump_str = $status->dump();
       $dump_str = $status->dump( to => 'string' );

    # dump object to log
    $status->dump( to => 'log' );

    # dump object to file descriptor
    $status->dump( fd => STDOUT );
    $status->dump( to => 'fd', fd => \*STDOUT );

Always returns a true value.

=cut

sub dump {
    my $self = shift;
    my ( %ARGS ) = validate( @_, { 'to' => 0, 'fd' => 0 } );
    my ( $action, $fh );
    if ( not %ARGS ) {
        $action = 'string';
    } elsif ( exists $ARGS{'to'} ) {
        if ( $ARGS{'to'} eq 'string' ) {
            $action = 'string';
        } elsif ( $ARGS{'to'} eq 'log' ) {
            $action = 'log';
        } elsif ( $ARGS{'to'} eq 'fd' and exists $ARGS{'fd'} ) {
            $action = 'fd';
            $fh = $ARGS{'fd'};
        } else {
            die "App::CELL->Status->dump() doing nothing (bad arguments)";
        }
    } elsif ( exists $ARGS{'fd'} ) {
        $action = 'fd';
        $fh = $ARGS{'fd'};
    } else {
        die "App::CELL->Status->dump() doing nothing (bad arguments)";
    }
    if ( $action eq "string" ) {
        return _prep_dump_string(
            level => $self->level,
            code => $self->code,
            text => $self->text,
        );
    } elsif ( $action eq "log" ) {
        $log->status_obj( $self );
    } 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 = {};