4 use vars qw($DEBUG @ISA @EXPORT_OK $me);
6 use Carp qw( confess );
9 use FS::Misc::DateTime qw( parse_datetime day_end );
10 use FS::Record qw(dbdef);
11 use FS::cust_main; # are sql_balance and sql_date_balance in the right module?
16 @ISA = qw( Exporter );
18 @EXPORT_OK = qw( svc_url random_id );
21 $me = '[FS::UID::Web]';
30 sub parse_beginning_ending {
31 my($cgi, $prefix) = @_;
32 $prefix .= '_' if $prefix;
35 if ( $cgi->param($prefix.'begin') =~ /^(\d+)$/ ) {
37 } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
38 $beginning = parse_datetime($1) || 0;
41 my $ending = 4294967295; #2^32-1
42 if ( $cgi->param($prefix.'end') =~ /^(\d+)$/ ) {
44 } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
45 $ending = parse_datetime($1);
46 $ending = day_end($ending) unless $ending =~ /:/;
49 ( $beginning, $ending );
54 Returns a service URL, first checking to see if there is a service-specific
55 page to link to, otherwise to a generic service handling page. Options are
56 passed as a list of name-value pairs, and include:
60 =item * m - Mason request object ($m)
62 =item * action - The action for which to construct "edit", "view", or "search"
64 =item ** part_svc - Service definition (see L<FS::part_svc>)
66 =item ** svcdb - Service table
68 =item *** query - Query string
70 =item *** svc - FS::cust_svc or FS::svc_* object
72 =item ahref - Optional flag, if set true returns <A HREF="$url"> instead of just the URL.
78 ** part_svc OR svcdb is required
80 *** query OR svc is required
87 # 'm' => $m, #mason request object
88 # 'action' => 'edit', #or 'view'
90 # 'part_svc' => $part_svc, #usual
92 # 'svcdb' => 'svc_table',
94 # 'query' => #optional query string
95 # # (pass a blank string if you want a "raw" URL to add your
98 # 'svc' => $svc_x, #or $cust_svc, it just needs a svcnum
103 # 'ahref' => 1, # if set true, returns <A HREF="$url">
105 use FS::CGI qw(rooturl);
109 #? return '' unless ref($opt{part_svc});
111 my $svcdb = $opt{svcdb} || $opt{part_svc}->svcdb;
112 my $query = exists($opt{query}) ? $opt{query} : $opt{svc}->svcnum;
114 warn "$me [svc_url] checking for /$opt{action}/$svcdb.cgi component"
116 if ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.cgi") ) {
117 $url = "$svcdb.cgi?";
118 } elsif ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.html") ) {
119 $url = "$svcdb.html?";
121 my $generic = $opt{action} eq 'search' ? 'cust_svc' : 'svc_Common';
123 $url = "$generic.html?svcdb=$svcdb;";
124 $url .= 'svcnum=' if $query =~ /^\d+(;|$)/ or $query eq '';
127 my $return = FS::CGI::rooturl(). "$opt{action}/$url$query";
129 $return = qq!<A HREF="$return">! if $opt{ahref};
135 my($m, $part_svc, $cust_svc) = @_ or return '';
136 svc_X_link( $part_svc->svc, @_ );
140 my($m, $part_svc, $cust_svc) = @_ or return '';
141 my($svc, $label, $svcdb) = $cust_svc->label;
142 svc_X_link( $label, @_ );
146 my ($x, $m, $part_svc, $cust_svc) = @_ or return '';
149 unless $FS::CurrentUser::CurrentUser->access_right('View customer services');
151 confess "svc_X_link called without a service ($x, $m, $part_svc, $cust_svc)\n"
158 'part_svc' => $part_svc,
165 #this probably needs an ACL too...
166 sub svc_export_links {
167 my ($m, $part_svc, $cust_svc) = @_ or return '';
169 my $ahref = $cust_svc->export_links;
175 my($cgi, $field) = (shift, shift);
176 my $table = ( @_ && length($_[0]) ) ? shift.'.' : '';
185 foreach my $op (keys %op) {
187 warn "checking for ${field}_$op field\n"
190 if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*(-?[\d\,\s]+(\.\d\d)?)\s*$/ ) {
193 $num =~ s/[\,\s]+//g;
194 my $search = "$table$field $op{$op} $num";
195 push @search, $search;
197 warn "found ${field}_$op field; adding search element $search\n"
208 # cust_main report subroutines
213 =item cust_header [ CUST_FIELDS_VALUE ]
215 Returns an array of customer information headers according to the supplied
216 customer fields value, or if no value is supplied, the B<cust-fields>
221 use vars qw( @cust_fields @cust_colors @cust_styles @cust_aligns );
225 warn "FS::UI:Web::cust_header called"
228 my $conf = new FS::Conf;
230 my %header2method = (
231 'Customer' => 'name',
232 'Cust. Status' => 'cust_status_label',
233 'Cust#' => 'custnum',
235 'Company' => 'company',
237 # obsolete but might still be referenced in configuration
238 '(bill) Customer' => 'name',
239 '(service) Customer' => 'ship_name',
240 '(bill) Name' => 'contact',
241 '(service) Name' => 'ship_contact',
242 '(bill) Company' => 'company',
243 '(service) Company' => 'ship_company',
244 '(bill) Day phone' => 'daytime',
245 '(bill) Night phone' => 'night',
246 '(bill) Fax number' => 'fax',
248 'Customer' => 'name',
249 'Address 1' => 'bill_address1',
250 'Address 2' => 'bill_address2',
251 'City' => 'bill_city',
252 'State' => 'bill_state',
254 'Country' => 'bill_country_full',
255 'Day phone' => 'daytime', # XXX should use msgcat, but how?
256 'Night phone' => 'night', # XXX should use msgcat, but how?
257 'Mobile phone' => 'mobile', # XXX should use msgcat, but how?
258 'Fax number' => 'fax',
259 '(bill) Address 1' => 'bill_address1',
260 '(bill) Address 2' => 'bill_address2',
261 '(bill) City' => 'bill_city',
262 '(bill) State' => 'bill_state',
263 '(bill) Zip' => 'bill_zip',
264 '(bill) Country' => 'bill_country_full',
265 '(bill) Latitude' => 'bill_latitude',
266 '(bill) Longitude' => 'bill_longitude',
267 '(service) Address 1' => 'ship_address1',
268 '(service) Address 2' => 'ship_address2',
269 '(service) City' => 'ship_city',
270 '(service) State' => 'ship_state',
271 '(service) Zip' => 'ship_zip',
272 '(service) Country' => 'ship_country_full',
273 '(service) Latitude' => 'ship_latitude',
274 '(service) Longitude' => 'ship_longitude',
275 'Invoicing email(s)' => 'invoicing_list_emailonly_scalar',
276 'Payment Type' => 'cust_payby',
277 'Current Balance' => 'current_balance',
278 'Agent Cust#' => 'agent_custid',
280 $header2method{'Cust#'} = 'display_custnum'
281 if $conf->exists('cust_main-default_agent_custid');
283 my %header2colormethod = (
284 'Cust. Status' => 'cust_statuscolor',
287 'Cust. Status' => 'b',
290 'Cust. Status' => 'c',
298 warn " using supplied cust-fields override".
299 " (ignoring cust-fields config file)"
301 $cust_fields = shift;
305 if ( $conf->exists('cust-fields')
306 && $conf->config('cust-fields') =~ /^([\w\. \|\#\(\)]+):?/
309 warn " found cust-fields configuration value"
313 warn " no cust-fields configuration value found; using default 'Cust. Status | Customer'"
315 $cust_fields = 'Cust. Status | Customer';
320 @cust_header = split(/ \| /, $cust_fields);
321 @cust_fields = map { $header2method{$_} || $_ } @cust_header;
322 @cust_colors = map { exists $header2colormethod{$_}
323 ? $header2colormethod{$_}
327 @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' }
329 @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' }
336 sub cust_sort_fields {
337 cust_header(@_) if( @_ or !@cust_fields );
338 #inefficientish, but tiny lists and only run once per page
340 map { $_ eq 'custnum' ? 'custnum' : '' } @cust_fields;
344 =item cust_sql_fields [ CUST_FIELDS_VALUE ]
346 Returns a list of fields for the SELECT portion of an SQL query.
348 As with L<the cust_header subroutine|/cust_header>, the fields returned are
349 defined by the supplied customer fields setting, or if no customer fields
350 setting is supplied, the <B>cust-fields</B> configuration value.
354 sub cust_sql_fields {
356 my @fields = qw( last first company );
357 # push @fields, map "ship_$_", @fields;
359 cust_header(@_) if( @_ or !@cust_fields );
360 #inefficientish, but tiny lists and only run once per page
363 foreach my $field (qw( address1 address2 city state zip latitude longitude )) {
364 foreach my $pre ('bill_','ship_') {
365 if ( grep { $_ eq $pre.$field } @cust_fields ) {
366 push @location_fields, $pre.'location.'.$field.' AS '.$pre.$field;
370 foreach my $pre ('bill_','ship_') {
371 if ( grep { $_ eq $pre.'country_full' } @cust_fields ) {
372 push @location_fields, $pre.'locationnum';
376 foreach my $field (qw(daytime night mobile fax )) {
377 push @fields, $field if (grep { $_ eq $field } @cust_fields);
379 push @fields, "payby AS cust_payby"
380 if grep { $_ eq 'cust_payby' } @cust_fields;
381 push @fields, 'agent_custid';
383 my @extra_fields = ();
384 if (grep { $_ eq 'current_balance' } @cust_fields) {
385 push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
388 map("cust_main.$_", @fields), @location_fields, @extra_fields;
391 =item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ]
393 Returns an SQL join phrase for the FROM clause so that the fields listed
394 in L<cust_sql_fields> will be available. Currently joins to cust_main
395 itself, as well as cust_location (under the aliases 'bill_location' and
396 'ship_location') if address fields are needed. L<cust_header()> should have
399 All of these will be left joins; if you want to exclude rows with no linked
400 cust_main record (or bill_location/ship_location), you can do so in the
403 TABLE is the table containing the custnum field. If CUSTNUM (a field name
404 in that table) is specified, that field will be joined to cust_main.custnum.
405 Otherwise, this function will assume the field is named "custnum". If the
406 argument isn't present at all, the join will just say "USING (custnum)",
409 As a special case, if TABLE is 'cust_main', only the joins to cust_location
412 LOCATION_TABLE is an optional table name to use for joining ship_location,
413 in case your query also includes package information and you want the
414 "service address" columns to reflect package addresses.
419 my ($cust_table, $location_table) = @_;
420 my ($custnum, $locationnum);
421 ($cust_table, $custnum) = split(/\./, $cust_table);
422 $custnum ||= 'custnum';
423 ($location_table, $locationnum) = split(/\./, $location_table);
424 $locationnum ||= 'locationnum';
428 $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)"
429 unless $cust_table eq 'cust_main';
431 $sql = " LEFT JOIN cust_main USING (custnum)";
434 if ( !@cust_fields or grep /^bill_/, @cust_fields ) {
436 $sql .= ' LEFT JOIN cust_location bill_location'.
437 ' ON (bill_location.locationnum = cust_main.bill_locationnum)';
441 if ( !@cust_fields or grep /^ship_/, @cust_fields ) {
443 if (!$location_table) {
444 $location_table = 'cust_main';
445 $locationnum = 'ship_locationnum';
448 $sql .= ' LEFT JOIN cust_location ship_location'.
449 " ON (ship_location.locationnum = $location_table.$locationnum) ";
455 =item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
457 Given an object that contains fields from cust_main (say, from a
458 JOINed search. See httemplate/search/svc_* for examples), returns an array
459 of customer information, or "(unlinked)" if this service is not linked to a
462 As with L<the cust_header subroutine|/cust_header>, the fields returned are
463 defined by the supplied customer fields setting, or if no customer fields
464 setting is supplied, the <B>cust-fields</B> configuration value.
471 warn "FS::UI::Web::cust_fields called for $record ".
472 "(cust_fields: @cust_fields)"
475 #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
476 # #override incase we were passed as a sub
478 my $seen_unlinked = 0;
481 if ( $record->custnum ) {
482 warn " $record -> $_" if $DEBUG > 1;
483 encode_entities( $record->$_(@_) );
485 warn " ($record unlinked)" if $DEBUG > 1;
486 $seen_unlinked++ ? '' : '(unlinked)';
491 =item cust_fields_subs
493 Returns an array of subroutine references for returning customer field values.
494 This is similar to cust_fields, but returns each field's sub as a distinct
499 sub cust_fields_subs {
500 my $unlinked_warn = 0;
504 if ( $unlinked_warn++ ) {
508 if ( $record->custnum ) {
509 encode_entities( $record->$f(@_) );
519 $record->custnum ? encode_entities( $record->$f(@_) ) : '';
529 Returns an array of subroutine references (or empty strings) for returning
530 customer information colors.
532 As with L<the cust_header subroutine|/cust_header>, the fields returned are
533 defined by the supplied customer fields setting, or if no customer fields
534 setting is supplied, the <B>cust-fields</B> configuration value.
542 sub { shift->$method(@_) };
551 Returns an array of customer information styles.
553 As with L<the cust_header subroutine|/cust_header>, the fields returned are
554 defined by the supplied customer fields setting, or if no customer fields
555 setting is supplied, the <B>cust-fields</B> configuration value.
571 Returns an array or scalar (depending on context) of customer information
574 As with L<the cust_header subroutine|/cust_header>, the fields returned are
575 defined by the supplied customer fields setting, or if no customer fields
576 setting is supplied, the <B>cust-fields</B> configuration value.
584 join('', @cust_aligns);
590 Returns an array of links to view/cust_main.cgi, for use with cust_fields.
595 my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ];
597 return map { $_ eq 'cust_status_label' ? '' : $link }
603 Utility function to determine if the client is a mobile browser.
608 my $ua = $ENV{'HTTP_USER_AGENT'} || '';
609 if ( $ua =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60|Opera Mini|Opera Mobi)/io ) {
615 =item random_id [ DIGITS ]
617 Returns a random number of length DIGITS, or if unspecified, a long random
618 identifier consisting of the timestamp, process ID, and a random number.
619 Anything in the UI that needs a random identifier should use this.
625 if (!defined $NO_RANDOM_IDS) {
626 my $conf = FS::Conf->new;
627 $NO_RANDOM_IDS = $conf->exists('no_random_ids') ? 1 : 0;
628 warn "TEST MODE--RANDOM ID NUMBERS DISABLED\n" if $NO_RANDOM_IDS;
630 if ( $NO_RANDOM_IDS ) {
634 return '0000000000-0000-000000000.000000';
638 return int(rand(10 ** $digits));
640 return time . "-$$-" . rand() * 2**32;
650 # begin JSRPC code...
653 package FS::UI::Web::JSRPC;
658 use Storable qw(nfreeze);
660 use Cpanel::JSON::XS;
662 use FS::Record qw(qsearchs);
664 use FS::CGI qw(rooturl);
678 croak "CGI object required as second argument" unless $self->{'cgi'};
687 my $cgi = $self->{'cgi'};
689 # XXX this should parse JSON foo and build a proper data structure
690 my @args = $cgi->param('arg');
692 #work around konqueror bug!
693 @args = map { s/\x00$//; $_; } @args;
695 my $sub = $cgi->param('sub'); #????
697 warn "FS::UI::Web::JSRPC::process:\n".
700 " args=".join(', ',@args)."\n"
703 if ( $sub eq 'start_job' ) {
705 $self->start_job(@args);
707 } elsif ( $sub eq 'job_status' ) {
709 $self->job_status(@args);
713 die "unknown sub $sub";
722 warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
726 my( $field, $value ) = splice(@_, 0, 2);
727 unless ( exists( $param{$field} ) ) {
728 $param{$field} = $value;
729 } elsif ( ! ref($param{$field}) ) {
730 $param{$field} = [ $param{$field}, $value ];
732 push @{$param{$field}}, $value;
735 $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
736 $param{RootURL} = rooturl($self->{cgi}->self_url);
737 warn "FS::UI::Web::start_job\n".
739 if ( ref($param{$_}) ) {
740 " $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
742 " $_ => $param{$_}\n";
747 #first get the CGI params shipped off to a job ASAP so an id can be returned
750 my $job = new FS::queue { 'job' => $self->{'job'} };
752 #too slow to insert all the cgi params as individual args..,?
753 #my $error = $queue->insert('_JOB', $cgi->Vars);
755 #rely on FS::queue smartness to freeze/encode the param hash
757 my $error = $job->insert( '_JOB', \%param );
761 warn "job not inserted: $error\n"
764 $error; #this doesn't seem to be handled well,
765 # will trigger "illegal jobnum" below?
766 # (should never be an error inserting the job, though, only thing
767 # would be Pg f%*kage)
770 warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
779 my( $self, $jobnum ) = @_; #$url ???
781 sleep 1; # XXX could use something better...
784 if ( $jobnum =~ /^(\d+)$/ ) {
785 $job = qsearchs('queue', { 'jobnum' => $jobnum } );
787 die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
791 if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
792 my ($progress, $action) = split ',', $job->statustext, 2;
793 $action ||= 'Server processing job';
794 @return = ( 'progress', $progress, $action );
795 } elsif ( !$job ) { #handle job gone case : job successful
796 # so close popup, redirect parent window...
797 @return = ( 'complete' );
798 } elsif ( $job->status eq 'done' ) {
799 @return = ( 'done', $job->statustext, '' );
801 @return = ( 'error', $job ? $job->statustext : $jobnum );
804 encode_json \@return;