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' => '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 payby)) {
377 push @fields, $field if (grep { $_ eq $field } @cust_fields);
379 push @fields, 'agent_custid';
381 my @extra_fields = ();
382 if (grep { $_ eq 'current_balance' } @cust_fields) {
383 push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
386 map("cust_main.$_", @fields), @location_fields, @extra_fields;
389 =item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ]
391 Returns an SQL join phrase for the FROM clause so that the fields listed
392 in L<cust_sql_fields> will be available. Currently joins to cust_main
393 itself, as well as cust_location (under the aliases 'bill_location' and
394 'ship_location') if address fields are needed. L<cust_header()> should have
397 All of these will be left joins; if you want to exclude rows with no linked
398 cust_main record (or bill_location/ship_location), you can do so in the
401 TABLE is the table containing the custnum field. If CUSTNUM (a field name
402 in that table) is specified, that field will be joined to cust_main.custnum.
403 Otherwise, this function will assume the field is named "custnum". If the
404 argument isn't present at all, the join will just say "USING (custnum)",
407 As a special case, if TABLE is 'cust_main', only the joins to cust_location
410 LOCATION_TABLE is an optional table name to use for joining ship_location,
411 in case your query also includes package information and you want the
412 "service address" columns to reflect package addresses.
417 my ($cust_table, $location_table) = @_;
418 my ($custnum, $locationnum);
419 ($cust_table, $custnum) = split(/\./, $cust_table);
420 $custnum ||= 'custnum';
421 ($location_table, $locationnum) = split(/\./, $location_table);
422 $locationnum ||= 'locationnum';
426 $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)"
427 unless $cust_table eq 'cust_main';
429 $sql = " LEFT JOIN cust_main USING (custnum)";
432 if ( !@cust_fields or grep /^bill_/, @cust_fields ) {
434 $sql .= ' LEFT JOIN cust_location bill_location'.
435 ' ON (bill_location.locationnum = cust_main.bill_locationnum)';
439 if ( !@cust_fields or grep /^ship_/, @cust_fields ) {
441 if (!$location_table) {
442 $location_table = 'cust_main';
443 $locationnum = 'ship_locationnum';
446 $sql .= ' LEFT JOIN cust_location ship_location'.
447 " ON (ship_location.locationnum = $location_table.$locationnum) ";
453 =item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
455 Given an object that contains fields from cust_main (say, from a
456 JOINed search. See httemplate/search/svc_* for examples), returns an array
457 of customer information, or "(unlinked)" if this service is not linked to a
460 As with L<the cust_header subroutine|/cust_header>, the fields returned are
461 defined by the supplied customer fields setting, or if no customer fields
462 setting is supplied, the <B>cust-fields</B> configuration value.
469 warn "FS::UI::Web::cust_fields called for $record ".
470 "(cust_fields: @cust_fields)"
473 #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
474 # #override incase we were passed as a sub
476 my $seen_unlinked = 0;
479 if ( $record->custnum ) {
480 warn " $record -> $_" if $DEBUG > 1;
481 encode_entities( $record->$_(@_) );
483 warn " ($record unlinked)" if $DEBUG > 1;
484 $seen_unlinked++ ? '' : '(unlinked)';
489 =item cust_fields_subs
491 Returns an array of subroutine references for returning customer field values.
492 This is similar to cust_fields, but returns each field's sub as a distinct
497 sub cust_fields_subs {
498 my $unlinked_warn = 0;
502 if ( $unlinked_warn++ ) {
506 if ( $record->custnum ) {
507 encode_entities( $record->$f(@_) );
517 $record->custnum ? encode_entities( $record->$f(@_) ) : '';
527 Returns an array of subroutine references (or empty strings) for returning
528 customer information colors.
530 As with L<the cust_header subroutine|/cust_header>, the fields returned are
531 defined by the supplied customer fields setting, or if no customer fields
532 setting is supplied, the <B>cust-fields</B> configuration value.
540 sub { shift->$method(@_) };
549 Returns an array of customer information styles.
551 As with L<the cust_header subroutine|/cust_header>, the fields returned are
552 defined by the supplied customer fields setting, or if no customer fields
553 setting is supplied, the <B>cust-fields</B> configuration value.
569 Returns an array or scalar (depending on context) of customer information
572 As with L<the cust_header subroutine|/cust_header>, the fields returned are
573 defined by the supplied customer fields setting, or if no customer fields
574 setting is supplied, the <B>cust-fields</B> configuration value.
582 join('', @cust_aligns);
588 Returns an array of links to view/cust_main.cgi, for use with cust_fields.
593 my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ];
595 return map { $_ eq 'cust_status_label' ? '' : $link }
601 Utility function to determine if the client is a mobile browser.
606 my $ua = $ENV{'HTTP_USER_AGENT'} || '';
607 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 ) {
613 =item random_id [ DIGITS ]
615 Returns a random number of length DIGITS, or if unspecified, a long random
616 identifier consisting of the timestamp, process ID, and a random number.
617 Anything in the UI that needs a random identifier should use this.
623 if (!defined $NO_RANDOM_IDS) {
624 my $conf = FS::Conf->new;
625 $NO_RANDOM_IDS = $conf->exists('no_random_ids') ? 1 : 0;
626 warn "TEST MODE--RANDOM ID NUMBERS DISABLED\n" if $NO_RANDOM_IDS;
628 if ( $NO_RANDOM_IDS ) {
632 return '0000000000-0000-000000000.000000';
636 return int(rand(10 ** $digits));
638 return time . "-$$-" . rand() * 2**32;
648 # begin JSRPC code...
651 package FS::UI::Web::JSRPC;
656 use Storable qw(nfreeze);
658 use Cpanel::JSON::XS;
660 use FS::Record qw(qsearchs);
662 use FS::CGI qw(rooturl);
676 croak "CGI object required as second argument" unless $self->{'cgi'};
685 my $cgi = $self->{'cgi'};
687 # XXX this should parse JSON foo and build a proper data structure
688 my @args = $cgi->param('arg');
690 #work around konqueror bug!
691 @args = map { s/\x00$//; $_; } @args;
693 my $sub = $cgi->param('sub'); #????
695 warn "FS::UI::Web::JSRPC::process:\n".
698 " args=".join(', ',@args)."\n"
701 if ( $sub eq 'start_job' ) {
703 $self->start_job(@args);
705 } elsif ( $sub eq 'job_status' ) {
707 $self->job_status(@args);
711 die "unknown sub $sub";
720 warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
724 my( $field, $value ) = splice(@_, 0, 2);
725 unless ( exists( $param{$field} ) ) {
726 $param{$field} = $value;
727 } elsif ( ! ref($param{$field}) ) {
728 $param{$field} = [ $param{$field}, $value ];
730 push @{$param{$field}}, $value;
733 $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
734 $param{RootURL} = rooturl($self->{cgi}->self_url);
735 warn "FS::UI::Web::start_job\n".
737 if ( ref($param{$_}) ) {
738 " $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
740 " $_ => $param{$_}\n";
745 #first get the CGI params shipped off to a job ASAP so an id can be returned
748 my $job = new FS::queue { 'job' => $self->{'job'} };
750 #too slow to insert all the cgi params as individual args..,?
751 #my $error = $queue->insert('_JOB', $cgi->Vars);
753 #rely on FS::queue smartness to freeze/encode the param hash
755 my $error = $job->insert( '_JOB', \%param );
759 warn "job not inserted: $error\n"
762 $error; #this doesn't seem to be handled well,
763 # will trigger "illegal jobnum" below?
764 # (should never be an error inserting the job, though, only thing
765 # would be Pg f%*kage)
768 warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
777 my( $self, $jobnum ) = @_; #$url ???
779 sleep 1; # XXX could use something better...
782 if ( $jobnum =~ /^(\d+)$/ ) {
783 $job = qsearchs('queue', { 'jobnum' => $jobnum } );
785 die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
789 if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
790 my ($progress, $action) = split ',', $job->statustext, 2;
791 $action ||= 'Server processing job';
792 @return = ( 'progress', $progress, $action );
793 } elsif ( !$job ) { #handle job gone case : job successful
794 # so close popup, redirect parent window...
795 @return = ( 'complete' );
796 } elsif ( $job->status eq 'done' ) {
797 @return = ( 'done', $job->statustext, '' );
799 @return = ( 'error', $job ? $job->statustext : $jobnum );
802 encode_json \@return;