#################### main pod documentation begin ###################

=head1 NAME

  Zymonic::Client - Zymonic Webservice Client

=head1 SYNOPSIS

  my $zc = Zymonic::Client->new(URL => 'https://www.zymonic.com/zymonicmp/',
                                system => 'zymonic.test',   
                                credentials => {
                                  username => 'alex',
                                  password => 'password',
                                },
                               );
   
  my $r = $zc->sample_filter( 'filter', $filter_args );

Is a simple perl wrapper for connecting to remote Zymonic Systems
using Zymonic's native API.

=head1 DESCRIPTION

Is a simple perl wrapper for connecting to remote Zymonic Systems
using Zymonic's native API. Processes or filters from the remote
system can then be called by their ZName.

Whilst this is a module within the Zymonic namespace it does
not use any Zymonic modules, so it can be used in other projects
without the attribution license or having to install all of 
Zymonic.

=head1 USAGE

Load the object:

  my $zc = Zymonic::Client->new(
    URL         => 'https://www.zymonic.com/zymonicmp/',
    syste       => 'zymonic.test',   
    credentials => {
      username => 'alex',
      password => 'password',
    },
    options => {
      debug              => 'true',
      update_user_groups => 'true',
    },
    debug_callback => sub { print @_; }
  ;

Call the Process or Filter by its ZName:

  my $r = $zc->sample_filter( 'filter', $filter_args );

The filter args should be constructed for processing by XML::Simple.
Likewise the response will be the Zymonic XML response processed by
XML::Simple.

If credentials is not present, then API call will be made with Authentications.
Options should be a hasref of key/values which will be used in ZymonicHeader
for each API call.

debug_callback should be a function that will be called with debug info.
Arguments will be type (request/response/request_error) and an object. For
request/response object will be XML string, for request error it will
be the LWP Response object.

=head1 BUGS

None we're aware of...

=head1 SUPPORT

As in the license, Zymonic is provided without warranty or support
unless purchased separately, however... If you email 
zymonic-support@zednax.com your issue will   be noted and may 
receive a response.

For security issues, please contact zymonic-security@zednax.com and
someone will respond within 8 working hours.


=head1 AUTHOR

    Alex Masidlover et al.
    CPAN ID: MODAUTHOR
    Zednax Limited
    alex.masidlover@zednax.com
    http://www.zednax.com

=head1 COPYRIGHT

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

=head1 SEE ALSO

perl(1).

=cut

#################### main pod documentation end ###################

package Zymonic::Client;

use strict;
use warnings;

BEGIN
{
    use Exporter ();
    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION = '0.01';
    @ISA     = qw(Exporter);

    #Give a hoot don't pollute, do not export more than needed by default
    @EXPORT      = qw();
    @EXPORT_OK   = qw();
    %EXPORT_TAGS = ();
}

use Data::Dumper;
use LWP::UserAgent;
use XML::Simple;

our $AUTOLOAD;

#################### subroutine header begin ####################

=head2 new

 Usage     :  my $zc = Zymonic::Client
                         ->new(URL => 
                                 'https://www.zymonic.com/zymonicmp/',
                                system => 'zymonic.test',   
                                credentials => {
                                  username => 'alex',
                                  password => 'password',
                                },
                               );
 Purpose   : This is the constructor for the Zymonic Client.
 Returns   : a Zymonic::Client object
 Argument  : expects a URL, a system name,
 timeout(optional) and authentication credentials.
 Throws    : nothing
 Comment   : 

See Also   : Zymonic::Client::init

=cut

#################### subroutine header end ####################

sub new
{
    my $invocant = shift;
    my $class    = ref($invocant) || $invocant;
    my $self     = {@_};                          # Remaining args become attributes

    bless $self, $class;

    $self->init;

    return $self;

}

#################### subroutine header begin ####################

=head2 init

 Usage     :  $zc->init
 Purpose   : This is called by the constructor for the Zymonic 
 Client to perform initialisation tasks.
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : Zymonic::Client::new

=cut

#################### subroutine header end ####################

sub init
{
    my $self = shift;

    # Check that System and URL parameters have been included.
    die "No system parameter set" unless $self->{system};
    die "No URL set"              unless $self->{URL};

    $self->{ua} = LWP::UserAgent->new;
    $self->{ua}->timeout( $self->{timeout} || 10 );
    $self->{ua}->env_proxy;
}

#################### subroutine header begin ####################

=head2 autoloader

 Usage     : my $value = $object->property($new_value);
 Purpose   : Provides method style access to the 
 Returns   : A hashref containing the response from the webservice
 Argument  : A type (process or filter), 
 A hashref of data to pass to the webservice
 Throws    : none
 Comment   : 
       : Methods that are all caps and don't exist in $self's definition
       : are special perl methods, like DESTROY, and shouldn't be handled
       : by the autolader.

See Also   :

=cut

#################### subroutine header end ####################

sub AUTOLOAD
{
    my $self       = shift;
    my $type       = shift;
    my $parameters = shift;

    my ($service) = ( $AUTOLOAD =~ /::(\w+)$/ );

    # Don't handle special methods
    # Methods that are all caps and don't exist in $self's definition
    # are spcial perl methods, like DESTROY, and shouldn't be handled
    # by the autolader.
    return if ( $service =~ /^[A-Z]*$/ );

    die "Type must be set to filter or process" unless $type and $type =~ /process|filter/;

    # Build XML to send
    my $xml = XMLout(
        {
            (
                ref( $self->{credentials} ) eq 'HASH'
                ? ( Authentication =>
                      { map { $_ => { content => $self->{credentials}->{$_} } } keys %{ $self->{credentials} } } )
                : ()
            ),
            ZymonicHeader => $self->get_zymonic_header($type),
            $service      => $parameters,
        },
        KeyAttr  => [],
        RootName => 'ZymonicRequest',
        NoEscape => 1
    );

    my $result = $self->make_request($xml);
    if ( $result->{error} )
    {
        die $result->{error};
    }
    elsif ( $result->{response} )
    {
        return $result->{response};
    }
    elsif ( $result->{redirect} && $self->{allow_redirect} )
    {
        return $result->{redirect};
    }
    else
    {
        die "Invalid result: " . Dumper($result);
    }
}

#################### subroutine header begin ####################

=head2 check_for_errors

 Usage     :  $zc->check_for_errors($xml_response)
 Purpose   : This can be called by a user after making an API call. Pass
 in the result and user will be returned a hashref of any errors present.
 Returns   : undef is no errors, otherwise hashref containing following keys:
 auth_error, errors
 Argument  : API XML Simple respone object, also an option list of errors to
 ignore each error found wil regex match against each item in list and if it 
 matches 1 or more, the error will be ignored. Third argument can be a
 transition and fourth a process to check whether transition was successful.
 Throws    : nothing
 Comment   : 

See Also   :

=cut

#################### subroutine header end ####################

sub check_for_errors
{
    my $self             = shift;
    my $response         = shift;
    my $ignore_list      = shift || [];
    my $process_zname    = shift || '';
    my $transition_zname = shift || '';

    my $errors = {};

    # check for auth error, if found, stop the script as will always fail
    if ( ref( $response->{AuthFailed} ) && $response->{AuthFailed}->{content} eq 'true' )
    {
        $errors->{auth_error} = $response->{AuthFailedMessage}->{content};
    }

    # check for errors in response
    my @errors = ();
    if ( ref( $response->{error} ) )
    {
        push(
            @errors,
            map {
                    ( ref( $_->{code} ) ? "$_->{code}->{content}:::"   : '' )
                  . ( $_->{description} ? $_->{description}->{content} : $_->{message}->{content} )
            } ( ref( $response->{error} ) eq 'ARRAY' ? @{ $response->{error} } : $response->{error} )
        );

    }
    if ( ref( $response->{message} ) )
    {
        push( @errors,
            map { $_->{content} }
              ( ref( $response->{message} ) eq 'ARRAY' ? @{ $response->{message} } : $response->{message} ) );
    }
    if ( ref( $response->{session_errors} ) )
    {
        push(
            @errors,
            map { $_->{content} } (
                ref( $response->{session_errors} ) eq 'ARRAY'
                ? @{ $response->{session_errors} }
                : $response->{session_errors}
            )
        );
    }

    # strip any errors to ignore
    my @return_errors = ();
    if ( @{$ignore_list} )
    {
        foreach my $error (@errors)
        {
            unless ( grep { $error =~ /$_/ } @{$ignore_list} )
            {
                push( @return_errors, $error );
            }
        }
    }
    else { @return_errors = @errors; }

    $errors->{errors} = \@return_errors if @return_errors;

    if ( $process_zname && $transition_zname )
    {
        if ( ref( $response->{$process_zname} ) )
        {
            if ( ref( $response->{$process_zname}->{$transition_zname} ) )
            {
                unless ( $response->{$process_zname}->{$transition_zname}->{type} eq 'TransitionResult'
                    && $response->{$process_zname}->{$transition_zname}->{success} eq 'true' )
                {
                    push( @return_errors, $transition_zname . " failed." );
                }
            }
            else
            {
                push( @return_errors, $transition_zname . " not found." );
            }
        }
        else
        {
            push( @return_errors, $process_zname . " not found." );
        }
    }

    $errors->{errors} = \@return_errors if @return_errors;

    return ( keys %{$errors} == 0 ? undef : $errors );
}

#################### subroutine header begin ####################

=head2 login

 Usage     :  $zc->login
 Purpose   : Helper function which does an API call just to log the user in
 to the session.
 Argument  : nothing
 Result    : True/false value
 Throws    : nothing
 Comment   : 

See Also   :

=cut

#################### subroutine header end ####################

sub login
{
    my $self = shift;

    # return false value if no credentials
    unless ( ref( $self->{credentials} ) eq 'HASH' )
    {
        if ( $self->{debug_callback} )
        {
            &{ $self->{debug_callback} }( 'login_error', 'No credentials' );
        }
        return '';
    }

    # Build XML to send
    my $xml = XMLout(
        {
            Authentication =>
              { map { $_ => { content => $self->{credentials}->{$_} } } keys %{ $self->{credentials} } },
            ZymonicHeader => $self->get_zymonic_header('login'),
        },
        KeyAttr  => [],
        RootName => 'ZymonicRequest',
        NoEscape => 1
    );

    my $result = $self->make_request($xml);
    if ( $result->{error} )
    {
        if ( $self->{debug_callback} )
        {
            &{ $self->{debug_callback} }( 'request_error', $result->{error} );
        }
        return '';
    }
    else
    {
        my $errors = $self->check_for_errors( $result->{response} );
        if ($errors)
        {
            if ( $self->{debug_callback} )
            {
                &{ $self->{debug_callback} }( 'response_error', $errors );
            }
            return '';
        }
        else
        {

            # grab the crsf_token and set as option
            $self->{csrf_token} = $result->{response}->{csrf_token};
            return 'true';
        }
    }
}

#################### subroutine header begin ####################

=head2 ping

 Usage     :  $zc->ping
 Purpose   : Helper function which does an API call just to maintain the session.
 Argument  : nothing
 Result    : True/false value
 Throws    : nothing
 Comment   : 

See Also   :

=cut

#################### subroutine header end ####################

sub ping
{
    my $self = shift;

    # Build XML to send
    my $xml = XMLout(
        { ZymonicHeader => $self->get_zymonic_header('login'), },
        KeyAttr  => [],
        RootName => 'ZymonicRequest',
        NoEscape => 1
    );

    my $result = $self->make_request($xml);
    if ( $result->{error} )
    {
        return '';
    }
    else
    {
        my $errors = $self->check_for_errors( $result->{response} );
        if ($errors)
        {
            if ( $self->{debug_callback} )
            {
                &{ $self->{debug_callback} }( 'response_error', $errors );
            }
            return '';
        }
        else
        {
            return 'true';
        }
    }
}

#################### subroutine header begin ####################

=head2 logout

 Usage     :  $zc->logout
 Purpose   : Helper function which does an API call just to log the user out of
 the session.
 Argument  : nothing
 Result    : True/false value
 Throws    : nothing
 Comment   : 

See Also   :

=cut

#################### subroutine header end ####################

sub logout
{
    my $self = shift;

    # Build XML to send
    my $xml = XMLout(
        { ZymonicHeader => $self->get_zymonic_header('logout'), },
        KeyAttr  => [],
        RootName => 'ZymonicRequest',
        NoEscape => 1
    );

    my $result = $self->make_request($xml);
    if ( $result->{error} )
    {
        return '';
    }
    else
    {
        my $errors = $self->check_for_errors( $result->{response} );
        if ($errors)
        {
            if ( $self->{debug_callback} )
            {
                &{ $self->{debug_callback} }( 'response_error', $errors );
            }
            return '';
        }
        else
        {
            return 'true';
        }
    }
}

#################### subroutine header begin ####################

=head2 make_request

 Usage     :  $zc->make_request
 Purpose   : Functiont o do the call and return the response
 Argument  : XML to send
 Result    : hashref containing either response or errors
 Throws    : nothing
 Comment   : 

See Also   :

=cut

#################### subroutine header end ####################

sub make_request
{
    my $self = shift;
    my $xml  = shift;

    if ( $self->{debug_callback} )
    {
        my $debug_xml = $xml;
        $debug_xml =~ s/<Authentication>.*<\/Authentication>/<Authentication_Censored \/>/s;
        &{ $self->{debug_callback} }( 'request', $debug_xml );
    }

    # POST to the service
    my $response = $self->{ua}->post( $self->{URL}, { xmldata => $xml } );

    if ( $response->is_success )
    {

        # check for cookie
        my $cookie_line = $response->header('Set-Cookie') || '';
        if ( $cookie_line =~ /ZYMONIC$self->{system}=(\w+?);/ )
        {
            $self->{cookie} = $1;
            if ( $self->{debug_callback} )
            {
                &{ $self->{debug_callback} }( 'cookie', $self->{cookie} );
            }
        }

        if ( $self->{debug_callback} )
        {
            &{ $self->{debug_callback} }( 'response', $response->content );
        }

        # Convert XML and check for errors
        return { response => XMLin( $response->content, ForceContent => 1 ) };
    }
    elsif ( $response->is_redirect && $self->{allow_redirect} )
    {
        my $redirect = { url => $response->header('location') || '' };

        # split params
        if ( $redirect->{url} )
        {
            my ( $base_url, $param_string ) = split( /\?/, $redirect->{url}, 2 );
            $redirect->{base_url} = $base_url;
            $redirect->{params} =
              { map { my ( $key, $value ) = split( /=/, $_, 2 ); ( $key => $value ); } split( '&', $param_string ) };
        }

        if ( $self->{debug_callback} )
        {
            &{ $self->{debug_callback} }( 'redirect', $redirect );
        }
        return { redirect => $redirect };
    }
    else
    {
        if ( $self->{debug_callback} )
        {
            &{ $self->{debug_callback} }( 'request_error', $response );
        }
        return { error => $response->status_line, response => $response };
    }
}

#################### subroutine header begin ####################

=head2 parse_filter_results

 Usage     : $zc->parse_filter_results($filter_zname, $filter_xml)
 Purpose   : Parses all results into hashrefs for easy use.
 Argument  : filter zname and XML filter response
 Result    : list of results, result being a hashref containg id, key/value
 for field, and hashref of reports, keyed on report ident. If report ident is
 undef it means the report is not expanded, if expanded it will be an arrayref.
 Throws    : nothing
 Comment   : Assembles list recursively.

See Also   :

=cut

#################### subroutine header end ####################

sub parse_filter_results
{
    my $self         = shift;
    my $filter_zname = shift;
    my $xml          = shift;

    # base case
    if ($filter_zname)
    {

        # check format is correct
        if (   ref($xml) eq 'HASH'
            && ref( $xml->{$filter_zname} ) eq 'HASH'
            && ref( $xml->{$filter_zname}->{report} ) eq 'HASH' )
        {

            # start with the first report
            return $self->parse_filter_results( '', $xml->{$filter_zname}->{report} );
        }
    }
    else
    {

        # recursive calls, $xml is the report object, assemble results
        my @results = ();
        if ( ref( $xml->{result} ) )
        {
            foreach my $result ( @{ ( ref( $xml->{result} ) eq 'ARRAY' ? $xml->{result} : [ $xml->{result} ] ) } )
            {

                # build hashref of field value
                push(
                    @results,
                    {

                        # get id and ident
                        id    => $result->{ZZid},
                        ident => $result->{ident},

                        # add any nested reports
                        (
                            $result->{report}
                            ? (
                                report => {
                                    map {
                                        $_->{ident} => (
                                              ( $_->{expanded} && $_->{expanded} eq 'true' )
                                            ? [ $self->parse_filter_results( '', $_ ) ]
                                            : undef
                                          )
                                      } (
                                        ref( $result->{report} ) eq 'ARRAY'
                                        ? @{ $result->{report} }
                                        : ( $result->{report} )
                                      )
                                }
                              )
                            : ()
                        ),

                        # add all fields
                        map {
                            my $field = $_;
                            my @display_fields =
                              grep {
                                     ref($_) eq 'HASH'
                                  && ( $_->{type} || '' ) eq 'OptionDisplayField'
                                  && ref( $_->{Value} ) eq 'HASH'
                                  && defined $_->{Value}->{content}
                              } values %{ $result->{$field} };
                            (
                                "${field}_raw" => $result->{$field}->{Value}->{content},
                                $field         => (
                                    @display_fields
                                    ? join( ', ', map { $_->{Value}->{content} } @display_fields )
                                    : $result->{$field}->{Value}->{content}
                                )
                            );
                          }
                          grep { ref( $result->{$_} ) eq 'HASH' && $_ !~ /ZZid|report/ } keys %{$result},

                    }
                );
            }
        }

        return @results;
    }

    # reach here is no results, or format incorrect
    return ();
}

#################### subroutine header begin ####################

=head2 secure_unsecured

 Usage     :  $zc->secure_unsecured
 Purpose   : Helper function which does an API call just to secure_unsecured
 on the incoming tables
 Argument  : nothing
 Result    : hashref: { table_zname => { Record => [ { keyfield1 => value, ... }, ... ] } }
 Throws    : nothing
 Comment   : 

See Also   :

=cut

#################### subroutine header end ####################

sub secure_unsecured
{
    my $self = shift;
    my $tables = shift || [];

    my $return = {};
    return $return if @{$tables} == 0;

    # Build XML to send
    my $xml = XMLout(
        {
            (
                keys %{ $self->{credentials} }
                ? ( Authentication =>
                      { map { $_ => { content => $self->{credentials}->{$_} } } keys %{ $self->{credentials} } } )
                : ()
            ),
            ZymonicHeader =>
              $self->get_zymonic_header( 'secure_unsecured', { tables => { content => join( ',', @{$tables} ) } } ),

        },
        KeyAttr  => [],
        RootName => 'ZymonicRequest',
        NoEscape => 1
    );

    my $result = $self->make_request($xml);
    if ( $result->{error} )
    {
        if ( $self->{debug_callback} )
        {
            &{ $self->{debug_callback} }( 'request_error', $result->{error} );
        }
    }
    else
    {
        my $errors = $self->check_for_errors( $result->{response} );
        if ($errors)
        {
            if ( $self->{debug_callback} )
            {
                &{ $self->{debug_callback} }( 'response_error', $errors );
            }
        }
        else
        {

            # return the response
            $return = $result->{response};
        }
    }

    return $return;
}

#################### subroutine header begin ####################

=head2 get_zymonic_header

 Usage     :  $zc->get_zymonic_header($webservice_mode, $extras)
 Purpose   : Helper function which returns xml fragment ZymonicHeader
 for a zymonic XML request
 Argument  : webservice mode to use and hashre fo extras
 Result    : hashref which should then be keyed with ZymonicHeader
 Throws    : nothing
 Comment   : 

See Also   :

=cut

#################### subroutine header end ####################

sub get_zymonic_header
{
    my $self            = shift;
    my $webservice_mode = shift;
    my $extras          = shift || {};
    return {
        system         => { content => $self->{system} },
        webservicemode => { content => $webservice_mode },
        ( $self->{cookie}     ? ( cookie => { content => $self->{cookie} } )     : () ),
        ( $self->{csrf_token} ? ( token  => { content => $self->{csrf_token} } ) : () ),
        (
            ref( $self->{options} ) eq 'HASH'
            ? map { $_ => { content => $self->{options}->{$_} } }
              keys %{ $self->{options} }
            : ()
        ),
        %{$extras},
    };
}

1;