e504ec5fa9ff668450b04cec70a875e12cb89eb7
[freeside.git] / FS / FS / API.pm
1 package FS::API;
2
3 use strict;
4 use Date::Parse;
5 use FS::Conf;
6 use FS::Record qw( qsearch qsearchs );
7 use FS::cust_main;
8 use FS::cust_location;
9 use FS::cust_pay;
10 use FS::cust_credit;
11 use FS::cust_refund;
12 use FS::cust_pkg;
13 use FS::cust_contact;
14
15 =head1 NAME
16
17 FS::API - Freeside backend API
18
19 =head1 SYNOPSIS
20
21   use Frontier::Client;
22   use Data::Dumper;
23
24   my $url = new URI 'http://localhost:8008/'; #or if accessing remotely, secure
25                                               # the traffic
26
27   my $xmlrpc = new Frontier::Client url=>$url;
28
29   my $result = $xmlrpc->call( 'FS.API.customer_info',
30                                 'secret'  => 'sharingiscaring',
31                                 'custnum' => 181318,
32                             );
33
34   print Dumper($result);
35
36 =head1 DESCRIPTION
37
38 This module implements a backend API for advanced back-office integration.
39
40 In contrast to the self-service API, which authenticates an end-user and offers
41 functionality to that end user, the backend API performs a simple shared-secret
42 authentication and offers full, administrator functionality, enabling
43 integration with other back-office systems.  Only access this API from a secure 
44 network from other backoffice machines. DON'T use this API to create customer 
45 portal functionality.
46
47 If accessing this API remotely with XML-RPC or JSON-RPC, be careful to block
48 the port by default, only allow access from back-office servers with the same
49 security precations as the Freeside server, and encrypt the communication
50 channel (for example, with an SSH tunnel or VPN) rather than accessing it
51 in plaintext.
52
53 =head1 METHODS
54
55 =over 4
56
57 =item insert_payment OPTION => VALUE, ...
58
59 Adds a new payment to a customers account. Takes a list of keys and values as
60 paramters with the following keys:
61
62 =over 4
63
64 =item secret
65
66 API Secret
67
68 =item custnum
69
70 Customer number
71
72 =item payby
73
74 Payment type
75
76 =item paid
77
78 Amount paid
79
80 =item _date
81
82 Option date for payment
83
84 =item order_number
85
86 Optional order number
87
88 =back
89
90 Example:
91
92   my $result = FS::API->insert_payment(
93     'secret'  => 'sharingiscaring',
94     'custnum' => 181318,
95     'payby'   => 'CASH',
96     'paid'    => '54.32',
97
98     #optional
99     '_date'   => 1397977200, #UNIX timestamp
100     'order_number' => '12345',
101   );
102
103   if ( $result->{'error'} ) {
104     die $result->{'error'};
105   } else {
106     #payment was inserted
107     print "paynum ". $result->{'paynum'};
108   }
109
110 =cut
111
112 #enter cash payment
113 sub insert_payment {
114   my($class, %opt) = @_;
115   return _shared_secret_error() unless _check_shared_secret($opt{secret});
116
117   #less "raw" than this?  we are the backoffice API, and aren't worried
118   # about version migration ala cust_main/cust_location here
119   my $cust_pay = new FS::cust_pay { %opt };
120   my $error = $cust_pay->insert( 'manual'=>1 );
121   return { 'error'  => $error,
122            'paynum' => $cust_pay->paynum,
123          };
124 }
125
126 # pass the phone number ( from svc_phone ) 
127 sub insert_payment_phonenum {
128   my($class, %opt) = @_;
129   $class->_by_phonenum('insert_payment', %opt);
130 }
131
132 sub _by_phonenum {
133   my($class, $method, %opt) = @_;
134   return _shared_secret_error() unless _check_shared_secret($opt{secret});
135
136   my $phonenum = delete $opt{'phonenum'};
137
138   my $svc_phone = qsearchs('svc_phone', { 'phonenum' => $phonenum } )
139     or return { 'error' => 'Unknown phonenum' };
140
141   my $cust_pkg = $svc_phone->cust_svc->cust_pkg
142     or return { 'error' => 'Unlinked phonenum' };
143
144   $opt{'custnum'} = $cust_pkg->custnum;
145
146   $class->$method(%opt);
147 }
148
149 =item insert_credit OPTION => VALUE, ...
150
151 Adds a a credit to a customers account.  Takes a list of keys and values as
152 parameters with the following keys
153
154 =over 
155
156 =item secret
157
158 API Secret
159
160 =item custnum
161
162 customer number
163
164 =item amount
165
166 Amount of the credit
167
168 =item _date
169
170 The date the credit will be posted
171
172 =back
173
174 Example:
175
176   my $result = FS::API->insert_credit(
177     'secret'  => 'sharingiscaring',
178     'custnum' => 181318,
179     'amount'  => '54.32',
180
181     #optional
182     '_date'   => 1397977200, #UNIX timestamp
183   );
184
185   if ( $result->{'error'} ) {
186     die $result->{'error'};
187   } else {
188     #credit was inserted
189     print "crednum ". $result->{'crednum'};
190   }
191
192 =cut
193
194 #Enter credit
195 sub insert_credit {
196   my($class, %opt) = @_;
197   return _shared_secret_error() unless _check_shared_secret($opt{secret});
198
199   $opt{'reasonnum'} ||= FS::Conf->new->config('api_credit_reason');
200
201   #less "raw" than this?  we are the backoffice API, and aren't worried
202   # about version migration ala cust_main/cust_location here
203   my $cust_credit = new FS::cust_credit { %opt };
204   my $error = $cust_credit->insert;
205   return { 'error'  => $error,
206            'crednum' => $cust_credit->crednum,
207          };
208 }
209
210 # pass the phone number ( from svc_phone ) 
211 sub insert_credit_phonenum {
212   my($class, %opt) = @_;
213   $class->_by_phonenum('insert_credit', %opt);
214 }
215
216 =item apply_payments_and_credits
217
218 Applies payments and credits for this customer.  Takes a list of keys and
219 values as parameter with the following keys:
220
221 =over 4
222
223 =item secret
224
225 API secret
226
227 =item custnum
228
229 Customer number
230
231 =back
232
233 =cut
234
235 #apply payments and credits
236 sub apply_payments_and_credits {
237   my($class, %opt) = @_;
238   return _shared_secret_error() unless _check_shared_secret($opt{secret});
239
240   my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} })
241     or return { 'error' => 'Unknown custnum' };
242
243   my $error = $cust_main->apply_payments_and_credits( 'manual'=>1 );
244   return { 'error'  => $error, };
245 }
246
247 =item insert_refund OPTION => VALUE, ...
248
249 Adds a a credit to a customers account.  Takes a list of keys and values as
250 parmeters with the following keys: custnum, payby, refund
251
252 Example:
253
254   my $result = FS::API->insert_refund(
255     'secret'  => 'sharingiscaring',
256     'custnum' => 181318,
257     'payby'   => 'CASH',
258     'refund'  => '54.32',
259
260     #optional
261     '_date'   => 1397977200, #UNIX timestamp
262   );
263
264   if ( $result->{'error'} ) {
265     die $result->{'error'};
266   } else {
267     #refund was inserted
268     print "refundnum ". $result->{'crednum'};
269   }
270
271 =cut
272
273 #Enter cash refund.
274 sub insert_refund {
275   my($class, %opt) = @_;
276   return _shared_secret_error() unless _check_shared_secret($opt{secret});
277
278   # when github pull request #24 is merged,
279   #  will have to change over to default reasonnum like credit
280   # but until then, this will do
281   $opt{'reason'} ||= 'API refund';
282
283   #less "raw" than this?  we are the backoffice API, and aren't worried
284   # about version migration ala cust_main/cust_location here
285   my $cust_refund = new FS::cust_refund { %opt };
286   my $error = $cust_refund->insert;
287   return { 'error'     => $error,
288            'refundnum' => $cust_refund->refundnum,
289          };
290 }
291
292 # pass the phone number ( from svc_phone ) 
293 sub insert_refund_phonenum {
294   my($class, %opt) = @_;
295   $class->_by_phonenum('insert_refund', %opt);
296 }
297
298 #---
299
300 # "2 way syncing" ?  start with non-sync pulling info here, then if necessary
301 # figure out how to trigger something when those things change
302
303 # long-term: package changes?
304
305 =item new_customer OPTION => VALUE, ...
306
307 Creates a new customer. Takes a list of keys and values as parameters with the
308 following keys:
309
310 =over 4
311
312 =item secret
313
314 API Secret
315
316 =item first
317
318 first name (required)
319
320 =item last
321
322 last name (required)
323
324 =item ss
325
326 (not typically collected; mostly used for ACH transactions)
327
328 =item company
329
330 Company name
331
332 =item address1 (required)
333
334 Address line one
335
336 =item city (required)
337
338 City
339
340 =item county
341
342 County
343
344 =item state (required)
345
346 State
347
348 =item zip (required)
349
350 Zip or postal code
351
352 =item country
353
354 2 Digit Country Code
355
356 =item latitude
357
358 latitude
359
360 =item Longitude
361
362 longitude
363
364 =item geocode
365
366 Currently used for third party tax vendor lookups
367
368 =item censustract
369
370 Used for determining FCC 477 reporting
371
372 =item censusyear
373
374 Used for determining FCC 477 reporting
375
376 =item ship_address1
377
378 =item ship_address2
379
380 =item ship_city
381
382 =item ship_county
383
384 =item ship_state
385
386 =item ship_zip
387
388 =item ship_country
389
390 Optional shipping address fields.  If sending an optional shipping address,
391 ship_address1, ship_city, ship_state and ship_zip are required.
392
393 =item daytime
394
395 Daytime phone number
396
397 =item night
398
399 Evening phone number
400
401 =item fax
402
403 Fax number
404
405 =item mobile
406
407 Mobile number
408
409 =item invoicing_list
410
411 comma-separated list of email addresses for email invoices. The special value 'POST' is used to designate postal invoicing (it may be specified alone or in addition to email addresses),
412 postal_invoicing
413 Set to 1 to enable postal invoicing
414
415 =item referral_custnum
416
417 Referring customer number
418
419 =item salesnum
420
421 Sales person number
422
423 =item agentnum
424
425 Agent number
426
427 =item agent_custid
428
429 Agent specific customer number
430
431 =item referral_custnum
432
433 Referring customer number
434
435 =back
436
437 =cut
438
439 #certainly false laziness w/ClientAPI::Signup new_customer/new_customer_minimal
440 # but approaching this from a clean start / back-office perspective
441 #  i.e. no package/service, no immediate credit card run, etc.
442
443 sub new_customer {
444   my( $class, %opt ) = @_;
445   return _shared_secret_error() unless _check_shared_secret($opt{secret});
446
447   #default agentnum like signup_server-default_agentnum?
448   #$opt{agentnum} ||= $conf->config('signup_server-default_agentnum');
449  
450   #same for refnum like signup_server-default_refnum
451   $opt{refnum} ||= FS::Conf->new->config('signup_server-default_refnum');
452
453   FS::cust_main->API_insert( %opt );
454 }
455
456 =item update_customer
457
458 Updates an existing customer. Passing an empty value clears that field, while
459 NOT passing that key/value at all leaves it alone. Takes a list of keys and
460 values as parameters with the following keys:
461
462 =over 4
463
464 =item secret
465
466 API Secret (required)
467
468 =item custnum
469
470 Customer number (required)
471
472 =item first
473
474 first name 
475
476 =item last
477
478 last name 
479
480 =item company
481
482 Company name
483
484 =item address1 
485
486 Address line one
487
488 =item city 
489
490 City
491
492 =item county
493
494 County
495
496 =item state 
497
498 State
499
500 =item zip 
501
502 Zip or postal code
503
504 =item country
505
506 2 Digit Country Code
507
508 =item daytime
509
510 Daytime phone number
511
512 =item night
513
514 Evening phone number
515
516 =item fax
517
518 Fax number
519
520 =item mobile
521
522 Mobile number
523
524 =item invoicing_list
525
526 Comma-separated list of email addresses for email invoices. The special value 
527 'POST' is used to designate postal invoicing (it may be specified alone or in
528 addition to email addresses),
529 postal_invoicing
530 Set to 1 to enable postal invoicing
531
532 =item referral_custnum
533
534 Referring customer number
535
536 =item salesnum
537
538 Sales person number
539
540 =item agentnum
541
542 Agent number
543
544 =back
545
546 =cut
547
548 sub update_customer {
549   my( $class, %opt ) = @_;
550   return _shared_secret_error() unless _check_shared_secret($opt{secret});
551
552   FS::cust_main->API_update( %opt );
553 }
554
555 =item customer_info OPTION => VALUE, ...
556
557 Returns general customer information. Takes a list of keys and values as
558 parameters with the following keys: custnum, secret 
559
560 Example:
561
562   use Frontier::Client;
563   use Data::Dumper;
564
565   my $url = new URI 'http://localhost:8008/'; #or if accessing remotely, secure
566                                               # the traffic
567
568   my $xmlrpc = new Frontier::Client url=>$url;
569
570   my $result = $xmlrpc->call( 'FS.API.customer_info',
571                                 'secret'  => 'sharingiscaring',
572                                 'custnum' => 181318,
573                             );
574
575   print Dumper($result);
576
577 =cut
578
579 sub customer_info {
580   my( $class, %opt ) = @_;
581   return _shared_secret_error() unless _check_shared_secret($opt{secret});
582
583   my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} })
584     or return { 'error' => 'Unknown custnum' };
585
586   $cust_main->API_getinfo;
587 }
588
589 =item customer_list_svcs OPTION => VALUE, ...
590
591 Returns customer service information.  Takes a list of keys and values as
592 parameters with the following keys: custnum, secret
593
594 Example:
595
596   use Frontier::Client;
597   use Data::Dumper;
598
599   my $url = new URI 'http://localhost:8008/'; #or if accessing remotely, secure
600                                               # the traffic
601
602   my $xmlrpc = new Frontier::Client url=>$url;
603
604   my $result = $xmlrpc->call( 'FS.API.customer_list_svcs',
605                                 'secret'  => 'sharingiscaring',
606                                 'custnum' => 181318,
607                             );
608
609   print Dumper($result);
610
611   foreach my $cust_svc ( @{ $result->{'cust_svc'} } ) {
612     #print $cust_svc->{mac_addr}."\n" if exists $cust_svc->{mac_addr};
613     print $cust_svc->{circuit_id}."\n" if exists $cust_svc->{circuit_id};
614   }
615
616 =cut
617
618 sub customer_list_svcs {
619   my( $class, %opt ) = @_;
620   return _shared_secret_error() unless _check_shared_secret($opt{secret});
621
622   my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} })
623     or return { 'error' => 'Unknown custnum' };
624
625   #$cust_main->API_list_svcs;
626
627   #false laziness w/ClientAPI/list_svcs
628
629   my @cust_svc = ();
630   #my @cust_pkg_usage = ();
631   #foreach my $cust_pkg ( $p->{'ncancelled'} 
632   #                       ? $cust_main->ncancelled_pkgs
633   #                       : $cust_main->unsuspended_pkgs ) {
634   foreach my $cust_pkg ( $cust_main->all_pkgs ) {
635     #next if $pkgnum && $cust_pkg->pkgnum != $pkgnum;
636     push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context
637     #push @cust_pkg_usage, $cust_pkg->cust_pkg_usage;
638   }
639
640   return {
641     'cust_svc' => [ map $_->API_getinfo, @cust_svc ],
642   };
643
644 }
645
646 =item location_info
647
648 Returns location specific information for the customer. Takes a list of keys
649 and values as paramters with the following keys: custnum, secret
650
651 =cut
652
653 #I also monitor for changes to the additional locations that are applied to
654 # packages, and would like for those to be exportable as well.  basically the
655 # location data passed with the custnum.
656
657 sub location_info {
658   my( $class, %opt ) = @_;
659   return _shared_secret_error() unless _check_shared_secret($opt{secret});
660
661   my @cust_location = qsearch('cust_location', { 'custnum' => $opt{custnum} });
662
663   my %return = (
664     'error'           => '',
665     'locations'       => [ map $_->hashref, @cust_location ],
666   );
667
668   return \%return;
669 }
670
671 =item list_customer_packages OPTION => VALUE, ...
672
673 Lists all customer packages.
674
675 =over
676
677 =item secret
678
679 API Secret
680
681 =item custnum
682
683 Customer Number
684
685 =back
686
687 Example:
688
689   my $result = FS::API->list_packages(
690     'secret'  => 'sharingiscaring',
691     'custnum'  => custnum,
692   );
693
694   if ( $result->{'error'} ) {
695     die $result->{'error'};
696   } else {
697     # list packages returns an array of hashes for packages ordered by custnum and pkgnum.
698     print Dumper($result->{'pkgs'});
699   }
700
701 =cut
702
703 sub list_customer_packages {
704   my( $class, %opt ) = @_;
705   return _shared_secret_error() unless _check_shared_secret($opt{secret});
706
707   my $sql_query = FS::cust_pkg->search({ 'custnum' => $opt{custnum}, });
708
709   $sql_query->{order_by} = 'ORDER BY custnum, pkgnum';
710
711   my @packages = qsearch($sql_query)
712     or return { 'error' => 'No packages' };
713
714   my $return = {
715     'packages'       => [ map $_->hashref, @packages ],
716   };
717
718   $return;
719 }
720
721 =item package_status OPTION => VALUE, ...
722
723 Get package status.
724
725 =over
726
727 =item secret
728
729 API Secret
730
731 =item pkgnum
732
733 Package Number
734
735 =back
736
737 Example:
738
739   my $result = FS::API->package_status(
740     'secret'  => 'sharingiscaring',
741     'pkgnum'  => pkgnum,
742   );
743
744   if ( $result->{'error'} ) {
745     die $result->{'error'};
746   } else {
747     # package status returns a hash with the status for a package.
748     print Dumper($result->{'status'});
749   }
750
751 =cut
752
753 sub package_status {
754   my( $class, %opt ) = @_;
755   return _shared_secret_error() unless _check_shared_secret($opt{secret});
756
757   my $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $opt{pkgnum} } )
758     or return { 'error' => 'No packages' };
759
760   my $return = {
761     'status' => $cust_pkg->status,
762   };
763
764   $return;
765 }
766
767 =item order_package OPTION => VALUE, ...
768
769 Orders a new customer package.  Takes a list of keys and values as paramaters
770 with the following keys:
771
772 =over 4
773
774 =item secret
775
776 API Secret
777
778 =item custnum
779
780 =item pkgpart
781
782 =item quantity
783
784 =item start_date
785
786 =item contract_end
787
788 =item address1
789
790 =item address2
791
792 =item city
793
794 =item county
795
796 =item state
797
798 =item zip
799
800 =item country
801
802 =item setup_fee
803
804 Including this implements per-customer custom pricing for this package, overriding package definition pricing
805
806 =item recur_fee
807
808 Including this implements per-customer custom pricing for this package, overriding package definition pricing
809
810 =item invoice_details
811
812 A single string for just one detail line, or an array reference of one or more
813 lines of detail
814
815 =back
816
817 =cut
818
819 sub order_package {
820   my( $class, %opt ) = @_;
821
822   my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} })
823     or return { 'error' => 'Unknown custnum' };
824
825   #some conceptual false laziness w/cust_pkg/Import.pm
826
827   my $cust_pkg = new FS::cust_pkg {
828     'pkgpart'    => $opt{'pkgpart'},
829     'quantity'   => $opt{'quantity'} || 1,
830   };
831
832   #start_date and contract_end
833   foreach my $date_field (qw( start_date contract_end )) {
834     if ( $opt{$date_field} =~ /^(\d+)$/ ) {
835       $cust_pkg->$date_field( $opt{$date_field} );
836     } elsif ( $opt{$date_field} ) {
837       $cust_pkg->$date_field( str2time( $opt{$date_field} ) );
838     }
839   }
840
841   #especially this part for custom pkg price
842   # (false laziness w/cust_pkg/Import.pm)
843   my $s = $opt{'setup_fee'};
844   my $r = $opt{'recur_fee'};
845   my $part_pkg = $cust_pkg->part_pkg;
846   if (    ( length($s) && $s != $part_pkg->option('setup_fee') )
847        or ( length($r) && $r != $part_pkg->option('recur_fee') )
848      )
849   {
850
851     local($FS::part_pkg::skip_pkg_svc_hack) = 1;
852
853     my $custom_part_pkg = $part_pkg->clone;
854     $custom_part_pkg->disabled('Y');
855     my %options = $part_pkg->options;
856     $options{'setup_fee'} = $s if length($s);
857     $options{'recur_fee'} = $r if length($r);
858     my $error = $custom_part_pkg->insert( options=>\%options );
859     return ( 'error' => "error customizing package: $error" ) if $error;
860
861     #not ->pkg_svc, we want to ignore links and clone the actual package def
862     foreach my $pkg_svc ( $part_pkg->_pkg_svc ) {
863       my $c_pkg_svc = new FS::pkg_svc { $pkg_svc->hash };
864       $c_pkg_svc->pkgsvcnum('');
865       $c_pkg_svc->pkgpart( $custom_part_pkg->pkgpart );
866       my $error = $c_pkg_svc->insert;
867       return "error customizing package: $error" if $error;
868     }
869
870     $cust_pkg->pkgpart( $custom_part_pkg->pkgpart );
871
872   }
873
874   my %order_pkg = ( 'cust_pkg' => $cust_pkg );
875
876   my @loc_fields = qw( address1 address2 city county state zip country );
877   if ( grep length($opt{$_}), @loc_fields ) {
878      $order_pkg{'cust_location'} = new FS::cust_location {
879        map { $_ => $opt{$_} } @loc_fields, 'custnum'
880      };
881   }
882
883   $order_pkg{'invoice_details'} = $opt{'invoice_details'}
884     if $opt{'invoice_details'};
885
886   my $error = $cust_main->order_pkg( %order_pkg );
887
888   #if ( $error ) {
889     return { 'error'  => $error,
890              #'pkgnum' => '',
891            };
892   #} else {
893   #  return { 'error'  => '',
894   #           #cust_main->order_pkg doesn't actually have a way to return pkgnum
895   #           #'pkgnum' => $pkgnum,
896   #         };
897   #}
898
899 }
900
901 =item change_package_location
902
903 Updates package location. Takes a list of keys and values 
904 as parameters with the following keys: 
905
906 pkgnum
907
908 secret
909
910 locationnum - pass this, or the following keys (don't pass both)
911
912 locationname
913
914 address1
915
916 address2
917
918 city
919
920 county
921
922 state
923
924 zip
925
926 addr_clean
927
928 country
929
930 censustract
931
932 censusyear
933
934 location_type
935
936 location_number
937
938 location_kind
939
940 incorporated
941
942 On error, returns a hashref with an 'error' key.
943 On success, returns a hashref with 'pkgnum' and 'locationnum' keys,
944 containing the new values.
945
946 =cut
947
948 sub change_package_location {
949   my $class = shift;
950   my %opt  = @_;
951   return _shared_secret_error() unless _check_shared_secret($opt{'secret'});
952
953   my $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $opt{'pkgnum'} })
954     or return { 'error' => 'Unknown pkgnum' };
955
956   my %changeopt;
957
958   foreach my $field ( qw(
959     locationnum
960     locationname
961     address1
962     address2
963     city
964     county
965     state
966     zip
967     addr_clean
968     country
969     censustract
970     censusyear
971     location_type
972     location_number
973     location_kind
974     incorporated
975   )) {
976     $changeopt{$field} = $opt{$field} if $opt{$field};
977   }
978
979   $cust_pkg->API_change(%changeopt);
980 }
981
982 =item bill_now OPTION => VALUE, ...
983
984 Bills a single customer now, in the same fashion as the "Bill now" link in the
985 UI.
986
987 Returns a hash reference with a single key, 'error'.  If there is an error,   
988 the value contains the error, otherwise it is empty. Takes a list of keys and
989 values as parameters with the following keys:
990
991 =over 4
992
993 =item secret
994
995 API Secret (required)
996
997 =item custnum
998
999 Customer number (required)
1000
1001 =back
1002
1003 =cut
1004
1005 sub bill_now {
1006   my( $class, %opt ) = @_;
1007   return _shared_secret_error() unless _check_shared_secret($opt{secret});
1008
1009   my $cust_main = qsearchs('cust_main', { 'custnum' => $opt{custnum} })
1010     or return { 'error' => 'Unknown custnum' };
1011
1012   my $error = $cust_main->bill_and_collect( 'fatal'      => 'return',
1013                                             'retry'      => 1,
1014                                             'check_freq' =>'1d',
1015                                           );
1016
1017    return { 'error' => $error,
1018           };
1019
1020 }
1021
1022
1023 #next.. Delete Advertising sources?
1024
1025 =item list_advertising_sources OPTION => VALUE, ...
1026
1027 Lists all advertising sources.
1028
1029 =over
1030
1031 =item secret
1032
1033 API Secret
1034
1035 =back
1036
1037 Example:
1038
1039   my $result = FS::API->list_advertising_sources(
1040     'secret'  => 'sharingiscaring',
1041   );
1042
1043   if ( $result->{'error'} ) {
1044     die $result->{'error'};
1045   } else {
1046     # list advertising sources returns an array of hashes for sources.
1047     print Dumper($result->{'sources'});
1048   }
1049
1050 =cut
1051
1052 #list_advertising_sources
1053 sub list_advertising_sources {
1054   my( $class, %opt ) = @_;
1055   return _shared_secret_error() unless _check_shared_secret($opt{secret});
1056
1057   my @sources = qsearch('part_referral', {}, '', "")
1058     or return { 'error' => 'No referrals' };
1059
1060   my $return = {
1061     'sources'       => [ map $_->hashref, @sources ],
1062   };
1063
1064   $return;
1065 }
1066
1067 =item add_advertising_source OPTION => VALUE, ...
1068
1069 Add a new advertising source.
1070
1071 =over
1072
1073 =item secret
1074
1075 API Secret
1076
1077 =item referral
1078
1079 Referral name
1080
1081 =item disabled
1082
1083 Referral disabled, Y for disabled or nothing for enabled
1084
1085 =item agentnum
1086
1087 Agent ID number
1088
1089 =item title
1090
1091 External referral ID
1092
1093 =back
1094
1095 Example:
1096
1097   my $result = FS::API->add_advertising_source(
1098     'secret'     => 'sharingiscaring',
1099     'referral'   => 'test referral',
1100
1101     #optional
1102     'disabled'   => 'Y',
1103     'agentnum'   => '2', #agent id number
1104     'title'      => 'test title',
1105   );
1106
1107   if ( $result->{'error'} ) {
1108     die $result->{'error'};
1109   } else {
1110     # add_advertising_source returns new source upon success.
1111     print Dumper($result);
1112   }
1113
1114 =cut
1115
1116 #add_advertising_source
1117 sub add_advertising_source {
1118   my( $class, %opt ) = @_;
1119   return _shared_secret_error() unless _check_shared_secret($opt{secret});
1120
1121   use FS::part_referral;
1122
1123   my $new_source = $opt{source};
1124
1125   my $source = new FS::part_referral $new_source;
1126
1127   my $error = $source->insert;
1128
1129   my $return = {$source->hash};
1130   $return = { 'error' => $error, } if $error;
1131
1132   $return;
1133 }
1134
1135 =item edit_advertising_source OPTION => VALUE, ...
1136
1137 Edit a advertising source.
1138
1139 =over
1140
1141 =item secret
1142
1143 API Secret
1144
1145 =item refnum
1146
1147 Referral number to edit
1148
1149 =item source
1150
1151 hash of edited source fields.
1152
1153 =over
1154
1155 =item referral
1156
1157 Referral name
1158
1159 =item disabled
1160
1161 Referral disabled, Y for disabled or nothing for enabled
1162
1163 =item agentnum
1164
1165 Agent ID number
1166
1167 =item title
1168
1169 External referral ID
1170
1171 =back
1172
1173 =back
1174
1175 Example:
1176
1177   my $result = FS::API->edit_advertising_source(
1178     'secret'     => 'sharingiscaring',
1179     'refnum'     => '4', # referral number to edit
1180     'source'     => {
1181        #optional
1182        'referral'   => 'test referral',
1183        'disabled'   => 'Y',
1184        'agentnum'   => '2', #agent id number
1185        'title'      => 'test title',
1186     }
1187   );
1188
1189   if ( $result->{'error'} ) {
1190     die $result->{'error'};
1191   } else {
1192     # edit_advertising_source returns updated source upon success.
1193     print Dumper($result);
1194   }
1195
1196 =cut
1197
1198 #edit_advertising_source
1199 sub edit_advertising_source {
1200   my( $class, %opt ) = @_;
1201   return _shared_secret_error() unless _check_shared_secret($opt{secret});
1202
1203   use FS::part_referral;
1204
1205   my $refnum = $opt{refnum};
1206   my $source = $opt{source};
1207
1208   my $old = FS::Record::qsearchs('part_referral', {'refnum' => $refnum,});
1209   my $new = new FS::part_referral { $old->hash };
1210
1211   foreach my $key (keys %$source) {
1212     $new->$key($source->{$key});
1213   }
1214
1215   my $error = $new->replace;
1216
1217   my $return = {$new->hash};
1218   $return = { 'error' => $error, } if $error;
1219
1220   $return;
1221 }
1222
1223
1224 =item email_optout OPTION => VALUE, ...
1225
1226 Each e-mail address, or L<FS::cust_contact> record, has two opt-in flags:
1227 message_dest: recieve non-invoicing messages, and invoice_dest: recieve
1228 invoicing messages
1229
1230 Use this API call to remove opt-in flags for an e-mail address
1231
1232 =over 4
1233
1234 =item address
1235
1236 E-Mail address
1237
1238 =item disable_message_dest
1239
1240 Enabled by default:
1241 Set this parameter as 0 in your API call to leave the message_dest flag as is
1242
1243 =item disable_invoice_dest
1244
1245 Enabled by default:
1246 Set this parameter as 0 in your API call to leave the invoice_dest flag as is
1247
1248 =back
1249
1250 =cut
1251
1252 sub email_opt_out {
1253   my ($class, %opt) = @_;
1254
1255   return _shared_secret_error()
1256     unless _check_shared_secret($opt{secret});
1257
1258   return {error => 'No e-mail address specified'}
1259     unless $opt{address} && $opt{address} =~ /\@/;
1260
1261   $opt{disable_message_dest} ||= 1;
1262   $opt{disable_invoice_dest} ||= 1;
1263
1264   my $address = FS::Record::dbh->quote($opt{address});
1265
1266   for my $cust_contact (
1267     FS::Record::qsearch({
1268       table     => 'cust_contact',
1269       select    => 'cust_contact.*',
1270       addl_from => 'LEFT JOIN contact_email USING (contactnum)',
1271       extra_sql => "WHERE contact_email.emailaddress = $address",
1272     })
1273   ) {
1274     $cust_contact->set(invoice_dest => '') if $opt{disable_invoice_dest};
1275     $cust_contact->set(message_dest => '') if $opt{disable_message_dest};
1276
1277     my $error = $cust_contact->replace();
1278     return {error => $error} if $error;
1279   }
1280   return;
1281 }
1282
1283
1284 ##
1285 # helper subroutines
1286 ##
1287
1288 sub _check_shared_secret {
1289   shift eq FS::Conf->new->config('api_shared_secret');
1290 }
1291
1292 sub _shared_secret_error {
1293   return { 'error' => 'Incorrect shared secret' };
1294 }
1295
1296
1297 =back
1298
1299 =cut
1300
1301 1;