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