view release on metacpan or  search on metacpan

lib/App/MBUtiny/Storage/HTTP.pm  view on Meta::CPAN

package App::MBUtiny::Storage::HTTP; # $Id: HTTP.pm 121 2019-07-01 19:51:50Z abalama $
use strict;
use utf8;

=encoding utf-8

=head1 NAME

App::MBUtiny::Storage::HTTP - App::MBUtiny::Storage subclass for HTTP storage support

=head1 VIRSION

Version 1.00

=head1 SYNOPSIS

  <Host "foo">
    <HTTP>
        FixUP   on
        URL     https://user:password@example.com/mbuserver/foo/dir1
        URL     https://user:password@example.com/mbuserver/foo/dir2
        Set     User-Agent TestServer/1.00
        Set     X-Test Foo Bar Baz
        Comment HTTP storage said blah-blah-blah # Optional for collector
    </HTTP>

    # . . .

  </Host>

=head1 DESCRIPTION

App::MBUtiny::Storage subclass for HTTP storage support

=head2 del

Removes the specified file.
This is backend method of L<App::MBUtiny::Storage/del>

=head2 get

Gets the backup file from storage and saves it to specified path.
This is backend method of L<App::MBUtiny::Storage/get>

=head2 init

The method performs initialization of storage.
This is backend method of L<App::MBUtiny::Storage/init>

=head2 list

Gets backup file list on storage.
This is backend method of L<App::MBUtiny::Storage/list>

=head2 http_storages

    my @list = $storage->http_storages;

Returns list of HTTP storage nodes

=head2 put

Sends backup file to storage.
This is backend method of L<App::MBUtiny::Storage/put>

=head2 test

Storage testing.
This is backend method of L<App::MBUtiny::Storage/test>

=head1 HISTORY

See C<Changes> file

=head1 TO DO

See C<TODO> file

=head1 BUGS

* none noted

=head1 SEE ALSO

L<App::MBUtiny::Storage>

=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 Storable qw/dclone/;
use URI;
use List::Util qw/uniq/;
use CTK::ConfGenUtil;
use CTK::TFVals qw/ :ALL /;
use App::MBUtiny::Util qw/ node2anode set2attr hide_password filesize /;

use constant {
        STORAGE_SIGN => 'HTTP',
    };

sub init {
    my $self = shift;
    $self->maybe::next::method();
    $self->storage_status(STORAGE_SIGN, -1);
    my $usehttp = 0;

    my $http_nodes = dclone(node2anode(node($self->{host}, 'http')));
    #print explain($http_nodes), "\n";

    my %http_storages;
    foreach my $http_node (@$http_nodes) {
        my $urls = array($http_node, 'url') || [];
        my $attr = set2attr($http_node),
        my $timeout = uv2zero(value($http_node, 'timeout'));
        my $cmnt = value($http_node, 'comment') || "";
        foreach my $url (@$urls) {
            my $url_wop = hide_password($url, 2);
            $http_storages{$url} = {
                    url     => $url,
                    url_wop => $url_wop,
                    attr    => dclone($attr),
                    timeout => $timeout,
                    comment => join("\n", grep {$_} ($url_wop, $cmnt)),
                    fixup   => value($http_node, 'fixup') ? 1 : 0,
                };
            $usehttp++;
        }
    }
    $self->{http_storages} = [(values(%http_storages))];

    $self->storage_status(STORAGE_SIGN, $usehttp) if $usehttp;
    #print explain($self->{http_storages}), "\n";
    return $self;
}
sub http_storages {
    my $self = shift;
    my $storages = $self->{http_storages} || [];
    return @$storages;
}
sub test {
    my $self = shift;
    my %params = @_; $self->maybe::next::method(%params);
    my $sign = STORAGE_SIGN;
    return -1 if $self->storage_status($sign) <= 0; # SKIP

    my @test = ();
    foreach my $storage ($self->http_storages) {
        my $url = $storage->{url};
        my $url_wop = $storage->{url_wop};
        my $attr = $storage->{attr};

        # Create object
        my $client = new App::MBUtiny::Storage::HTTP::Client(
            url     => $url, # Base URL
            timeout => $storage->{timeout}, # default: 180
            ($attr && isnt_void($attr)) ? (headers => $attr) : (),
        );
        unless ($client->status) {
            $self->storage_status($sign, 0);
            push @test, [0, $url_wop, sprintf("Can't connect to %s: %s", $url_wop, $client->error)];
            next;
        }

        # Check server
        unless ($client->check) {
            $self->storage_status($sign, 0);
            push @test, [0, $url_wop, sprintf("Server not running or not configured (%s): %s", $url_wop, $client->error)];
            next;
        }

        push @test, [1, $url_wop];
    }

    $self->{test}->{$sign} = [@test];
    return 1;
}
sub put {