view release on metacpan or  search on metacpan

lib/API/ISPManager.pm  view on Meta::CPAN

        s/\/+$//sgi;
    }
    
    return $str;
}

# Make full query string (with host, path and protocol)
# STATIC(HASHREF: params)
# params:
# host*
# path
# allow_http
# param1
# param2 
# ...
sub mk_full_query_string {
    my $params = shift;

    return '' unless
        $params               &&
        ref $params eq 'HASH' &&
        %$params              &&
        $params->{host};

    my $host       = delete $params->{host};
    my $path       = delete $params->{path}        || '';
    my $allow_http = delete $params->{allow_http}  || '';

    unless ($path) {
        $path = 'manager';
    }

    $path = kill_start_end_slashes($path);
    $host = kill_start_end_slashes($host);

    my $query_path = ( $allow_http ? 'http' : 'https' ) . "://$host/$path/ispmgr?";

    return %$params ? $query_path . mk_query_string($params) : '';
}


# Make request to server and get answer
# STATIC (STRING: query_string)
sub mk_query_to_server {
    my $query_string = shift;

    return '' unless $query_string;
    warn "Query string: $query_string\n" if $DEBUG;

    my $ua = LWP::UserAgent->new;
    $ua->agent("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)");
    # Don`t working without this string!

    my $response = $ua->get($query_string);

    if ($response->is_success) {
        my $content = $response->content;

        if ($response->header('content-type') eq 'text/xml') {
            # allow only XML answers
            if ($content && $content =~ /^<\?xml version="\d\.\d" encoding="UTF-8"\?>/s) {
                warn $content if $DEBUG;
                return $content;
            } else {
                return '';
            }
        } else {
            return '';
        }
    } else {
        return '';
    }
}

# Parse answer
# STATIC(HASHREF: params)
# params:
#  STRING: answer
#  HASHREF: xml_parser_params)
sub parse_answer {
    my %params = @_;

    my $answer_string =
        $params{answer};
    my $parser_params =
        $params{parser_params} || { };

    return '' unless $answer_string;

    my $deparsed = XMLin( $answer_string, %$parser_params );
    warn Dumper $deparsed if $DEBUG;
    
    return $deparsed ? $deparsed : '';
}

# Get + deparse
# STATIC(STRING: query_string)
sub process_query {
    my %params = @_;

    my $query_string      = $params{query_string};
    my $xml_parser_params = $params{parser_params} || '';
    my $fake_answer       = $params{fake_answer} || '';

    return '' unless $query_string;

    my $answer = $fake_answer ? $fake_answer : mk_query_to_server($query_string);
    warn $answer if $answer && $DEBUG;

    return $answer ?
        parse_answer(
            answer        => $answer,
            parser_params => $xml_parser_params
        ) : '';
}

# Filter hash
# STATIC(HASHREF: hash, ARRREF: allowed_keys)
# RETURN: hashref only with allowed keys
sub filter_hash {
    my ($hash, $allowed_keys) = @_;