FS/FS/part_export/broadworks.pm

   1 package FS::part_export::broadworks;
   2
   3 use base qw( FS::part_export );
   4 use strict;
   5
   6 use Tie::IxHash;
   7 use FS::Record qw(dbh qsearch qsearchs);
   8 use Locale::SubCountry;
   9 use Carp qw(carp);
  10
  11 our $me = '[broadworks]';
  12 our %client; # exportnum => client object
  13 our %expire; # exportnum => timestamp on which to refresh the client
  14
  15 tie my %options, 'Tie::IxHash',
  16   'service_provider'=> { label => 'Service Provider ID' },
  17   'admin_user'      => { label => 'Administrative user ID' },
  18   'admin_pass'      => { label => 'Administrative password' },
  19   'domain'          => { label => 'Domain' },
  20   'user_limit'      => { label    => 'Maximum users per customer',
  21                          default  => 100 },
  22   'debug'           => { label => 'Enable debugging',
  23                          type  => 'checkbox',
  24                        },
  25 ;
  26
  27 # do we need roles for this?
  28 # no. cust_main -> group, svc_phone -> pilot/single user,
  29 # phone_device -> access device
  30 #
  31 # phase 2: svc_pbx -> trunk group, pbx_extension -> trunk user
  32
  33 our %info = (
  34   'svc'      => [qw( svc_phone svc_pbx )], # part_device?
  35   'desc'     =>
  36     'Provision phone and PBX services to a Broadworks Application Server',
  37   'options'  => \%options,
  38   'notes'    => <<'END'
  39 <P>Export to <b>BroadWorks Application Server</b>.</P>
  40 <P>In the simple case where one IP phone corresponds to one public phone
  41 number, this requires a svc_phone definition and a part_device. The "title"
  42 field ("external name") of the part_device must be one of the access device
  43 type names recognized by BroadWorks, such as "Polycom Soundpoint IP 550",
  44 "SNOM 320", or "Generic SIP Phone".</P>
  45 <P>Each phone service must have a device linked before it will be functional.
  46 Until then, authentication will be denied.</P>
  47 END
  48 );
  49
  50 sub _export_insert {
  51   my($self, $svc_x) = (shift, shift);
  52
  53   my $cust_main = $svc_x->cust_main;
  54   my ($groupId, $error) = $self->set_cust_main_Group($cust_main);
  55   return $error if $error;
  56
  57   if ( $svc_x->isa('FS::svc_phone') ) {
  58     my $userId;
  59     ($userId, $error) = $self->set_svc_phone_User($svc_x, $groupId);
  60
  61     $error ||= $self->set_sip_authentication($userId, $userId, $svc_x->sip_password);
  62
  63     return $error if $error;
  64
  65   } elsif ( $svc_x->isa('FS::svc_pbx') ) {
  66     # noop
  67   }
  68
  69   '';
  70 }
  71
  72 sub _export_replace {
  73   my($self, $svc_new, $svc_old) = @_;
  74
  75   my $cust_main = $svc_new->cust_main;
  76   my ($groupId, $error) = $self->set_cust_main_Group($cust_main);
  77   return $error if $error;
  78
  79   if ( $svc_new->isa('FS::svc_phone') ) {
  80     my $oldUserId = $self->userId($svc_old);
  81     my $newUserId = $self->userId($svc_new);
  82
  83     if ( $oldUserId ne $newUserId ) {
  84       my ($success, $message) = $self->request(
  85         User => 'UserModifyUserIdRequest',
  86         userId    => $oldUserId,
  87         newUserId => $newUserId
  88       );
  89       return $message if !$success;
  90
  91       if ( my $device = qsearchs('phone_device', { svcnum => $svc_new->svcnum }) ) {
  92         # there's a Line/Port configured for the device, and it also needs to be renamed.
  93         $error ||= $self->set_endpoint( $newUserId, $self->deviceName($device) );
  94       }
  95     }
  96
  97     if ( $svc_old->phonenum ne $svc_new->phonenum ) {
  98       $error ||= $self->release_number($svc_old->phonenum, $groupId);
  99     }
 100
 101     my $userId;
 102     ($userId, $error) = $self->set_svc_phone_User($svc_new, $groupId);
 103     $error ||= $self->set_sip_authentication($userId, $userId, $svc_new->sip_password);
 104
 105     if ($error and $oldUserId ne $newUserId) {
 106       # rename it back, then
 107       my ($success, $message) = $self->request(
 108         User => 'UserModifyUserIdRequest',
 109         userId    => $newUserId,
 110         newUserId => $oldUserId
 111       );
 112       # if it fails, we can't really fix it
 113       return "$error; unable to reverse user ID change: $message" if !$success;
 114     }
 115
 116     return $error if $error;
 117
 118   } elsif ( $svc_new->isa('FS::svc_pbx') ) {
 119     # noop
 120   }
 121
 122   '';
 123 }
 124
 125 sub _export_delete {
 126   my ($self, $svc_x) = @_;
 127
 128   my $cust_main = $svc_x->cust_main;
 129   my $groupId = $self->groupId($cust_main);
 130
 131   if ( $svc_x->isa('FS::svc_phone') ) {
 132     my $userId = $self->userId($svc_x);
 133     my $error = $self->delete_User($userId)
 134              || $self->release_number($svc_x->phonenum, $groupId);
 135     return $error if $error;
 136   } elsif ( $svc_x->isa('FS::svc_pbx') ) {
 137     # noop
 138   }
 139
 140   # find whether the customer still has any services on this platform
 141   # (other than the one being deleted)
 142   my %svcparts = map { $_->svcpart => 1 } $self->export_svc;
 143   my $svcparts = join(',', keys %svcparts);
 144   my $num_svcs = FS::cust_svc->count(
 145     '(select custnum from cust_pkg where cust_pkg.pkgnum = cust_svc.pkgnum) '.
 146     ' = ? '.
 147     ' AND svcnum != ?'.
 148     " AND svcpart IN ($svcparts)",
 149     $cust_main->custnum,
 150     $svc_x->svcnum
 151   );
 152
 153   if ( $num_svcs == 0 ) {
 154     warn "$me removed last service for group $groupId; deleting group.\n";
 155     my $error = $self->delete_Group($groupId);
 156     warn "$me error deleting group: $error\n" if $error;
 157     return "$error (removing customer group)" if $error;
 158   }
 159
 160   '';
 161 }
 162
 163 sub export_device_insert {
 164   my ($self, $svc_x, $device) = @_;
 165
 166   if ( $FS::svc_Common::noexport_hack ) {
 167     carp 'export_device_insert() suppressed by noexport_hack'
 168       if $self->option('debug');
 169     return;
 170   }
 171
 172   if ( $device->count('svcnum = ?', $svc_x->svcnum) > 1 ) {
 173     return "This service already has a device.";
 174   }
 175
 176   my $cust_main = $svc_x->cust_main;
 177   my $groupId = $self->groupId($cust_main);
 178
 179   my ($deviceName, $error) = $self->set_device_AccessDevice($device, $groupId);
 180   return $error if $error;
 181
 182   if ( $device->isa('FS::phone_device') ) {
 183     return $self->set_endpoint( $self->userId($svc_x), $deviceName);
 184   } # else pbx_device, extension_device
 185
 186   '';
 187 }
 188
 189 sub export_device_replace {
 190   my ($self, $svc_x, $new_device, $old_device) = @_;
 191
 192   if ( $FS::svc_Common::noexport_hack ) {
 193     carp 'export_device_replace() suppressed by noexport_hack'
 194       if $self->option('debug');
 195     return;
 196   }
 197
 198   my $cust_main = $svc_x->cust_main;
 199   my $groupId = $self->groupId($cust_main);
 200
 201   my $new_deviceName = $self->deviceName($new_device);
 202   my $old_deviceName = $self->deviceName($old_device);
 203
 204   if ($new_deviceName ne $old_deviceName) {
 205
 206     # do it in this order to switch the service endpoint over to the new
 207     # device.
 208     return $self->export_device_insert($svc_x, $new_device)
 209         || $self->delete_Device($old_deviceName, $groupId);
 210
 211   } else { # update in place
 212
 213     my ($deviceName, $error) = $self->set_device_AccessDevice($new_device, $groupId);
 214     return $error if $error;
 215
 216   }
 217 }
 218
 219 sub export_device_delete {
 220   my ($self, $svc_x, $device) = @_;
 221
 222   if ( $FS::svc_Common::noexport_hack ) {
 223     carp 'export_device_delete() suppressed by noexport_hack'
 224       if $self->option('debug');
 225     return;
 226   }
 227
 228   if ( $device->isa('FS::phone_device') ) {
 229     my $error = $self->set_endpoint( $self->userId($svc_x), '' );
 230     return $error if $error;
 231   } # else...
 232
 233   return $self->delete_Device($self->deviceName($device));
 234 }
 235
 236
 237 =head2 CREATE-OR-UPDATE METHODS
 238
 239 These take a Freeside object that can be exported to the Broadworks system,
 240 determine if it already has been exported, and if so, update it to match the
 241 Freeside object. If it's not already there, they create it. They return a list
 242 of two objects:
 243 - that object's identifying string or hashref or whatever in Broadworks, and
 244 - an error message, if creating the object failed.
 245
 246 =over 4
 247
 248 =item set_cust_main_Group CUST_MAIN
 249
 250 Takes a L<FS::cust_main>, creates a Group for the customer, and returns a
 251 GroupId. If the Group exists, it will be updated with the current customer
 252 and export settings.
 253
 254 =cut
 255
 256 sub set_cust_main_Group {
 257   my $self = shift;
 258   my $cust_main = shift;
 259   my $location = $cust_main->ship_location;
 260
 261   my $LSC = Locale::SubCountry->new($location->country)
 262     or return(0, "Invalid country code ".$location->country);
 263   my $state_name;
 264   if ( $LSC->has_sub_countries ) {
 265     $state_name = $LSC->full_name( $location->state );
 266   }
 267
 268   my $groupId = $self->groupId($cust_main);
 269   my %group_info = (
 270     $self->SPID,
 271     groupId           => $groupId,
 272     defaultDomain     => $self->option('domain'),
 273     userLimit         => $self->option('user_limit'),
 274     groupName         => $cust_main->name_short,
 275     callingLineIdName => $cust_main->name_short,
 276     contact => {
 277       contactName     => $cust_main->contact_firstlast,
 278       contactNumber   => (   $cust_main->daytime
 279                           || $cust_main->night
 280                           || $cust_main->mobile
 281                           || undef
 282                          ),
 283       contactEmail    => ( ($cust_main->all_emails)[0] || undef ),
 284     },
 285     address => {
 286       addressLine1    => $location->address1,
 287       addressLine2    => ($location->address2 || undef),
 288       city            => $location->city,
 289       stateOrProvince => $state_name,
 290       zipOrPostalCode => $location->zip,
 291       country         => $location->country,
 292     },
 293   );
 294
 295   my ($success, $message) = $self->request('Group' => 'GroupGetRequest14sp7',
 296     $self->SPID,
 297     groupId => $groupId
 298   );
 299
 300   if ($success) { # update it with the curent params
 301
 302     ($success, $message) =
 303       $self->request('Group' => 'GroupModifyRequest', %group_info);
 304
 305   } elsif ($message =~ /Group not found/) {
 306
 307     # create a new group
 308     ($success, $message) =
 309       $self->request('Group' => 'GroupAddRequest', %group_info);
 310
 311     if ($success) {
 312       # tell the group that its users in general are allowed to use
 313       # Authentication
 314       ($success, $message) = $self->request(
 315         'Group' => 'GroupServiceModifyAuthorizationListRequest',
 316         $self->SPID,
 317         groupId => $groupId,
 318         userServiceAuthorization => {
 319           serviceName => 'Authentication',
 320           authorizedQuantity => { unlimited => 'true' },
 321         },
 322       );
 323     }
 324
 325     if ($success) {
 326       # tell the group that each new user, specifically, is allowed to
 327       # use Authentication
 328       ($success, $message) = $self->request(
 329         'Group' => 'GroupNewUserTemplateAssignUserServiceListRequest',
 330         $self->SPID,
 331         groupId => $groupId,
 332         serviceName => 'Authentication',
 333       );
 334     }
 335
 336   } # else we somehow failed to fetch the group; throw an error
 337
 338   if ($success) {
 339     return ($groupId, '');
 340   } else {
 341     return ('', $message);
 342   }
 343 }
 344
 345 =item set_svc_phone_User SVC_PHONE, GROUPID
 346
 347 Creates a User object corresponding to this svc_phone, in the specified
 348 group. If the User already exists, updates the record with the current
 349 customer name (or phone name), phone number, and access device.
 350
 351 =cut
 352
 353 sub set_svc_phone_User {
 354   my ($self, $svc_phone, $groupId) = @_;
 355
 356   my $error;
 357
 358   # make sure the phone number is available
 359   $error = $self->assign_number( $svc_phone->phonenum, $groupId );
 360
 361   my $userId = $self->userId($svc_phone);
 362   my $cust_main = $svc_phone->cust_main;
 363
 364   my ($first, $last);
 365   if ($svc_phone->phone_name =~ /,/) {
 366     ($last, $first) = split(/,\s*/, $svc_phone->phone_name);
 367   } elsif ($svc_phone->phone_name =~ / /) {
 368     ($first, $last) = split(/ +/, $svc_phone->phone_name, 2);
 369   } else {
 370     $first = $cust_main->first;
 371     $last = $cust_main->last;
 372   }
 373
 374   my %new_user = (
 375     $self->SPID,
 376     groupId                 => $groupId,
 377     userId                  => $userId,
 378     lastName                => $last,
 379     firstName               => $first,
 380     callingLineIdLastName   => $last,
 381     callingLineIdFirstName  => $first,
 382     password                => $svc_phone->sip_password,
 383     # not supported: nameDialingName; Hiragana names
 384     phoneNumber             => $svc_phone->phonenum,
 385     callingLinePhoneNumber  => $svc_phone->phonenum,
 386   );
 387
 388   # does the user exist?
 389   my ($success, $message) = $self->request(
 390     'User' => 'UserGetRequest21',
 391     userId => $userId
 392   );
 393
 394   if ( $success ) { # modify in place
 395
 396     ($success, $message) = $self->request(
 397       'User' => 'UserModifyRequest17sp4',
 398       %new_user
 399     );
 400
 401   } elsif ( $message =~ /User not found/ ) { # create new
 402
 403     ($success, $message) = $self->request(
 404       'User' => 'UserAddRequest17sp4',
 405       %new_user
 406     );
 407
 408   }
 409
 410   if ($success) {
 411     return ($userId, '');
 412   } else {
 413     return ('', $message);
 414   }
 415 }
 416
 417 =item set_device_AccessDevice DEVICE, [ GROUPID ]
 418
 419 Creates/updates an Access Device Profile. This is a record for a
 420 I<specific physical device> that can send/receive calls. (Not to be confused
 421 with an "Access Device Endpoint", which is a I<port> on such a device.) DEVICE
 422 can be any record with a foreign key to L<FS::part_device>.
 423
 424 If GROUPID is specified, this device profile will be created at the Group
 425 level in that group; otherwise it will be a ServiceProvider level record.
 426
 427 =cut
 428
 429 sub set_device_AccessDevice {
 430   my $self = shift;
 431   my $device = shift;
 432   my $groupId = shift;
 433
 434   my $deviceName = $self->deviceName($device);
 435
 436   my $svc_x;
 437   if ($device->svcnum) {
 438     $svc_x = FS::cust_svc->by_key($device->svcnum)->svc_x;
 439   } else {
 440     $svc_x = FS::svc_phone->new({}); # returns empty for all fields
 441   }
 442
 443   my $part_device = $device->part_device
 444     or return ('', "devicepart ".$device->part_device." not defined" );
 445
 446   # required fields
 447   my %new_device = (
 448     $self->SPID,
 449     deviceName        => $deviceName,
 450     deviceType        => $part_device->title,
 451     description       => ($svc_x->title # svc_pbx
 452                           || $part_device->devicename), # others
 453   );
 454
 455   # optional fields
 456   $new_device{netAddress} = $svc_x->ip_addr if $svc_x->ip_addr; # svc_pbx only
 457   $new_device{macAddress} = $device->mac_addr if $device->mac_addr;
 458
 459   my %find_device = (
 460     $self->SPID,
 461     deviceName => $deviceName
 462   );
 463   my $level = 'ServiceProvider';
 464
 465   if ( $groupId ) {
 466     $level = 'Group';
 467     $find_device{groupId} = $new_device{groupId} = $groupId;
 468   } else {
 469     # shouldn't be used in our current design
 470     warn "$me creating access device $deviceName at Service Provider level\n";
 471   }
 472
 473   my ($success, $message) = $self->request(
 474     $level, $level.'AccessDeviceGetRequest18sp1',
 475     %find_device
 476   );
 477
 478   if ( $success ) { # modify in place
 479
 480     ($success, $message) = $self->request(
 481       $level => $level.'AccessDeviceModifyRequest14',
 482       %new_device
 483     );
 484
 485   } elsif ( $message =~ /Access Device not found/ ) { # create new
 486
 487     ($success, $message) = $self->request(
 488       $level => $level.'AccessDeviceAddRequest14',
 489       %new_device
 490     );
 491
 492   }
 493
 494   if ($success) {
 495     return ($deviceName, '');
 496   } else {
 497     return ('', $message);
 498   }
 499 }
 500
 501 =back
 502
 503 =head2 PROVISIONING METHODS
 504
 505 These return an error string on failure, and an empty string on success.
 506
 507 =over 4
 508
 509 =item assign_number NUMBER, GROUPID
 510
 511 Assigns a phone number to a group. If it's assigned to a different group or
 512 doesn't belong to the service provider, this will fail. If it's already
 513 assigned to I<this> group, it will do nothing and return success.
 514
 515 =cut
 516
 517 sub assign_number {
 518   my ($self, $number, $groupId) = @_;
 519   # see if it's already assigned
 520   my ($success, $message) = $self->request(
 521     Group => 'GroupDnGetAssignmentListRequest18',
 522     $self->SPID,
 523     groupId           => $groupId,
 524     searchCriteriaDn  => {
 525       mode  => 'Equal To',
 526       value => $number,
 527       isCaseInsensitive => 'false',
 528     },
 529   );
 530   return "$message (checking phone number status)" if !$success;
 531   my $result = $self->oci_table( $message->{dnTable} );
 532   return '' if @$result > 0;
 533
 534   ($success, $message) = $self->request(
 535     Group => 'GroupDnAssignListRequest',
 536     $self->SPID,
 537     groupId     => $groupId,
 538     phoneNumber => $number,
 539   );
 540
 541   $success ? '' : $message;
 542 }
 543
 544 =item release_number NUMBER, GROUPID
 545
 546 Unassigns a phone number from a group. If it's assigned to a user in the
 547 group then this will fail. If it's not assigned to the group at all, this
 548 does nothing.
 549
 550 =cut
 551
 552 sub release_number {
 553   my ($self, $number, $groupId) = @_;
 554   # see if it's already assigned
 555   my ($success, $message) = $self->request(
 556     Group => 'GroupDnGetAssignmentListRequest18',
 557     $self->SPID,
 558     groupId           => $groupId,
 559     searchCriteriaDn  => {
 560       mode  => 'Equal To',
 561       value => $number,
 562       isCaseInsensitive => 'false',
 563     },
 564   );
 565   return "$message (checking phone number status)" if !$success;
 566   my $result = $self->oci_table( $message->{dnTable} );
 567   return '' if @$result == 0;
 568
 569   ($success, $message) = $self->request(
 570     Group => 'GroupDnUnassignListRequest',
 571     $self->SPID,
 572     groupId     => $groupId,
 573     phoneNumber => $number,
 574   );
 575
 576   $success ? '' : $message;
 577 }
 578
 579 =item set_endpoint USERID [, DEVICENAME ]
 580
 581 Sets the endpoint for communicating with USERID to DEVICENAME. For now, this
 582 assumes that all devices are defined at Group level.
 583
 584 If DEVICENAME is null, the user will be set to have no endpoint.
 585
 586 =cut
 587
 588 # we only support linePort = userId, and no numbered ports
 589
 590 sub set_endpoint {
 591   my ($self, $userId, $deviceName) = @_;
 592
 593   my $endpoint;
 594   if ( length($deviceName) > 0 ) {
 595     $endpoint = {
 596       accessDeviceEndpoint => {
 597         linePort      => $userId,
 598         accessDevice  => {
 599           deviceLevel => 'Group',
 600           deviceName  => $deviceName,
 601         },
 602       }
 603     };
 604   } else {
 605     $endpoint = undef;
 606   }
 607   my ($success, $message) = $self->request(
 608     User => 'UserModifyRequest17sp4',
 609     userId    => $userId,
 610     endpoint  => $endpoint,
 611   );
 612
 613   $success ? '' : $message;
 614 }
 615
 616 =item set_sip_authentication USERID, NAME, PASSWORD
 617
 618 Sets the SIP authentication credentials for USERID to (NAME, PASSWORD).
 619
 620 =cut
 621
 622 sub set_sip_authentication {
 623   my ($self, $userId, $userName, $password) = @_;
 624
 625   my ($success, $message) = $self->request(
 626     'Services/ServiceAuthentication' => 'UserAuthenticationModifyRequest',
 627     userId      => $userId,
 628     userName    => $userName,
 629     newPassword => $password,
 630   );
 631
 632   $success ? '' : $message;
 633 }
 634
 635 =item delete_group GROUPID
 636
 637 Deletes the group GROUPID.
 638
 639 =cut
 640
 641 sub delete_Group {
 642   my ($self, $groupId) = @_;
 643
 644   my ($success, $message) = $self->request(
 645     Group => 'GroupDeleteRequest',
 646     $self->SPID,
 647     groupId => $groupId
 648   );
 649   if ( $success or $message =~ /Group not found/ ) {
 650     return '';
 651   } else {
 652     return $message;
 653   }
 654 }
 655
 656 =item delete_User USERID
 657
 658 Deletes the user USERID, and releases its phone number if it has one.
 659
 660 =cut
 661
 662 sub delete_User {
 663   my ($self, $userId) = @_;
 664
 665   my ($success, $message) = $self->request(
 666     User => 'UserDeleteRequest',
 667     userId => $userId
 668   );
 669   if ($success or $message =~ /User not found/) {
 670     return '';
 671   } else {
 672     return $message;
 673   }
 674 }
 675
 676 =item delete_Device DEVICENAME[, GROUPID ]
 677
 678 Deletes the access device DEVICENAME (from group GROUPID, or from the service
 679 provider if there is no GROUPID).
 680
 681 =cut
 682
 683 sub delete_Device {
 684   my ($self, $deviceName, $groupId) = @_;
 685
 686   my ($success, $message);
 687   if ( $groupId ) {
 688     ($success, $message) = $self->request(
 689       Group => 'GroupAccessDeviceDeleteRequest',
 690       $self->SPID,
 691       groupId => $groupId,
 692       deviceName => $deviceName,
 693     );
 694   } else {
 695     ($success, $message) = $self->request(
 696       ServiceProvider => 'ServiceProviderAccessDeviceDeleteRequest',
 697       $self->SPID,
 698       deviceName => $deviceName,
 699     );
 700   }
 701   if ( $success or $message =~ /Access Device not found/ ) {
 702     return '';
 703   } else {
 704     return $message;
 705   }
 706 }
 707
 708 =back
 709
 710 =head2 CONVENIENCE METHODS
 711
 712 =over 4
 713
 714 =item SPID
 715
 716 Returns 'serviceProviderId' => the service_provider option. This is commonly
 717 needed in request parameters.
 718
 719 =item groupId CUST_MAIN
 720
 721 Returns the groupID that goes with the specified customer.
 722
 723 =item userId SVC_X
 724
 725 Returns the userId (including domain) that should go with the specified
 726 service.
 727
 728 =item deviceName DEVICE
 729
 730 Returns the access device name that should go with the specified phone_device
 731 or pbx_device.
 732
 733 =cut
 734
 735 sub SPID {
 736   my $self = shift;
 737   my $id = $self->option('service_provider') or die 'service provider not set';
 738   'serviceProviderId' => $id
 739 }
 740
 741 sub groupId {
 742   my $self = shift;
 743   my $cust_main = shift;
 744   'cust_main#'.$cust_main->custnum;
 745 }
 746
 747 sub userId {
 748   my $self = shift;
 749   my $svc = shift;
 750   my $userId;
 751   if ($svc->phonenum) {
 752     $userId = $svc->phonenum;
 753   } else { # pbx_extension needs one of these
 754     die "can't determine userId for non-svc_phone service";
 755   }
 756   my $domain = $self->option('domain'); # domsvc?
 757   $userId .= '@' . $domain if $domain;
 758
 759   return $userId;
 760 }
 761
 762 sub deviceName {
 763   my $self = shift;
 764   my $device = shift;
 765   $device->mac_addr || ($device->table . '#' . $device->devicenum);
 766 }
 767
 768 =item oci_table HASHREF
 769
 770 Converts the base OCITable type into an arrayref of hashrefs.
 771
 772 =cut
 773
 774 sub oci_table {
 775   my $self = shift;
 776   my $oci_table = shift;
 777   my @colnames = $oci_table->{colHeading};
 778   my @data;
 779   foreach my $row (@{ $oci_table->{row} }) {
 780     my %hash;
 781     @hash{@colnames} = @{ $row->{col} };
 782     push @data, \%hash;
 783   }
 784
 785   \@data;
 786 }
 787
 788 #################
 789 # DID SELECTION #
 790 #################
 791
 792
 793
 794 ################
 795 # CALL DETAILS #
 796 ################
 797
 798 =item import_cdrs START, END
 799
 800 Retrieves CDRs for calls in the date range from START to END and inserts them
 801 as a new CDR batch. On success, returns a new cdr_batch object. On failure,
 802 returns an error message. If there are no new CDRs, returns nothing.
 803
 804 =cut
 805
 806 ##############
 807 # API ACCESS #
 808 ##############
 809
 810 =item request SCOPE, COMMAND, [ ARGUMENTS... ]
 811
 812 Wrapper for L<BroadWorks::OCI/request>. The client object will be cached.
 813 Returns two values: a flag, true or false, indicating success of the request,
 814 and the decoded response message as a hashref.
 815
 816 On failure of the request (or failure to authenticate), the response message
 817 will be a simple scalar containing the error message.
 818
 819 =cut
 820
 821 sub request {
 822   my $self = shift;
 823
 824   delete $client{$self->exportnum} if $expire{$self->exportnum} < time;
 825   my $client = $client{$self->exportnum};
 826   if (!$client) {
 827     local $@;
 828     eval "use BroadWorks::OCI";
 829     die "$me $@" if $@;
 830
 831     Log::Report::dispatcher('PERL', 'default',
 832       mode => ($self->option('debug') ? 'DEBUG' : 'NORMAL')
 833     );
 834
 835     $client = BroadWorks::OCI->new(
 836       userId    => $self->option('admin_user'),
 837       password  => $self->option('admin_pass'),
 838     );
 839     my ($success, $message) = $client->login;
 840     return ('', $message) if !$success;
 841
 842     $client{$self->exportnum} = $client; # if login succeeded
 843     $expire{$self->exportnum} = time + 120; # hardcoded, yeah
 844   }
 845   return $client->request(@_);
 846 }
 847
 848 1;