lib/BroadWorks/OCI.pm

   1 package BroadWorks::OCI;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings 'all';
   6
   7 use XML::Compile::Cache;
   8 use Log::Report 'broadworks-oci', syntax => 'SHORT';
   9 use IO::Socket::INET;
  10 use IO::Socket::Timeout;
  11 use Errno qw(ETIMEDOUT EWOULDBLOCK);
  12 use Digest::MD5;
  13 use Digest::SHA;
  14
  15 use Moose;
  16 use MooseX::ClassAttribute;
  17
  18 use File::ShareDir;
  19
  20 class_has '_XCC' => (
  21   is      => 'ro',
  22   lazy    => 1,
  23   default => sub { {} },
  24 );
  25
  26 sub XCC {
  27   my $self = shift;
  28   my $schema = shift;
  29   $self->_XCC->{$schema} ||= $self->_build_XCC($schema);
  30 }
  31
  32 sub _build_XCC {
  33   my $self = shift;
  34   my $schema = shift;
  35   my @path = split('/', $schema);
  36   $schema = pop @path;
  37   $schema = join('/', 'OCISchemaAS', @path) .
  38               '/OCISchema' . $schema . '.xsd';
  39   info "Loading $schema";
  40
  41   my $dist_dir = File::ShareDir::dist_dir('BroadWorks-OCI');
  42   my @schemata = (
  43     "OCISchemaBASE/OCISchemaBASE.xsd",
  44     "OCISchemaAS/OCISchemaDataTypes.xsd",
  45     "OCISchemaAS/OCISchemaSearchCriteria.xsd",
  46     "OCISchemaAS/OCISchemaSortCriteria.xsd",
  47     $schema,
  48   );
  49
  50   # results in some repeat inclusion of BASE and DataTypes, but not in
  51   # importing a huge pile of definitions we aren't going to use
  52   my $XCC = XML::Compile::Cache->new(
  53     \@schemata,
  54     schema_dirs => $dist_dir,
  55     xsi_type => {
  56       '{C}OCICommand' => 'AUTO',
  57     },
  58   );
  59   # we only ever send/receive one type of root element
  60   $XCC->declare(RW => '{C}BroadsoftDocument');
  61
  62   return $XCC;
  63 }
  64
  65 sub reader {
  66   my $self = shift;
  67   my $schema = shift;
  68   $self->XCC($schema)->reader('{C}BroadsoftDocument');
  69 }
  70
  71 sub writer {
  72   my $self = shift;
  73   my $schema = shift;
  74   $self->XCC($schema)->writer('{C}BroadsoftDocument');
  75 }
  76
  77 has 'sessionId' => (
  78   is      => 'ro',
  79   default => sub {
  80     Digest::MD5::md5_hex(time().{}.rand().$$);
  81   },
  82 );
  83
  84 has 'hostname' => (
  85   is      => 'ro',
  86   default => 'ews.xdp.broadsoft.com', # test server
  87 );
  88
  89 has 'port' => (
  90   is      => 'ro',
  91   default => 2208,
  92 );
  93
  94 has 'socket' => (
  95   is      => 'rw',
  96   lazy    => 1,
  97   builder => '_connect',
  98 );
  99
 100 has 'timeout' => (
 101   is      => 'rw',
 102   default => 30,
 103 );
 104
 105 sub _connect {
 106   my $self = shift;
 107   my $host = $self->hostname;
 108   my $port = $self->port;
 109   info("opening socket to $host:$port");
 110   my $socket = IO::Socket::INET->new(
 111     PeerAddr => $host,
 112     PeerPort => $port,
 113     Proto    => 'tcp',
 114     Timeout  => $self->timeout,
 115   ) or die "failed to connect: $!\n";
 116
 117   IO::Socket::Timeout->enable_timeouts_on($socket);
 118   $socket->read_timeout($self->timeout);
 119   $socket->write_timeout($self->timeout);
 120
 121   return $socket;
 122 }
 123
 124 has 'userId' => (
 125   is        => 'ro',
 126   required  => 1,
 127 );
 128
 129 has 'password' => (
 130   is        => 'ro',
 131   required  => 1,
 132 );
 133
 134 sub request {
 135   my $self = shift;
 136   my $schema = shift;
 137   my $command = shift;
 138
 139   my %args;
 140   if (ref($_[0])) {
 141     %args = %{ $_[0] };
 142   } else {
 143     %args = @_;
 144   }
 145   # XML::Compile's way to deal with the "xsi:type=" attribute for late-binding
 146   # element types:
 147   $args{'XSI_TYPE'} = $command;
 148
 149   my $doc = XML::LibXML::Document->new('1.0', 'UTF-8');
 150   info("sending $command");
 151   my $content = {
 152     'sessionId' => $self->sessionId,
 153     'protocol'  => 'OCI',
 154     'command'   => \%args,
 155   };
 156
 157   # format and send request
 158   local $@;
 159   eval {
 160     $doc->setDocumentElement( $self->writer($schema)->( $doc, $content ) );
 161     trace("$doc\n\n");
 162     $self->socket->print("$doc");
 163   };
 164   return (0, $@) if $@;
 165
 166   local $!;
 167   # responses from the API are _usually_ two lines, but sometimes only one.
 168   my $xml_response = $self->socket->getline;
 169   if ($xml_response and $xml_response !~ m[</BroadsoftDocument]) {
 170     $xml_response .= $self->socket->getline;
 171   }
 172   if (!$xml_response and ($! == ETIMEDOUT or $! == EWOULDBLOCK)) {
 173     return (0, 'OCI request timed out');
 174   }
 175
 176   # parse response
 177   trace("$xml_response\n\n");
 178   my $response = eval { $self->reader($schema)->( $xml_response ) };
 179   return (0, $@) if $@;
 180
 181   $command = $response->{command};
 182   $command = $command->[0] if ref($command) eq 'ARRAY';
 183
 184   my $response_type = $command->{XSI_TYPE};
 185   if ($response_type eq 'SuccessResponse') {
 186     return (1, '');
 187   } elsif ( $response_type eq '{C}ErrorResponse' ) {
 188     return (0, $command->{summary});
 189   } else { # all other response types
 190     info("received document type '$response_type'");
 191     return (1, $command);
 192   }
 193 }
 194
 195 sub login {
 196   my $self = shift;
 197   my ($success, $message) = $self->request( 'Login', 'AuthenticationRequest',
 198     userId => $self->userId,
 199   );
 200   return ($success, $message) unless $success;
 201
 202   # construct challenge response
 203   my $token = Digest::MD5::md5_hex(
 204     $message->{nonce} . ':' . Digest::SHA::sha1_hex($self->password)
 205   );
 206   return $self->request('Login', 'LoginRequest14sp4',
 207     userId => $self->userId,
 208     signedPassword => $token,
 209   );
 210 }
 211
 212 sub BUILD {
 213   my $self = shift;
 214   my ($success, $message) = $self->login;
 215   die "Login failed: $message" if !$success;
 216   $self;
 217 }
 218
 219 =head1 NAME
 220
 221 BroadWorks::OCI - Open Client Interface for BroadWorks Application Server.
 222
 223 =head1 VERSION
 224
 225 Version 0.01
 226
 227 =cut
 228
 229 our $VERSION = '0.01';
 230
 231 =head1 SYNOPSIS
 232
 233 Quick summary of what the module does.
 234
 235 Perhaps a little code snippet.
 236
 237     use BroadWorks::OCI;
 238
 239     my $foo = BroadWorks::OCI->new();
 240     ...
 241
 242 =head1 METHODS
 243
 244 =cut
 245
 246 =head1 AUTHOR
 247
 248 Mark Wells, C<< <mark at freeside.biz> >>
 249
 250
 251 =head1 SUPPORT
 252
 253 You can find documentation for this module with the perldoc command.
 254
 255     perldoc BroadWorks::OCI
 256
 257
 258 You can also look for information at:
 259
 260 =over 4
 261
 262 =item * RT: CPAN's request tracker (report bugs here)
 263
 264 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=BroadWorks-OCI>
 265
 266 =item * AnnoCPAN: Annotated CPAN documentation
 267
 268 L<http://annocpan.org/dist/BroadWorks-OCI>
 269
 270 =item * CPAN Ratings
 271
 272 L<http://cpanratings.perl.org/d/BroadWorks-OCI>
 273
 274 =item * Search CPAN
 275
 276 L<http://search.cpan.org/dist/BroadWorks-OCI/>
 277
 278 =back
 279
 280
 281 =head1 ACKNOWLEDGEMENTS
 282
 283
 284 =head1 LICENSE AND COPYRIGHT
 285
 286 Copyright 2015 Mark Wells.
 287
 288 This program is free software; you can redistribute it and/or modify it
 289 under the terms of the the Artistic License (2.0). You may obtain a
 290 copy of the full license at:
 291
 292 L<http://www.perlfoundation.org/artistic_license_2_0>
 293
 294 Any use, modification, and distribution of the Standard or Modified
 295 Versions is governed by this Artistic License. By using, modifying or
 296 distributing the Package, you accept this license. Do not use, modify,
 297 or distribute the Package, if you do not accept this license.
 298
 299 If your Modified Version has been derived from a Modified Version made
 300 by someone other than you, you are nevertheless required to ensure that
 301 your Modified Version complies with the requirements of this license.
 302
 303 This license does not grant you the right to use any trademark, service
 304 mark, tradename, or logo of the Copyright Holder.
 305
 306 This license includes the non-exclusive, worldwide, free-of-charge
 307 patent license to make, have made, use, offer to sell, sell, import and
 308 otherwise transfer the Package with respect to any patent claims
 309 licensable by the Copyright Holder that are necessarily infringed by the
 310 Package. If you institute patent litigation (including a cross-claim or
 311 counterclaim) against any party alleging that the Package constitutes
 312 direct or contributory patent infringement, then this Artistic License
 313 to you shall terminate on the date that such litigation is filed.
 314
 315 Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
 316 AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
 317 THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
 318 PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
 319 YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
 320 CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
 321 CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
 322 EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 323
 324
 325 =cut
 326
 327 1; # End of BroadWorks::OCI