File Coverage

blib/lib/Snapforce/API.pm
Criterion Covered Total %
statement 12 14 85.7
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 17 19 89.4


line stmt bran cond sub pod time code
1             package Snapforce::API;
2              
3 1     1   12658 use 5.018002;
  1         2  
4 1     1   3 use strict;
  1         1  
  1         14  
5 1     1   7 use warnings;
  1         3  
  1         20  
6 1     1   2 use Carp;
  1         1  
  1         45  
7 1     1   172 use XML::Parser;
  0            
  0            
8             use HTTP::Request::Common qw/GET POST/;
9             use LWP::UserAgent;
10             use Data::Dumper;
11              
12             require Exporter;
13              
14             our $VERSION = '0.01';
15             our $SNAPURL = 'https://crm2.snapforce.com/sf_receive_request.inc.php';
16              
17             sub new {
18             my ($class, $authuser, $authkey) = @_;
19             croak "Authentication user and/or key are missing" unless $authkey;
20             my $self = bless {
21             authuser => $authuser,
22             authkey => $authkey
23             }, $class;
24             return $self;
25             }
26              
27             sub fetchRecords {
28             my $self = shift;
29             return runAPI($self, 'method' => "fetchRecords", @_);
30             }
31              
32             sub runAPI {
33             my ($self, %args) = @_;
34             carp "No method specified for explicit call of runAPI. Defaulting to fetchRecords" if not $args{'method'};
35             my %params = (
36             format => "xml",
37             module => "Accounts",
38             api_user => $self->{authuser},
39             api_key => $self->{authkey},
40             status => "Active",
41             method => "fetchRecords"
42             );
43             @params{keys %args} = values %args;
44             my $ua = new LWP::UserAgent;
45             my $resp = $ua->request(POST $SNAPURL, [%params]);
46             print Dumper($resp);
47             return $resp->content;
48             }
49              
50             sub parseXML {
51             my ($self, $info) = @_;
52             my %data = ();
53             my @tree = ();
54             my $spot = "";
55             my $word = "";
56              
57             my $sthdl = sub {
58             my ($prsr, $elem, %atts) = @_;
59             my $obj = \%data;
60             $obj = ${$obj}{$_} foreach (@tree);
61             $spot = $elem.(%atts ? "-".$atts{(keys %atts)[0]} : "");
62             push @tree, $spot;
63             ${$obj}{$spot} = {};
64             $word = "";
65             };
66             my $edhdl = sub {
67             my ($prsr, $elem) = @_;
68             pop @tree;
69             my $obj = \%data;
70             $obj = ${$obj}{$_} foreach @tree;
71             ${$obj}{$spot} = $word;
72             $spot = "";
73             };
74             my $chhdl = sub {
75             $word .= $_[1];
76             };
77              
78             my $parser = XML::Parser->new(Handlers => {
79             Start => \&$sthdl,
80             End => \&$edhdl,
81             Char => \&$chhdl
82             });
83            
84             $parser->parse($info);
85             delete $data{""};
86             delete $data{(keys %data)[0]}{''};
87             return %data;
88             }
89             1;
90             __END__