File Coverage

blib/lib/OCS/Client.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

## no critic (Modules::RequireExplicitPackage)

use utf8;
use strict;
use warnings;

package OCS::Client;
# ABSTRACT: A simple interface to OCS's SOAP API
$OCS::Client::VERSION = '0.010';
use Carp;
use URI;
use SOAP::Lite;
use XML::Entities;
use XML::Simple;


sub new {
    my ($class, $url, $user, $pass, @args) = @_;

    my $uri = URI->new($url);
    $uri->path("/Apache/Ocsinventory/Interface");

    my $proxy = URI->new($url);

    my $userinfo;
    $userinfo  = $user if $user;
    $userinfo .= ':'   if $user && $pass;
    $userinfo .= $pass if $pass;
    $proxy->userinfo($userinfo) if $userinfo;

    $proxy->path("/ocsinterface");

    my $self = { soap => SOAP::Lite->uri($uri->as_string)->proxy($proxy->as_string, @args) };

    return bless $self, $class;
}


sub get_computers_V1 {
    my ($self, @args) = @_;
    my %request = (
	engine     => 'FIRST',
	asking_for => 'INVENTORY',
	checksum   => 0x01FFFF,
	wanted     => 0x000003,
	offset     => 0,
	@args,
    );

    my $request = "\n";
    while (my ($tag, $value) = each %request) {
	$request .= "  <\U$tag\E>$value\n";
    }
    $request .= "\n";

    my $som = $self->{soap}->get_computers_V1($request);

    die "ERROR: ", XML::Entities::decode('all', $som->fault->{faultstring})
	if $som->fault;

    my @computers = $som->paramsall;

    # peel of the  tag of @computers
    shift @computers;
    pop   @computers;

    return map {XMLin($_, ForceArray => [qw/DRIVES NETWORKS PRINTERS SOFTWARES STORAGES VIDEOS/])} @computers;
}


sub computer_iterator {
    my ($self, %request) = @_;
    my @computers;
    my $offset = 0;
    return sub {
	unless (@computers) {
	    @computers = $self->get_computers_V1(%request, offset => $offset);
	    ++$offset;
	}
	return shift @computers;
    };
}

# This hash is used to map OCS custom field ids (in the form
# "fields_N") into their names.
our %fields = (
    3 => 'UA',
    4 => 'Sala',
    5 => 'Nome do Usuário',
    6 => 'Atividade',
    7 => 'Nome da Empresa',
    8 => 'Ponto de Rede',
    9 => 'Switch',
    10 => 'Porta',
    11 => 'Status',
    13 => 'Observações',
    14 => 'Local do Ponto',
    15 => 'Asset Number',
    16 => 'Responsável',
    17 => 'Tipo',
    18 => 'Padrão de HW',
    19 => 'Data de Aquisição',
    20 => 'UA Username',
    21 => 'Office',
    22 => 'Office Tag',
    23 => 'PA',
    26 => 'Diretoria',
    27 => 'Nota Fiscal',
);


sub prune {
    my ($computer) = @_;

    foreach (my ($key, $accountinfo) = each %{$computer->{ACCOUNTINFO}}) {
	my %myinfo;
	foreach my $info (grep {exists $_->{content}} @$accountinfo) {
	    if ($info->{Name} =~ /^fields_(\d+)$/) {
                if (exists $fields{$1}) {
                    $myinfo{$fields{$1}} = $info->{content};
                } else {
                    warn "Skipping unknown ACCOUNTINFO field id: $1";
                }
	    } else {
		$myinfo{$info->{Name}} = $info->{content};
	    }
	}

	delete $myinfo{'UA Username'};

	$computer->{ACCOUNTINFO}{$key} = \%myinfo;
    }

    if (exists $computer->{DRIVES}) {
	foreach my $drive (@{$computer->{DRIVES}}) {
	    $drive->{ORDER} = (ref $drive->{VOLUMN} ? '' : $drive->{VOLUMN}) . (ref $drive->{LETTER} ? '' : $drive->{LETTER});
	    $drive->{ORDER} =~ s@:/$@:@;
	    delete @{$drive}{qw/CREATEDATE FREE LETTER NUMFILES VOLUMN/};
	}
	$computer->{DRIVES} = [sort {$a->{ORDER} cmp $b->{ORDER}} grep {$_->{TYPE} !~ /removable/i} @{$computer->{DRIVES}}];
    }

    if (exists $computer->{HARDWARE}) {
	delete @{$computer->{HARDWARE}}{qw/FIDELITY LASTCOME IPADDR IPSRC LASTDATE PROCESSORS QUALITY USERID SWAP/};
	$computer->{HARDWARE}{DESCRIPTION} =~ s@^([^/]+)/\d\d-\d\d-\d\d \d\d:\d\d:\d\d$@$1@;
    }

    if (exists $computer->{NETWORKS}) {
	foreach my $net (@{$computer->{NETWORKS}}) {
	    delete @{$net}{qw/SPEED STATUS/};
	}
    }

    if (exists $computer->{PRINTERS}) {
	$computer->{PRINTERS} = [sort {$a->{NAME} cmp $b->{NAME}} @{$computer->{PRINTERS}}];
    }

    # Of the software we only keep the name and the version
    if (exists $computer->{SOFTWARES}) {
	$computer->{SOFTWARES} = {map {($_->{NAME} => $_->{VERSION})} @{$computer->{SOFTWARES}}};
    }

    if (exists $computer->{STORAGES}) {
	$computer->{STORAGES} = [grep {$_->{TYPE} !~ /removable/i} @{$computer->{STORAGES}}];
    }

    if (exists $computer->{VIDEOS}) {
	foreach my $video (@{$computer->{VIDEOS}}) {
	    delete @{$video}{qw/RESOLUTION/};
	}
    }

    return $computer;
}


use constant {                  ## no critic (ValuesAndExpressions::ProhibitConstantPragma)
    # CHECKSUM constants
    'HARDWARE'            => 0x00001,
    'BIOS'                => 0x00002,
    'MEMORY_SLOTS'        => 0x00004,
    'SYSTEM_SLOTS'        => 0x00008,
    'REGISTRY'            => 0x00010,
    'SYSTEM_CONTROLLERS'  => 0x00020,
    'MONITORS'            => 0x00040,
    'SYSTEM_PORTS'        => 0x00080,
    'STORAGE_PERIPHERALS' => 0x00100,
    'LOGICAL_DRIVES'      => 0x00200,
    'INPUT_DEVICES'       => 0x00400,
    'MODEMS'              => 0x00800,
    'NETWORK_ADAPTERS'    => 0x01000,
    'PRINTERS'            => 0x02000,
    'SOUND_ADAPTERS'      => 0x04000,
    'VIDEO_ADAPTERS'      => 0x08000,
    'SOFTWARE'            => 0x10000,

    # WANTED constants
    'ACOUNTINFO'          => 0x00001,
    'DICO_SOFT'           => 0x00002,
};

1; # End of OCS::Client

__END__