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