view release on metacpan or  search on metacpan

lib/App/MBUtiny/Collector/Client.pm  view on Meta::CPAN

=head1 SEE ALSO

L<App::MBUtiny>, L<WWW::MLite::Client>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<http://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

use vars qw/ $VERSION /;
$VERSION = '1.00';

#use Carp;
#use CTK::TFVals qw/ :ALL /;
use CTK::ConfGenUtil;
#use Try::Tiny;
#use File::Basename qw/basename/;

use base qw/ WWW::MLite::Client /;

use constant {
        CONTENT_TYPE        => "application/json",
        SERIALIZE_FORMAT    => 'json',
        SR_ATTRS            => {
            json => [
                { # For serialize
                    utf8 => 0,
                    pretty => 1,
                    allow_nonref => 1,
                    allow_blessed => 1,
                },
                { # For deserialize
                    utf8 => 0,
                    allow_nonref => 1,
                    allow_blessed => 1,
                },
            ],
        },
    };

sub new {
    my $class = shift;
    my %params = @_;
    $params{sr_attrs}       ||= SR_ATTRS;
    $params{ua_opts}        ||= { agent => "MBUtiny/$VERSION" };
    $params{format}         ||= SERIALIZE_FORMAT;
    $params{content_type}   ||= CONTENT_TYPE;
    $params{no_check_redirect} //= 1;
    return $class->SUPER::new(%params);
}
sub request {
    my $self = shift;
    my $data = $self->SUPER::request(@_);
    my $state = $self->status;
    if ($state) {
        my $err = _check_response($data);
        if ($err) {
            $self->status(0);
            $self->error($err);
        }
    }
    return $data if is_hash($data);
    if ($data) {
        $self->status(0);
        $self->error("Non serialized content found!");
    }
    return {
        status => $self->status,
        error  => $self->error,
    };
}
sub check {
    my $self = shift;
    return $self->request();
}
sub add {
    my $self = shift;
    my %args = @_;
    $self->request(POST => undef, {%args});
    return $self->status;
}
sub del {
    my $self = shift;
    my %args = @_;
    my $base_path = $self->{uri}->path;
    my $name = $args{name};
    unless ($name) {
        $self->error("The name attribute not specified!");
        return $self->status(0);
    }
    my $file = $args{file};
    unless ($file) {
        $self->error("The file attribute not specified!");
        return $self->status(0);
    }
    $self->request(DELETE => sprintf('%s/%s?file=%s&type=%d', $base_path, $name, $file, $args{type} || 0));
    return $self->status;
}
sub list {
    my $self = shift;
    my $uri = $self->{uri}->clone;
    my %args = @_;
    my $name = $args{name};
    unless ($name) {
        $self->error("The name attribute not specified!");
        return ();
    }
    my $path_orig = $uri->path;
    $uri->path(sprintf("%s/list", $path_orig));
    $uri->query_form(name => $name);
    my $list = $self->request(GET => $uri->path_query) || {};
    my $result = array($list, "list");
    return @$result;