view release on metacpan or  search on metacpan

lib/App/Dochazka/CLI/Util.pm  view on Meta::CPAN

        if $debug_mode;

    $rv .= "Error encountered on attempted operation \"$oper_desc\"\n";

    # special handling if payload is a string
    if ( ref( $status->payload ) eq '' ) {

        $rv .= $status->payload;
        $rv .= "\n";

    } elsif ( ref( $status->payload ) eq 'HASH' ) {

        my $http_status = $status->{'http_status'} || 
                          $status->payload->{'http_code'} || 
                          "Cannot be determined";
        my $method      = $status->payload->{'http_method'} || 
                          "Cannot be determined";
        my $uri_path    = $status->payload->{'uri_path'} || 
                          '';
        $rv .= "REST operation: $method $uri_path\n";
        $rv .= "HTTP status: $http_status\n";
        $rv .= "Explanation: ";
        $rv .= $status->code;
        $rv .= ( $status->code eq $status->text ) 
            ? "\n"
            : ': ' . $status->text . "\n";
        $rv .= "Permanent? ";
        $rv .= ( $status->payload->{'permanent'} )
            ? "YES\n"
            : "NO\n";

    } else {
        die "AH! in rest_error, payload is neither a hashref nor an ordinary scalar";
    }

    my $status_clone = App::CELL::Status->new( 
        level => $status->level,
        code => 'REST_ERROR',
        payload => $rv,
        rest_payload => $status->payload,
        uri_path => $status->{'uri_path'},
        http_status => $status->{'http_status'},
    );
    return $status_clone;
}


=head2 truncate_to

Given a string and a maximum length (defaults to 32), truncates to that length.
Returns a copy of the string. If any characters were actually removed in the
truncate operation, '...' is appended -- unless the maximum length is zero, in
which case the empty string is returned.

=cut

sub truncate_to {
    my ( $str, $mlen ) = validate_pos( @_, 
        { type => SCALAR|UNDEF },
        { 
            callbacks => {
                'greater than or equal to zero' => sub { shift() >= 0 },
            },
            optional => 1,
            type => SCALAR, 
        },
    );
    $mlen = 32 unless defined( $mlen );
    my $len = length $str || 0;  # $str might be undef
    return $str unless $len > $mlen;
    my $str_copy = substr( $str, 0, $mlen );
    $str_copy .= '...' if $len > $mlen;
    $str_copy = '' if $mlen == 0;
    return $str_copy;  # might be undef
}


1;