#
# DESCRIPTION:
#   Plesk communicate interface. Some methods for Plesk methods (Accounts, Domains, Templates).
# AUTHORS:
#   Pavel Odintsov (nrg) <pavel.odintsov@gmail.com>
#
#========================================================================

package API::Plesk::Methods;

use strict;
use warnings;

use Carp;
use Data::Dumper;

our $VERSION = '1.01';

=head1 NAME

API::Plesk::Methods - some service functions for a writing our extensions.

=head1 SYNOPSIS

use API::Plesk::Methods;

=head1 DESCRIPTION

Several support functions to generate xml, xml parsing and data control.

=head1 EXPORT

See METHODS block.

=cut

our @EXPORT = qw(
    generate_info_block
    generate_settings_block
    construct_request_xml
    create_filter
    create_node
    xml_extract_values
    abstract_parser
);


=head1 METHODS

=over 3

=item construct_request_xml($type, $operation, @addition_blocks) 

Construct xml query:
 <$type><$operation>@addition_blocks</$operation></$type>

 $type -- client-template, client
 $operation -- type of operation: ADD, GET, SET, DEL
 @addition_blocks -- other xml blocks

=cut 

# Create xml query
# STATIC (operation*, type*, addition_blocks)
# $type -- client-template, client
# $operation -- type of operation: ADD, GET, SET, DEL
# @addition_blocks -- other xml blocks
sub construct_request_xml {
    my ($type, $operation, @addition_blocks) = @_;

    return '' unless $operation && $type; 
    
    return create_node($type, create_node($operation, (join '', @addition_blocks) || undef ));
}


# Generate settings XML block (limits, permissons, preferences)
# STATIC (block_type, settings_hash)
# $block_type -- type of block without trailing 's', limit (not limits!), permission
# $settings_hash -- key => value pairs of setting
sub generate_settings_block {
    my ($block_type, %settings) = @_;

    return '' unless $block_type;
    return create_node("${block_type}s") if scalar keys %settings < 1;

    my $settings_block = "<${block_type}s>";
    for my $setting_name (sort keys %settings) {
        $settings_block .= create_node($block_type, 
                              create_node('name', $setting_name). 
                                  create_node('value', $settings{$setting_name})) ;   
    }
    return $settings_block ."</${block_type}s>";;
}


# Abstract func for creating user info blocks
# STATIC (user_info_block_type, user_info)
# $user_info_block_type -- block type without trailing 's', gen_info (not gen_infos!)
# %user_info -- key => value pairs of setting
sub generate_info_block {
    my ($user_info_block_type, %user_info) = @_;
        
    return '' unless $user_info_block_type;
    return create_node($user_info_block_type) if scalar keys %user_info < 1;

    my $block = "<${user_info_block_type}>";    
    $block .= create_node($_, $user_info{$_}) for keys %user_info;
    $block .= "</${user_info_block_type}>";

    return $block;
}


=item create_filter(%params)

Construct xml filter.

Params:
  login_field_name => 'value' -- filter by "..." value.

  all              => 1      - select all accounts.
  login_field_name => 'name' - select account with a given login_field_name.
  id               => 123    - select account with a given id 

=cut 

# Create filter
# STATIC (ident_hash);
# Params: unique login or unique id or 'all' for request all data
# Set filter by field: login_field_name => 'field_name'
sub create_filter {
    my %params = @_;
 
    my $login_field_name = $params{'login_field_name'}; 

    if ($params{'id'}) {

        return create_node('filter', 
            create_node('id', $params{'id'}));

    } elsif ($params{$login_field_name}) {

        return create_node( 'filter', 
            create_node($login_field_name, $params{$login_field_name}) );

    } elsif ($params{'all'}) {
        return create_node('filter'); # blank filter query -- SELECT * for Plesk
    } else {
        return '';
    }
}


# Only create XML node
# STATIC(node_name, node_value);
sub create_node {
    my ($node_name, $node_value) = @_;

    return defined $node_value ? "<$node_name>$node_value</$node_name>" :
        "<$node_name/>";
}

=item xml_extract_values($data)
	
Extracts from xml pair of key -- data, where the key is the node name and the value of its contents.

If success return hashref.

=cut

# Extracts name -> value pairs from xml
# STATIC
sub xml_extract_values {
    my $xml_data = shift;
    return '' unless $xml_data;

    my %result = $xml_data =~ m#<(.*?)>(.*?)</\1>#gsi;

    return \%result;
}

=item abstract_pasrser($operation_type, $xml_from_server, $required_data)

Provides parsing $xml_from_server previously extracting content block <$operation_type>.
Also performed to check if the keys, a list of which appears in arrref $required_data

=back

=cut 

# Abstract parser sub 
# STATIC
sub abstract_parser {
    my $operation_type  = shift; # del, add, set, get
    my $xml_from_server = shift;
    my $required_data   = shift; # arref

    return '' unless $operation_type    && 
                     $xml_from_server   && 
                     ref $required_data eq 'ARRAY';

    my $result;
    my @result_blocks;  
    my $xml_cut = ($xml_from_server 
                    =~ m#<$operation_type>(.*?)</$operation_type>#gis)[0];

    # if not found operation_type block, find system block
    if ($xml_cut) {
        while ($xml_cut =~ m#<result>(.*?)</result>#giso) {
            push @result_blocks, $1 if $1;
        }
    } else {
        $xml_cut = ($xml_from_server 
                    =~ m#<system>(.*?)</system>#gis)[0];
        if ($xml_cut) {
            push @result_blocks, $xml_cut;
        } else {
            return ''; # block <op_type> or <system> not found
        }
    }


    if (scalar @result_blocks > 1) {

        for (@result_blocks) {   
            my $key_value_pairs = xml_extract_values($_);
            return $result unless $key_value_pairs && 
                check_required_keys($key_value_pairs, $required_data);

            push @$result, $key_value_pairs; # return arrref of hashref
        } 

    } elsif (scalar @result_blocks == 1) {
        $result = xml_extract_values(shift @result_blocks); # return hashref
        return '' unless check_required_keys($result, $required_data);

    } else {
        # no blocks, error
    }
    return $result;
}


# Check required data fields
# STATIC(input_hash_ref, required_fields)
sub check_required_keys {
    my $processed_hash_ref = shift;
    my $required_keys      = shift; # arr ref
    return '' unless ref $required_keys      eq 'ARRAY' &&   
                     ref $processed_hash_ref eq 'HASH';

    for (@$required_keys) {
        return '' unless $processed_hash_ref->{$_};
    }  

    return 1;
}


# Light weight Exporter
sub import {
    no strict 'refs';
    my $called_from = caller;

    foreach my $package_sub (@EXPORT) {
        # importing our sub into caller`s namespace
        *{$called_from . '::' . $package_sub} = \&$package_sub;
    }
}


1;
__END__
=head1 SEE ALSO

Blank.

=head1 AUTHOR

Odintsov Pavel E<lt>nrg[at]cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by NRG

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut