File Coverage

blib/lib/ARS/Simple.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package ARS::Simple;

use 5.006;
use strict;
use warnings FATAL => 'all';
use ARS 1.68;
use Carp;
use Data::Dumper;

our $VERSION = '0.01';

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

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

BEGIN
{
    my $module = 'ARS/Simple.pm';
    my $cfg = $INC{$module};
    unless ($cfg)
    {
        die "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 : $@";
        }
    }
}

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

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

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

    return $self;
}

sub DESTROY
{
    my $self = shift;

    if ($self->{ctl})
    {
        ars_Logoff($self->{ctl});
    }
}

sub _check_initialised
{
    my $self = shift;

    unless ($self->{ctl})
    {
        $self->_carp("Connected to Remedy ARSystem has not been establised yet.\n");
        return;
    }

    return 1;
}

sub get_list
{
    my ($self, $args) = @_;  # Expect args keys of 'form', 'query', optionally 'max_returns'

    # Check ARSystem initailised
    return unless $self->_check_initialised();

    # Check required args
    unless ($args->{form} && $args->{query})
    {
        $self->_carp("get_list() requires 'form' and 'query' arguments\n");
        return;
    }


    # Create a qualifier struct
    my $qual = $self->_load_qualifier($args);
    return unless $qual;

    # Set the limit
    $self->set_max_entries($args->{max_returns});

    # Get the entryId
    my @entries = ars_GetListEntry($self->{ctl}, $args->{form}, $qual, 0, 0,
        [{columnWidth => 1, separator => ' ', fieldId => 1 }]  # Minimise the amount of data returned
        );

    # Reset the limit
    $self->_reset_max_entries();


    my @entryIds;
    # Speed hack for large retuns
    $#entryIds = $#entries;
    @entryIds = ();

    for (my $x = 0; $x < $#entries; $x += 2)
    {
        #Assign the entryId's to the array, stripping the query list values
        push @entryIds, $entries[$x];
    }
    my %results = ( numMatches => scalar(@entryIds), eids => \@entryIds );
    return \%results;
}

sub _load_qualifier
{

    my ($self, $args) = @_;

    my $qual = ars_LoadQualifier($self->{ctl}, $args->{form}, $args->{query});
    unless ($qual)
    {
        $self->_carp("_load_qualifier() Error processing query:\n$ars_errstr\n");
    }

    return $qual;
}

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

    my $form    = $args->{form};
    my $query   = $args->{query};
    my $lfid_hr = $args->{lfid};
    my @fid     = values %$lfid_hr;

    # Check ARSystem initailised
    return unless $self->_check_initialised();

    # Check required args
    unless ($args->{form} && $args->{query})
    {
        $self->_carp("get_data_by_label() requires 'form' and 'query' arguments\n");
        return;
    }

    #-- Create a qualifier struct
    my $qual = $self->_load_qualifier($args);
    return unless $qual;

    # Set the limit
    $self->set_max_entries($args->{max_returns});

    # Get the data from the form defined by qualifier qual
    my %entryList;
    if ($ARS::VERSION >= 1.8)
    {
        %entryList = ars_GetListEntryWithFields($self->{ctl}, $form, $qual, 0, 0, \@fid);
    }
    else
    {
        %entryList = ars_GetListEntryWithFields($self->{ctl}, $form, $qual, 0, \@fid);
    }

    # Reset the limit
    $self->_reset_max_entries();

    unless (%entryList)
    {
        no warnings qw(uninitialized);
        if ($ars_errstr)
        {
            $self->_carp("get_data_by_label() failed.\nError=$ars_errstr\nForm=$form\nQuery=$query\n");
        }
        else
        {
            if ($self->{log})
            {
                $self->{log}->msg(3, "get_data_by_label() no records found.\n");
            }
        }
        return;
    }

    # Map the FID's to Labels in the hashs
    my %fid2label = reverse %$lfid_hr;
    foreach my $eID (keys %entryList)
    {
        foreach my $fid (keys %{$entryList{$eID}})
        {
            if (defined $fid2label{$fid})
            {
                $entryList{$eID}{$fid2label{$fid}} = $entryList{$eID}{$fid};
                delete $entryList{$eID}{$fid};
            }
        }
    }

    return \%entryList;
}

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

    # Set the limit
    $self->set_max_entries($args->{max_returns});

    # Run the SQL through the ARSystem API
    my $m = ars_GetListSQL($self->{ctl}, $self->{sql});

    # Reset the limit
    $self->_reset_max_entries();

    #    $m = {
    #            "numMatches"   => integer,
    #            "rows"         => [ [r1col1, r1col2], [r2col1, r2col2] ... ],
    #         }
    if ($ars_errstr && $ars_errstr ne '')
    {
        $self->_carp('get_SQL() - ars_GetListSQL error, sql=', $self->{sql}, "\nars_errstr=$ars_errstr\n");
    }

    return $m;
}

sub set_max_entries
{
    my ($self, $max) = @_;

    if (defined $max)
    {
        # Just use the value given
    }
    elsif ($self->{max_returns})
    {
        $max = $self->{max_returns};
    }
    elsif (defined $self->{reset_limit})
    {
        $max = 0;  # Set for unlimited returns if we have a reset limit defined
    }

    if (defined $max)
    {
        unless(ars_SetServerInfo($self->{ctl}, &ARS::AR_SERVER_INFO_MAX_ENTRIES, $max))
        {
            $self->_carp("set_max_entries() - Could not set the AR_SERVER_INFO_MAX_ENTRIES to $max:\n$ars_errstr\n");
        }
    }
}

sub _reset_max_entries
{
    my $self = shift;

    if (defined $self->{reset_limit})
    {
        $self->set_max_entries($self->{reset_limit});
    }
}

sub get_fields
{
    my ($self, $form) = @_;

    # Check required args
    unless ($form)
    {
        $self->_carp("get_fields() requires the 'form' as a argument\n");
        return;
    }

    my %fids = ars_GetFieldTable($self->{ctl}, $form);
    $self->_carp("get_fields() error: $ars_errstr\n") unless (%fids);

    return \%fids;
}

sub update_record
{
    my ($self, $args) = @_;
    my $eID  = $args->{eid};
    my $form = $args->{form};
    my %lvp  = %{$args->{lvp}};


    # Map lvp to use FID rather than label
    foreach my $label (keys %lvp)
    {
        if (defined $args->{lvp}{$label})
        {
            $lvp{$args->{lfid}{$label}} = $lvp{$label};
            delete $lvp{$label};
        }
        else
        {
            carp("update_record - label '$label' not found in lfid hash");
        }
    }


    my $rv = ars_SetEntry($self->{ctl}, $form, $eID, 0, %lvp);

    # Check for errors
    unless (defined $rv && $rv == 1)
    {
        # Update failed
        my $msg = "update_record(eid=$eID, form=$form, ...) failed:\nars_errstr=$ars_errstr\nlvp data was:\n";
        foreach my $label (sort keys %{$args->{lvp}})
        {
            $msg .= sprintf("%30s (%10d) ---> %s\n", $label, $args->{lfid}{$label}, defined($lvp{$args->{lfid}{$label}}) ? $lvp{$args->{lfid}{$label}} : '');
        }
        carp($msg);
    }
    return $rv;
}

sub get_ctl
{
    my $self = shift;

    return $self->{ctl};
}

sub _carp
{
    my $self = shift;
    my $msg = join('', @_);

    carp $msg;
    $self->{log}->exp($msg) if ($self->{log});
}

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
        {
            croak "No user defined, quitting\n";
        }
    }

    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
        {
            croak "No password defined, quitting\n";
        }
    }
    $user  = $self->{persistant}{user};
    $pword = $self->{persistant}{password};

    # Handle the other passed arguments
    $self->{server}      = $args->{server}      if $args->{server};
    $self->{log}         = $args->{log}         if $args->{log};
    $self->{max_returns} = $args->{max_returns} if defined $args->{max_returns};
    $self->{reset_limit} = $args->{reset_limit} if defined $args->{reset_limit};

    if ($args->{ars_debug})
    {
        $ARS::DEBUGGING = 1;
    }
    $self->{debug} = $args->{debug} ? 1 : 0;

    ## Now connect to Remedy
    if ($self->{server} && $user && $pword)
    {
        my $ctl = ars_Login($self->{server}, $user, $pword);
        if ($ctl)
        {
            $self->{ctl} = $ctl;
        }
        else
        {
            croak(__PACKAGE__ . " object initialisation failed.\nFailed to log into Remedy server=" . $self->{server} . " as user '$user' with supplied password: $ars_errstr\n");
        }
    }
    else
    {
        croak(__PACKAGE__ . " object initialisation failed, server, user and password are required\n");
    }
}


    # GG test - need to find and store the current value of AR_SERVER_INFO_MAX_ENTRIES
    #           so we can set reset_limit if not defined
    #my %s = ars_GetServerInfo($self->{ctl});
    #print  Dumper(\%s);


1; # End of ARS::Simple


__END__