File Coverage

blib/lib/ServiceNow/Simple.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package ServiceNow::Simple;
use strict;
use warnings FATAL => 'all';

our $VERSION = '0.09';

use Data::Dumper;
use FindBin;
use HTTP::Cookies;
use HTTP::Request::Common;
use LWP::UserAgent;
use SOAP::Lite;
use XML::Simple;
use Carp;

$Data::Dumper::Indent=1;
$Data::Dumper::Sortkeys=1;

our %config;
my $user;
my $pword;

BEGIN
{
    my $module = 'ServiceNow/Simple.pm';
    my $cfg = $INC{$module};
    unless ($cfg)
    {
        croak "Wrong case in use statement or $module module renamed. Perl is case sensitive!!!\n";
    }
    my $compiled = !(-e $cfg); # if the module was not read from disk => the script has been "compiled"
    $cfg =~ s/\.pm$/.cfg/;
    if ($compiled or -e $cfg)
    {
        # in a Perl2Exe or PerlApp created executable or PerlCtrl
        # generated COM object or the cfg is known to exist
        eval {require $cfg};
        if ($@ and $@ !~ /Can't locate /) #' <-- syntax higlighter
        {
            carp "Error in $cfg : $@\n";
        }
    }
}


sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = {};
    bless($self, $class);

    # Run initialisation code
    $self->_init(@_);

    return $self;
}


sub get
{
    my ($self, $args_h) = @_;

    my $method = $self->_get_method('get');
    my @params = $self->_load_args($args_h);
    my $result = $self->{soap}->call($method => @params);

    # Print faults to log file or stderr
    $self->_print_fault($result);

    if ($result && $result->body && $result->body->{'getResponse'})
    {
        return $result->body->{'getResponse'};
    }

    return;
}


sub get_keys
{
    my ($self, $args_h) = @_;

    my $method = $self->_get_method('getKeys');
    my @params = $self->_load_args($args_h);
    my $result = $self->{soap}->call($method => @params);

    # Print faults to log file or stderr
    $self->_print_fault($result);

    my $data_hr;
    if ($result && $result->body && $result->body->{'getKeysResponse'})
    {
        $data_hr = $result->body->{'getKeysResponse'};
    }

    if ($self->print_results())
    {
        print Data::Dumper->Dump([$data_hr], ['data_hr']) . "\n";
    }

    return $data_hr;
}


sub update
{
    # Note, one of the query_pairs must contain sys_id
    my ($self, $args_h) = @_;

    my $method = $self->_get_method('update');
    my @params = $self->_load_args($args_h);
    my $result = $self->{soap}->call($method => @params);

    # Print faults to log file or stderr
    $self->_print_fault($result);

    my $sys_id;
    if ($result && $result->body && $result->body->{updateResponse} && $result->body->{updateResponse}{sys_id})
    {
       $sys_id = $result->body->{updateResponse}{sys_id};
    }

    if ($self->print_results())
    {
        print Data::Dumper->Dump([$sys_id], ['sys_id']) . "\n";
    }

    return $sys_id;
}


sub get_records
{
    my ($self, $args_h) = @_;

    my $method = $self->_get_method('getRecords');

    # Check if we need to limit the columns returned.  Assume that IF there is a
    # __exclude_columns defined, it will over-ride this (and hence speed up the
    # process).  So __exclude_columns => undef is just a speed up, even though
    # there may be a LOT more data returned.
    my $the_columns;
    if ($args_h->{__columns} && ! exists($args_h->{__exclude_columns}))
    {
        $the_columns = $args_h->{__columns};
        delete $args_h->{__columns};

        if ($self->{instance_url} && $self->{__columns}{$self->{instance_url}}{$self->{table}}{$the_columns})
        {
            # We already have a list of fields to exclude for this form and __columns list
            $args_h->{__exclude_columns} = $self->{__columns}{$self->{instance_url}}{$self->{table}}{$the_columns};
        }
        elsif ($self->{instance} && $self->{__columns}{$self->{instance}}{$self->{table}}{$the_columns})
        {
            # We already have a list of fields to exclude for this form and __columns list
            $args_h->{__exclude_columns} = $self->{__columns}{$self->{instance}}{$self->{table}}{$the_columns};
        }
        else
        {
            # Do we have the list of fields for this form
            my @to_include = split /,/, $the_columns;
            my %all_fields;
            if ($self->{instance_url} && $self->{__columns}{__list}{$self->{instance_url}}{$self->{table}})
            {
                my $list = $self->{__columns}{__list}{$self->{instance_url}}{$self->{table}};
                %all_fields = map { $_ => 1 } split /,/, $list;
            }
            elsif ($self->{instance} && $self->{__columns}{__list}{$self->{instance}}{$self->{table}})
            {
                my $list = $self->{__columns}{__list}{$self->{instance}}{$self->{table}};
                %all_fields = map { $_ => 1 } split /,/, $list;
            }
            else
            {
                # Might as well query based on arguments passed, so remove what we don't want in query
                delete $args_h->{__exclude_columns};

                # Just get one record, to minimise data transfered
                my $original_limit = $args_h->{__limit};
                $args_h->{__limit} = 1;

                my @p = $self->_load_args($args_h);
                my $r = $self->{soap}->call($method => @p);

                # Add back in the limit if there was one, otherwise remove
                if ($original_limit)
                {
                    $args_h->{__limit} = $original_limit;
                }
                else
                {
                    delete $args_h->{__limit};
                }

                # GG handle no result!
                %all_fields = map { $_ => 1 } keys %{$r->body->{getRecordsResponse}{getRecordsResult}};

                # Store the full list in case we need it later
                if ($self->{instance_url})
                {
                    $self->{__columns}{__list}{$self->{instance_url}}{$self->{table}} = join(',', keys %all_fields);
                }
                else
                {
                    $self->{__columns}{__list}{$self->{instance}}{$self->{table}} = join(',', keys %all_fields);
                }
            }
            my @to_exclude;
            # Remove from the all fields hash those fields we want in the results
            # excluding the special meaning fields, those starting with '__'
            foreach my $ti (grep { $_ !~ /^__/} @to_include)
            {
                delete $all_fields{$ti};
            }

            # Add into the args we will pass
            $args_h->{__exclude_columns} = join(',', sort keys %all_fields);

            # Store for later use
            if ($self->{instance_url})
            {
                $self->{__columns}{$self->{instance_url}}{$self->{table}}{$the_columns} = $args_h->{__exclude_columns};
            }
            else
            {
                $self->{__columns}{$self->{instance}}{$self->{table}}{$the_columns} = $args_h->{__exclude_columns};
            }
        }
    }

    #__max_records   => 1000,
    #__chunks        => 200,
    #__callback      => 'write_csv',

    # If this is a __callback call we need to set __first_row, __last_row and iterate over the
    # possible result set.  Assume chunk size of 250 (default) unless __chunks is set.  Limit
    # the max number of records if __max_records is set.  Assume __first_row is 0 unless set.
    # Ignore __last_row and base on __chunks||250

    if ($args_h->{__callback})
    {
        # Store the callback function and remove it from the arguments hash
        my $callback = $args_h->{__callback};
        delete $args_h->{__callback};

        # Get the chunk size and clean up the arguments hash
        my $chunk_size = 250;
        if ($args_h->{__chunks})
        {
            $chunk_size = $args_h->{__chunks};
            delete $args_h->{__chunks};
        }

        my $max_records;
        if ($args_h->{__max_records})
        {
            $max_records = $args_h->{__max_records};
            delete $args_h->{__max_records};

            # max records takes precedence over chunk size
            if ($chunk_size > $max_records)
            {
                $chunk_size = $max_records;
            }
        }

        $args_h->{__first_row} = 0 unless $args_h->{__first_row};
        $args_h->{__last_row}  = $chunk_size;

        # Remove other things not relavent or useful :)
        delete $args_h->{__limits} if $args_h->{__limits};

        # If __columns, create an array of column names to pass
        my @columns;
        if ($the_columns)
        {
            @columns = split /,/, $the_columns;
        }

        # Make the first chunked call to ServiceNow
        my $total_records = 0;
        my @params = $self->_load_args($args_h);
        my $result = $self->{soap}->call($method => @params);

        # And now to the callback function
        my ($data_hr, $count) = $self->_getRecordsResponse($result);
        $total_records += $count;
        { $callback->($data_hr, 1, \@columns); }


        # Now chunk away...
        while ($count == $chunk_size && (!defined($max_records) || $total_records < $max_records))
        {
            # Sleep if we need to
            sleep($self->{__callback_sleep}) if $self->{__callback_sleep};

            # We need to get more
            $args_h->{__first_row} += $chunk_size;
            if (defined $max_records)
            {
                $args_h->{__last_row} = (($args_h->{__first_row} + $chunk_size) < $max_records) ? $args_h->{__first_row} + $chunk_size : $max_records;
            }
            else
            {
                $args_h->{__last_row} = $args_h->{__first_row} + $chunk_size;
            }

            @params = $self->_load_args($args_h);
            $result = $self->{soap}->call($method => @params);
            ($data_hr, $count) = $self->_getRecordsResponse($result);
            $total_records += $count;
            { $callback->($data_hr, 0, \@columns); }
        }
        return { count => $total_records, rows => undef };  # data handled by the callback function
    }
    else
    {
        my @params = $self->_load_args($args_h);
        my $result = $self->{soap}->call($method => @params);
        my ($data_hr, $count) = $self->_getRecordsResponse($result);

        return $data_hr;
    }
}


sub _getRecordsResponse
{
    my ($self, $result) = @_;

    my $count = 0;
    my $data_hr;
    if ($result && $result->body && $result->body->{getRecordsResponse} && $result->body->{getRecordsResponse}{getRecordsResult})
    {
        my $data = $result->body->{getRecordsResponse}{getRecordsResult};
        if (ref($data) eq 'HASH')
        {
            # There was only one record.  For consistant return, convert to array of hash
            $data_hr = { count => 1, rows => [ $data ] };
            $count = 1;
        }
        else
        {
            $count = scalar(@$data);
            $data_hr = { count => $count, rows => $data };
        }
    }

    # Print faults to log file or stderr
    $self->_print_fault($result);

    if ($self->print_results() && $data_hr)
    {
        print Data::Dumper->Dump([$data_hr], ['data_hr']) . "\n";
    }

    return ($data_hr, $count);
}


sub insert
{
    my ($self, $args_h) = @_;

    # Results:
    # --------
    # Regular tables:
    #   The sys_id field and the display value of the target table are returned.
    # Import set tables:
    #   The sys_id of the import set row, the name of the transformed target table (table),
    #   the display_name for the transformed target  table, the display_value of the
    #   transformed target row, and a status  field, which can contain inserted, updated,
    #   or error. There can be  an optional status_message field or an error_message field
    #   value when  status=error. When an insert did not cause a target row to be
    #   transformed, e.g. skipped because a key value is not specified, the sys_id field
    #   will contain the sys_id of the import set row rather than  the targeted transform table.
    # Import set tables with multiple transforms:
    #   The response from this type of insert will contain multiple sets of fields from the
    #   regular import set table insert wrapped in a multiInsertResponse parent element.
    #   Each set will contain a map field, showing which transform map created the response.

    my $method = $self->_get_method('insert');
    my @params = $self->_load_args($args_h);
    my $result = $self->{soap}->call($method => @params);

    # Print faults to log file or stderr
    $self->_print_fault($result);

    # insertResponse
    if ($result && $result->body && $result->body->{insertResponse})
    {
        return $result->body->{insertResponse};
    }

    return;
}



sub soap_debug
{
    SOAP::Lite->import(+trace => 'all');
}

sub print_results
{
    my ($self, $flag) = @_;

    if (defined $flag)
    {
        $self->{__print_results} = $flag;
    }
    return $self->{__print_results};
}


sub SOAP::Transport::HTTP::Client::get_basic_credentials
{
    return $user => $pword;
}


sub set_table
{
    my ($self, $table) = @_;

    $self->{table} = $table;
    $self->set_soap() if ($self->{instance} || $self->{instance_url});
    if(!$self->{wsdl} || ($self->{wsdl}{$self->{instance}} && !$self->{wsdl}{$self->{instance}}{$table}) || ($self->{wsdl}{$self->{instance_url}} && !$self->{wsdl}{$self->{instance_url}}{$table}))
    {
        $self->_load_wsdl($table);
    }
}


sub set_instance
{
    my ($self, $instance) = @_;

    if ($self->{instance_url})
    {
        carp "instance_url is defined and will take precedence over a defined 'instance'\n";
    }

    $self->{instance} = $instance;
    $self->set_soap() if ($self->{table});
}


sub set_instance_url
{
    my ($self, $instance_url) = @_;

    if ($self->{instance})
    {
        carp "instance is defined, instance_url will take precedence over a defined 'instance'\n";
    }

    $self->{instance_url} = $instance_url;
    $self->set_soap() if ($self->{table});
}


sub set_soap
{
    my $self = shift;

    my $url;
    if ($self->{instance_url})
    {
        if ($self->{instance_url} !~ m{/$})
        {
            $self->{instance_url} .= '/';
        }
        $url = $self->{instance_url} . $self->{table} . '.do?SOAP';
    }
    else
    {
        $url = 'https://' . $self->{instance} . '.service-now.com/' . $self->{table} . '.do?SOAP';
    }

    # Do we need to show the display value for a reference field rather than the sys_id, or both
    if ($self->{__display_value} && !$self->{__plus_display_value})
    {
        $url .=  '&displayvalue=true';
    }
    elsif ($self->{__plus_display_value})
    {
        $url .=  '&displayvalue=all';
    }

    my %args = ( cookie_jar => HTTP::Cookies->new(ignore_discard => 1) ) ;
    if ($self->{proxy})
    {
        $args{proxy} = [ https => $self->{proxy}, http => $self->{proxy} ];
    }

    $self->{soap} = SOAP::Lite->proxy($url, %args);
}


sub _get_method
{
    my ($self, $method) = @_;

    $self->{method}  = $method;
    $self->{__fault} = undef;  # Clear any previous faults
    return SOAP::Data->name($method)->attr({xmlns => 'http://www.service-now.com/'});
}


sub _load_args
{
    my ($self, $args_h) = @_;
    my (@args, $k, $v);

    my $fld_details;
    if ($self->{instance_url})
    {
        $fld_details = $self->{wsdl}{$self->{instance_url}}{$self->{table}}{$self->{method}};
    }
    else
    {
        $fld_details = $self->{wsdl}{$self->{instance}}{$self->{table}}{$self->{method}};
    }

    while (($k, $v) = each %$args_h)
    {
        if ($fld_details->{$k})
        {
            (my $type = $fld_details->{$k}{type}) =~ s/xsd://gms;
            push @args, SOAP::Data->name( $k => $v )->type($type);
        }
        else
        {
            push @args, SOAP::Data->name( $k => $v );
        }
    }

    # Add in the limits if not in the arguments and defined in object
    if (! $args_h->{__limit} && $self->{__limit})
    {
        push @args, SOAP::Data->name( __limit => $self->{__limit} );
    }

    return @args;
}


sub _print_fault
{
    my ($self, $result) = @_;

    if ($result->fault)
    {
        no warnings qw(uninitialized);
        if ($self->{__log})
        {
            $self->{__log}->exp('E930 - faultcode   =' . $result->fault->{faultcode}   . "\n",
                                       'faultstring =' . $result->fault->{faultstring} . "\n",
                                       'detail      =' . $result->fault->{detail}      . "\n");
        }
        else
        {
            carp 'faultcode   =' . $result->fault->{faultcode}   . "\n" .
                 'faultstring =' . $result->fault->{faultstring} . "\n" .
                 'detail      =' . $result->fault->{detail}      . "\n";
        }

        # Store the fault so it can be queried before the next ws call
        # Cleared in _get_method()
        $self->{__fault}{faultcode}   = $result->fault->{faultcode};
        $self->{__fault}{faultstring} = $result->fault->{faultstring};
        $self->{__fault}{detail}      = $result->fault->{detail};
    }
}


sub _load_wsdl
{
    my ($self, $table) = @_;

    my $ua = LWP::UserAgent->new();

    if ($self->{instance_url})
    {
        # Not sure if this is correct for instance_url case, since I have not been able to test it?
        # expect instance_url format to be https://instance_url/
        if ($self->{instance_url} =~ m{https?://([^/]+)/?$})
        {
            $ua->credentials($1 . ':443', 'Service-now', $user, $pword);
        }
        else
        {
            # Not in the format we expected...
            carp '_load_wsdl instance_url format expected as https://instance_url/ but was ' . $self->{instance_url} . ", skipping WDSL load.\n";
            return;
        }
    }
    else
    {
        $ua->credentials($self->{instance} . '.service-now.com:443', 'Service-now', $user, $pword);
    }

    # Note:  There is no advantage in including the displayvalue=1 or displayvalue=all in the WSDL request
    #        in the case of displayvalue=all, the dv_ fields can not be excluded for fields you do request
    #        (or more accurately, fields you don't exclude)
    my $response;
    if ($self->{instance_url})
    {
        $response = $ua->get($self->{instance_url} . $table . '.do?WSDL');
    }
    else
    {
        $response = $ua->get('https://' . $self->{instance} . '.service-now.com/' . $table . '.do?WSDL');
    }
    if ($response->is_success())
    {
        #my $wsdl = XMLin($response->content, ForceArray => 1);
        #$XML::Simple::PREFERRED_PARSER = '';
        my $wsdl = XMLin($response->content);

        foreach my $method (grep { $_ !~ /Response$/ } keys %{ $wsdl->{'wsdl:types'}{'xsd:schema'}{'xsd:element'} })
        {
            #print "Method=$method\n";
            my $e = $wsdl->{'wsdl:types'}{'xsd:schema'}{'xsd:element'}{$method}{'xsd:complexType'}{'xsd:sequence'}{'xsd:element'};
            foreach my $fld (keys %{ $e })
            {
                #print "\n\n", join("\n", keys %{ $wsdl->{'wsdl:types'}{'xsd:schema'}{'xsd:element'}{deleteMultiple}{'xsd:complexType'}{'xsd:sequence'}{'xsd:element'} }), "\n";
                #print "  $fld => $e->{$fld}{type}\n";
                if ($self->{instance_url})
                {
                    $self->{wsdl}{$self->{instance_url}}{$table}{$method}{$fld} = $e->{$fld};
                }
                else
                {
                    $self->{wsdl}{$self->{instance}}{$table}{$method}{$fld} = $e->{$fld};
                }
            }
        }
    }
}


sub set_display_value
{
    my ($self, $flag) = @_;

    $self->{__display_value} = $flag;
    $self->set_soap();
}


sub set_plus_display_value
{
    my ($self, $flag) = @_;

    $self->{__plus_display_value} = $flag;
    $self->set_soap();
    $self->_load_wsdl($self->{table});
}


sub _init
{
    my ($self, $args) = @_;

    # Did we have any of the persistant variables passed
    my $k = '5Jv@sI9^bl@D*j5H3@:7g4H[2]d%Ks314aNuGeX;';
    if ($args->{user})
    {
        $self->{persistant}{user} = $args->{user};
    }
    else
    {
        if (defined $config{user})
        {
            my $s = pack('H*', $config{user});
            my $x = substr($k, 0, length($s));
            my $u = $s ^ $x;
            $self->{persistant}{user} = $u;
        }
        else
        {
            carp "No user defined, quitting\n";
            exit(1);
        }
    }

    if ($args->{password})
    {
        $self->{persistant}{password} = $args->{password};
    }
    else
    {
        if (defined $config{password})
        {
            my $s = pack('H*', $config{password});
            my $x = substr($k, 0, length($s));
            my $u = $s ^ $x;
            $self->{persistant}{password} = $u;
        }
        else
        {
            carp "No password defined, quitting\n";
            exit(2);
        }
    }
    if ($args->{proxy})
    {
        $self->{persistant}{proxy} = $args->{proxy};
    }
    elsif (defined $config{proxy})
    {
        $self->{persistant}{proxy} = $config{proxy};
    }
    $user  = $self->{persistant}{user};
    $pword = $self->{persistant}{password};

    # Stop environment variable from playing around with SOAP::Lite
    if ($args->{__remove_env_proxy})
    {
        delete $ENV{HTTP_proxy}  if $ENV{HTTP_proxy};
        delete $ENV{HTTPS_proxy} if $ENV{HTTPS_proxy};
    }
    elsif ($self->{persistant}{proxy} && !$ENV{HTTPS_proxy})
    {
        $ENV{HTTPS_proxy} = $self->{persistant}{proxy};
    }


    # Handle the other passed arguments
    $self->{__display_value} = $args->{__display_value} ? 1 : 0;
    $self->{__plus_display_value} = $args->{__plus_display_value} ? 1 : 0;
    $self->set_instance($args->{instance})              if $args->{instance};
    $self->set_instance_url($args->{instance_url})      if $args->{instance_url};
    $self->set_table($args->{table})                    if $args->{table};     # Important this is after instance
    $self->{__limit}         = $args->{__limit}         if $args->{__limit};
    $self->{__log}           = $args->{__log}           if $args->{__log};
    $self->{__print_results} = $args->{__print_results} if $args->{__print_results};   # Print results to stdout
    $self->soap_debug()                                 if $args->{__soap_debug};
    if ($args->{table} && ($args->{instance} || $args->{instance_url}))
    {
        $self->set_soap();
    }
}

#####################################################################
# DO NOT REMOVE THE FOLLOWING LINE, IT IS NEEDED TO LOAD THIS LIBRARY
1;


__END__