Sample Perl Code: Login and Logout

Below is a sample Perl code (compressed from CPAN's sample code in github) for performing Login and Logout through web services:

(Note: you have to change user_email, user_password, user_role, and account_id with the proper credentials and make sure all necessary Perl dependencies are installed before testing)

#!/usr/bin/perl -w
use Carp;
use SOAP::Lite;
use Data::Dumper;
use XML::Parser;
use XML::Parser::EasyTree;
$XML::Parser::EasyTree::Noempty=1;

my $ns = SuiteCloudNetSuite->new({
    EMAIL => 'user_email',
    PASSWORD => 'user_password',
    ROLE => 'user_role',
    ACCOUNT => 'account_id',
});

$ns->login or die "Can't connect to NetSuite!";
$ns->logout;

package SuiteCloudNetSuite;
sub new {
    my ($self, $hash_ref) = @_;
   
    my $soap = SOAP::Lite->new;
    #$soap->proxy('https://webservices.na1.netsuite.com/services/NetSuitePort_2012_2');
    $soap->proxy('https://webservices.na1.netsuite.com/services/NetSuitePort_2012_2');
   
    $hash_ref->{TIME} = time;
    $hash_ref->{SOAP} = $soap;
   
    bless $hash_ref, $self;   
}

sub login {
    my ($self) = shift;
   
    $self->{SOAP}->on_action(sub { return 'login'; } );
    my $som = $self->{SOAP}->login(
          SOAP::Data->name('passport' => \SOAP::Data->value(
              SOAP::Data->name('email' => $self->{EMAIL}),
              SOAP::Data->name('password' => $self->{PASSWORD}),
              SOAP::Data->name('account' => $self->{ACCOUNT}),
              SOAP::Data->name('role')->attr({ 'internalId' => $self->{ROLE} })
          ))
    );
   
    if ($som->fault) { $self->error; }
    else {
        if ($som->match("//loginResponse/sessionResponse/status")) {
          if ($som->dataof("//loginResponse/sessionResponse/status")->attr->{'isSuccess'} eq 'true') {

              $self->{COOKIE} = $self->{SOAP}->transport->http_response->header('Set-Cookie');
              my $response = $self->_parseResponse;
              if ($som->match('/Envelope/Header/sessionInfo/userId')) {
                $response->{userId} = $som->headerof('//sessionInfo/userId')->value;
              } else { $self->error; }
              if ($response->{statusIsSuccess} eq 'true') {
                $self->{LOGIN_RESULTS} = $response;
                return 1;
              }
              else { $self->error; }
          } else { $self->error; }
        } else { $self->error; }
    }
}

sub logout {
    my ($self) = shift;
   
    $self->{SOAP}->transport->http_request->header(Cookie => $self->{COOKIE});
    $self->{SOAP}->on_action(sub { return 'logout'; } );
    my $som = $self->{SOAP}->logout;
   
    if ($som->fault) { $self->error; }
    else {
        if ($som->match("//logoutResponse/sessionResponse/status")) {
          if ($som->dataof("//logoutResponse/sessionResponse/status")->attr->{'isSuccess'} eq 'true') {
              my $response = $self->_parseResponse;
              if ($response->{statusIsSuccess} eq 'true') {
                $self->{LOGOUT_RESULTS} = $response;
                return 1;
              }
              else { $self->error; }
          } else { $self->error; }
        } else { $self->error; }
    }
}

sub _parseResponse {
    my ($self) = shift;
    
    my ($method) = ((caller(1))[3] =~ /^.*::(.*)$/);
   
    $self->{LAST_REQ} = $self->{SOAP}->transport->http_request->content();
    $self->{LAST_RES} = $self->{SOAP}->transport->http_response->content();

    $self->_logTransport($self->{LOGGINGDIR}, $method) if $self->{LOGGINGDIR};

    my $p = new XML::Parser( Style=>'EasyTree' );
    my $tree = $p->parse($self->{LAST_RES});
   
    use vars qw($body $head);
    for my $header (@{ $tree->[0]->{content} }) {
        if    ($header->{name} =~ /^.*:Header$/) { $head = $header; }
        elsif ($header->{name} =~ /^.*:Body$/) {   $body = $header; }
    }

    $self->{TIME} = time;
    $self->{LAST_HEAD} = $head;
    $self->{LAST_BODY} = $body;

    if ($method eq 'error') {

        if (ref $body->{content}->[0]->{content}->[0]->{content}->[0]->{content} eq 'ARRAY') {
          return &_parseFamily($body->{content}->[0]->{content}->[0]->{content}->[0]->{content});
        }
        elsif ($body->{content}->[0]->{content}->[2]->{content}->[0]->{content}->[0]->{name} =~ m/ns1:code/) {
          return &_parseFamily($body->{content}->[0]->{content}->[2]->{content}->[0]->{content});
        }
        elsif ($body->{content}->[0]->{content}->[2]->{content}->[0]->{name} eq 'ns1:hostname') {
          return &_parseFamily($body->{content}->[0]->{content});
        }
        else {
          return 'Unable to parse error response!  Contact module author..';
        }
    }
    elsif (ref $body->{content}->[0]->{content}->[0]->{content} eq 'ARRAY') {
        return &_parseFamily($body->{content}->[0]->{content}->[0]->{content});
    }
    else { return; }

}

sub error {
    my ($self) = shift;
   
    my ($method) = ((caller(1))[3] =~ /^.*::(.*)$/);
  
    $self->{LAST_REQ} = $self->{SOAP}->transport->http_request->content();
    $self->{LAST_RES} = $self->{SOAP}->transport->http_response->content();
    
    $self->{ERROR_RESULTS} = $self->_parseResponse;
   
    if (defined $self->{DEBUG}) {
       
        use XML::Handler::YAWriter;
        undef my $errorMsg;
        my $ya = new XML::Handler::YAWriter(
        'AsString' => 1,
        'Pretty' => {
          'PrettyWhiteIndent'=> 1,
          'CompactAttrIndent'=> 1,
          'PrettyWhiteNewline'=> 1,
        } );
        my $parser = XML::Parser::PerlSAX->new('Handler' => $ya);
       
        $parser->parse($self->{LAST_REQ});
        $errorMsg .= '*'x32 . '  SOAP REQUEST  ' . '*'x32 . "\n";
        $errorMsg .= "@{ $ya->{Strings} }\n";
       
        $parser->parse($self->{LAST_RES});
        $errorMsg .= '*'x32 . ' SOAP RESPONSE  ' . '*'x32 . "\n";
        $errorMsg .= "@{ $ya->{Strings} }\n";
        return $errorMsg;
       
    }
  
    $self->_logTransport($self->{ERRORDIR}, $method) if $self->{ERRORDIR};
    return;
}

sub _parseFamily {
    my ($array_ref, $store_ref) = @_;
   
    undef my $parse_ref;
    for my $node (@{ $array_ref }) {
 
        $node->{name} =~ s/^(.*:)?(.*)$/$2/g;
        if (!defined $node->{content}->[0]) {
          $parse_ref = &_parseNode($node, $parse_ref);
        }
        else {
          if (scalar @{ $node->{content} } == 1) {
              if (ref $node->{content}->[0]->{content} eq 'ARRAY') {
                if (scalar @{ $node->{content}->[0]->{content} } > 1) {
                    #$parse_ref->{$node->{name}} = &_parseFamily($node->{content}->[0]->{content});
                    push @{ $parse_ref->{$node->{name}} }, &_parseFamily($node->{content});
                } else {
                   
                    if ($node->{name} =~ /List$/) {
              if (scalar @{ $node->{content}->[0]->{content} } > 1) {
                for (0..scalar @{ $node->{content} }-1) {
                    push @{ $parse_ref->{$node->{name}} }, &_parseFamily($node->{content}->[0]->{content});
                }
              }
              else {
                if (!ref $node->{content}->[0]->{content}->[0]->{content}) {
                    $parse_ref = &_parseNode($node->{content}->[0], $parse_ref);
                }
                else {
                    push @{ $parse_ref->{$node->{name}} }, &_parseNode($node->{content}->[0]->{content}->[0]);
                }
              }
                    }
                    else {
              $parse_ref = &_parseNode($node, $parse_ref);
                    }

                }
              } else { $parse_ref = &_parseNode($node, $parse_ref); }
          }
          else {

              if ($node->{name} =~ /(List|Matrix)$/) {
                if (scalar @{ $node->{content}->[0]->{content} } > 1) {
                    for (0..scalar @{ $node->{content} }-1) {
                        my $record = &_parseFamily($node->{content}->[$_]->{content});
                        $record = &_parseAttributes($node->{content}->[$_], $record);
                        push @{ $parse_ref->{$node->{name}} }, $record;
                    }
                }
                else {
                    for (0..scalar @{ $node->{content} }-1) {
                        if (!ref $node->{content}->[$_]->{content}->[0]->{content}) {
                            $parse_ref = &_parseNode($node->{content}->[$_], $parse_ref);
                        }
                        else {
                            #if ($node->{name} eq 'customFieldList') {
                            #    push @{ $parse_ref->{$node->{name}} }, &_parseNode($node->{content}->[$_]);
                            #}
                            if (!ref $node->{content}->[$_]->{content}->[0]->{content}->[0]->{content}) {
                                push @{ $parse_ref->{$node->{name}} }, &_parseNode($node->{content}->[$_]);
                            }
                            elsif (ref $node->{content}->[$_]->{content}->[0]->{content}->[0]->{content}) {
                                push @{ $parse_ref->{$node->{name}} }, &_parseNode($node->{content}->[$_]->{content}->[0]);
                            }
                            else {
                                push @{ $parse_ref->{$node->{name}} }, &_parseNode($node->{content}->[$_]);
                            }
                        }
                    }
                }
              }
              else {
                $parse_ref = &_parseFamily($node->{content}, $parse_ref);
              }
          }
        }
        $parse_ref = &_parseAttributes($node, $parse_ref);
    }

    if ($store_ref) {
        while (my ($key, $val) = each %{ $parse_ref }) {
          $store_ref->{$key} = $val;
        }
        return $store_ref;
    } else { return $parse_ref; }
   
}

sub _parseNode {
    my ($hash_ref, $store_ref) = @_;
   
    undef my $parse_ref;
    if (defined $hash_ref->{name}) {
        $hash_ref->{name} =~ s/^(.*:)?(.*)$/$2/g;
    }
   
    if (scalar @{ $hash_ref->{content} } == 1) {

        if (defined $hash_ref->{content}->[0]->{name}) {
          $hash_ref->{content}->[0]->{name} =~ /^(.*:)?(name|value)$/;
          if (defined $hash_ref->{content}->[0]->{attrib}->{internalId}) {
              $parse_ref->{$hash_ref->{name} . ucfirst($2)} = $hash_ref->{content}->[0]->{attrib}->{internalId};
          }
          else {
              $parse_ref->{$hash_ref->{name} . ucfirst($2)} = $hash_ref->{content}->[0]->{content}->[0]->{content};
          }
        }
        else {
          if (defined $hash_ref->{content}->[0]->{content}) {
              if (!ref $hash_ref->{content}->[0]->{content}) {
                $parse_ref->{$hash_ref->{name}} = $hash_ref->{content}->[0]->{content};
              }
          }
        }
    }
   
    $parse_ref = &_parseAttributes($hash_ref, $parse_ref);
   
    if (ref $store_ref eq 'HASH') {
        while (my ($key, $val) = each %{ $parse_ref }) {
          $store_ref->{$key} = $val;
        }
        return $store_ref;
    } else { return $parse_ref; }
   
}

sub _parseAttributes {
    my ($hash_ref, $store_ref) = @_;
   
    undef my $parse_ref;
    if (defined $hash_ref->{name}) {
        $hash_ref->{name} =~ s/^(.*:)?(.*)$/$2/g;
    }
   
    if (defined $hash_ref->{attrib}) {
        for my $attrib (keys %{ $hash_ref->{attrib} }) {
          next if $attrib =~ /^xmlns:/;
          if ($attrib =~ /^xsi:type$/) {
              $hash_ref->{attrib}->{$attrib} =~ s/^(.*:)?(.*)$/lcfirst($2)/eg;
              $parse_ref->{$hash_ref->{name} . 'Type'} = $hash_ref->{attrib}->{$attrib};
          } else { $parse_ref->{$hash_ref->{name} . ucfirst($attrib)} = $hash_ref->{attrib}->{$attrib}; }
        }
    }
   
    if ($store_ref) {
        while (my ($key, $val) = each %{ $parse_ref }) {
          $store_ref->{$key} = $val;
        }
        return $store_ref;
    } else { return $parse_ref; }
   
}