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 );
21 $me = '[FS::UID::Web]';
28 sub parse_beginning_ending {
29 my($cgi, $prefix) = @_;
30 $prefix .= '_' if $prefix;
33 if ( $cgi->param($prefix.'begin') =~ /^(\d+)$/ ) {
35 } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
36 $beginning = parse_datetime($1) || 0;
39 my $ending = 4294967295; #2^32-1
40 if ( $cgi->param($prefix.'end') =~ /^(\d+)$/ ) {
42 } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
43 $ending = parse_datetime($1);
44 $ending = day_end($ending) unless $ending =~ /:/;
47 ( $beginning, $ending );
52 Returns a service URL, first checking to see if there is a service-specific
53 page to link to, otherwise to a generic service handling page. Options are
54 passed as a list of name-value pairs, and include:
58 =item * m - Mason request object ($m)
60 =item * action - The action for which to construct "edit", "view", or "search"
62 =item ** part_svc - Service definition (see L<FS::part_svc>)
64 =item ** svcdb - Service table
66 =item *** query - Query string
68 =item *** svc - FS::cust_svc or FS::svc_* object
70 =item ahref - Optional flag, if set true returns <A HREF="$url"> instead of just the URL.
76 ** part_svc OR svcdb is required
78 *** query OR svc is required
85 # 'm' => $m, #mason request object
86 # 'action' => 'edit', #or 'view'
88 # 'part_svc' => $part_svc, #usual
90 # 'svcdb' => 'svc_table',
92 # 'query' => #optional query string
93 # # (pass a blank string if you want a "raw" URL to add your
96 # 'svc' => $svc_x, #or $cust_svc, it just needs a svcnum
101 # 'ahref' => 1, # if set true, returns <A HREF="$url">
103 use FS::CGI qw(rooturl);
107 #? return '' unless ref($opt{part_svc});
109 my $svcdb = $opt{svcdb} || $opt{part_svc}->svcdb;
110 my $query = exists($opt{query}) ? $opt{query} : $opt{svc}->svcnum;
112 warn "$me [svc_url] checking for /$opt{action}/$svcdb.cgi component"
114 if ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.cgi") ) {
115 $url = "$svcdb.cgi?";
116 } elsif ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.html") ) {
117 $url = "$svcdb.html?";
119 my $generic = $opt{action} eq 'search' ? 'cust_svc' : 'svc_Common';
121 $url = "$generic.html?svcdb=$svcdb;";
122 $url .= 'svcnum=' if $query =~ /^\d+(;|$)/ or $query eq '';
125 my $return = FS::CGI::rooturl(). "$opt{action}/$url$query";
127 $return = qq!<A HREF="$return">! if $opt{ahref};
133 my($m, $part_svc, $cust_svc) = @_ or return '';
134 svc_X_link( $part_svc->svc, @_ );
138 my($m, $part_svc, $cust_svc) = @_ or return '';
139 my($svc, $label, $svcdb) = $cust_svc->label;
140 svc_X_link( $label, @_ );
144 my ($x, $m, $part_svc, $cust_svc) = @_ or return '';
147 unless $FS::CurrentUser::CurrentUser->access_right('View customer services');
149 confess "svc_X_link called without a service ($x, $m, $part_svc, $cust_svc)\n"
156 'part_svc' => $part_svc,
163 #this probably needs an ACL too...
164 sub svc_export_links {
165 my ($m, $part_svc, $cust_svc) = @_ or return '';
167 my $ahref = $cust_svc->export_links;
173 my($cgi, $field) = (shift, shift);
174 my $table = ( @_ && length($_[0]) ) ? shift.'.' : '';
183 foreach my $op (keys %op) {
185 warn "checking for ${field}_$op field\n"
188 if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*(-?[\d\,\s]+(\.\d\d)?)\s*$/ ) {
191 $num =~ s/[\,\s]+//g;
192 my $search = "$table$field $op{$op} $num";
193 push @search, $search;
195 warn "found ${field}_$op field; adding search element $search\n"
206 # cust_main report subroutines
211 =item cust_header [ CUST_FIELDS_VALUE ]
213 Returns an array of customer information headers according to the supplied
214 customer fields value, or if no value is supplied, the B<cust-fields>
219 use vars qw( @cust_fields @cust_colors @cust_styles @cust_aligns );
223 warn "FS::UI:Web::cust_header called"
226 my $conf = new FS::Conf;
228 my %header2method = (
229 'Customer' => 'name',
230 'Cust. Status' => 'cust_status_label',
231 'Cust#' => 'custnum',
233 'Company' => 'company',
235 # obsolete but might still be referenced in configuration
236 '(bill) Customer' => 'name',
237 '(service) Customer' => 'ship_name',
238 '(bill) Name' => 'contact',
239 '(service) Name' => 'ship_contact',
240 '(bill) Company' => 'company',
241 '(service) Company' => 'ship_company',
242 '(bill) Day phone' => 'daytime',
243 '(bill) Night phone' => 'night',
244 '(bill) Fax number' => 'fax',
246 'Customer' => 'name',
247 'Address 1' => 'bill_address1',
248 'Address 2' => 'bill_address2',
249 'City' => 'bill_city',
250 'State' => 'bill_state',
252 'Country' => 'bill_country_full',
253 'Day phone' => 'daytime', # XXX should use msgcat, but how?
254 'Night phone' => 'night', # XXX should use msgcat, but how?
255 'Mobile phone' => 'mobile', # XXX should use msgcat, but how?
256 'Fax number' => 'fax',
257 '(bill) Address 1' => 'bill_address1',
258 '(bill) Address 2' => 'bill_address2',
259 '(bill) City' => 'bill_city',
260 '(bill) State' => 'bill_state',
261 '(bill) Zip' => 'bill_zip',
262 '(bill) Country' => 'bill_country_full',
263 '(bill) Latitude' => 'bill_latitude',
264 '(bill) Longitude' => 'bill_longitude',
265 '(service) Address 1' => 'ship_address1',
266 '(service) Address 2' => 'ship_address2',
267 '(service) City' => 'ship_city',
268 '(service) State' => 'ship_state',
269 '(service) Zip' => 'ship_zip',
270 '(service) Country' => 'ship_country_full',
271 '(service) Latitude' => 'ship_latitude',
272 '(service) Longitude' => 'ship_longitude',
273 'Invoicing email(s)' => 'invoicing_list_emailonly_scalar',
274 'Payment Type' => 'payby',
275 'Current Balance' => 'current_balance',
276 'Agent Cust#' => 'agent_custid',
278 $header2method{'Cust#'} = 'display_custnum'
279 if $conf->exists('cust_main-default_agent_custid');
281 my %header2colormethod = (
282 'Cust. Status' => 'cust_statuscolor',
285 'Cust. Status' => 'b',
288 'Cust. Status' => 'c',
296 warn " using supplied cust-fields override".
297 " (ignoring cust-fields config file)"
299 $cust_fields = shift;
303 if ( $conf->exists('cust-fields')
304 && $conf->config('cust-fields') =~ /^([\w\. \|\#\(\)]+):?/
307 warn " found cust-fields configuration value"
311 warn " no cust-fields configuration value found; using default 'Cust. Status | Customer'"
313 $cust_fields = 'Cust. Status | Customer';
318 @cust_header = split(/ \| /, $cust_fields);
319 @cust_fields = map { $header2method{$_} || $_ } @cust_header;
320 @cust_colors = map { exists $header2colormethod{$_}
321 ? $header2colormethod{$_}
325 @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' }
327 @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' }
334 sub cust_sort_fields {
335 cust_header(@_) if( @_ or !@cust_fields );
336 #inefficientish, but tiny lists and only run once per page
338 map { $_ eq 'custnum' ? 'custnum' : '' } @cust_fields;
342 =item cust_sql_fields [ CUST_FIELDS_VALUE ]
344 Returns a list of fields for the SELECT portion of an SQL query.
346 As with L<the cust_header subroutine|/cust_header>, the fields returned are
347 defined by the supplied customer fields setting, or if no customer fields
348 setting is supplied, the <B>cust-fields</B> configuration value.
352 sub cust_sql_fields {
354 my @fields = qw( last first company );
355 # push @fields, map "ship_$_", @fields;
357 cust_header(@_) if( @_ or !@cust_fields );
358 #inefficientish, but tiny lists and only run once per page
361 foreach my $field (qw( address1 address2 city state zip latitude longitude )) {
362 foreach my $pre ('bill_','ship_') {
363 if ( grep { $_ eq $pre.$field } @cust_fields ) {
364 push @location_fields, $pre.'location.'.$field.' AS '.$pre.$field;
368 foreach my $pre ('bill_','ship_') {
369 if ( grep { $_ eq $pre.'country_full' } @cust_fields ) {
370 push @location_fields, $pre.'locationnum';
374 foreach my $field (qw(daytime night mobile fax payby)) {
375 push @fields, $field if (grep { $_ eq $field } @cust_fields);
377 push @fields, 'agent_custid';
379 my @extra_fields = ();
380 if (grep { $_ eq 'current_balance' } @cust_fields) {
381 push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
384 map("cust_main.$_", @fields), @location_fields, @extra_fields;
387 =item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ]
389 Returns an SQL join phrase for the FROM clause so that the fields listed
390 in L<cust_sql_fields> will be available. Currently joins to cust_main
391 itself, as well as cust_location (under the aliases 'bill_location' and
392 'ship_location') if address fields are needed. L<cust_header()> should have
395 All of these will be left joins; if you want to exclude rows with no linked
396 cust_main record (or bill_location/ship_location), you can do so in the
399 TABLE is the table containing the custnum field. If CUSTNUM (a field name
400 in that table) is specified, that field will be joined to cust_main.custnum.
401 Otherwise, this function will assume the field is named "custnum". If the
402 argument isn't present at all, the join will just say "USING (custnum)",
405 As a special case, if TABLE is 'cust_main', only the joins to cust_location
408 LOCATION_TABLE is an optional table name to use for joining ship_location,
409 in case your query also includes package information and you want the
410 "service address" columns to reflect package addresses.
415 my ($cust_table, $location_table) = @_;
416 my ($custnum, $locationnum);
417 ($cust_table, $custnum) = split(/\./, $cust_table);
418 $custnum ||= 'custnum';
419 ($location_table, $locationnum) = split(/\./, $location_table);
420 $locationnum ||= 'locationnum';
424 $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)"
425 unless $cust_table eq 'cust_main';
427 $sql = " LEFT JOIN cust_main USING (custnum)";
430 if ( !@cust_fields or grep /^bill_/, @cust_fields ) {
432 $sql .= ' LEFT JOIN cust_location bill_location'.
433 ' ON (bill_location.locationnum = cust_main.bill_locationnum)';
437 if ( !@cust_fields or grep /^ship_/, @cust_fields ) {
439 if (!$location_table) {
440 $location_table = 'cust_main';
441 $locationnum = 'ship_locationnum';
444 $sql .= ' LEFT JOIN cust_location ship_location'.
445 " ON (ship_location.locationnum = $location_table.$locationnum) ";
451 =item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
453 Given an object that contains fields from cust_main (say, from a
454 JOINed search. See httemplate/search/svc_* for examples), returns an array
455 of customer information, or "(unlinked)" if this service is not linked to a
458 As with L<the cust_header subroutine|/cust_header>, the fields returned are
459 defined by the supplied customer fields setting, or if no customer fields
460 setting is supplied, the <B>cust-fields</B> configuration value.
467 warn "FS::UI::Web::cust_fields called for $record ".
468 "(cust_fields: @cust_fields)"
471 #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
472 # #override incase we were passed as a sub
474 my $seen_unlinked = 0;
477 if ( $record->custnum ) {
478 warn " $record -> $_" if $DEBUG > 1;
479 encode_entities( $record->$_(@_) );
481 warn " ($record unlinked)" if $DEBUG > 1;
482 $seen_unlinked++ ? '' : '(unlinked)';
487 =item cust_fields_subs
489 Returns an array of subroutine references for returning customer field values.
490 This is similar to cust_fields, but returns each field's sub as a distinct
495 sub cust_fields_subs {
496 my $unlinked_warn = 0;
500 if ( $unlinked_warn++ ) {
504 if ( $record->custnum ) {
505 encode_entities( $record->$f(@_) );
515 $record->custnum ? encode_entities( $record->$f(@_) ) : '';
525 Returns an array of subroutine references (or empty strings) for returning
526 customer information colors.
528 As with L<the cust_header subroutine|/cust_header>, the fields returned are
529 defined by the supplied customer fields setting, or if no customer fields
530 setting is supplied, the <B>cust-fields</B> configuration value.
538 sub { shift->$method(@_) };
547 Returns an array of customer information styles.
549 As with L<the cust_header subroutine|/cust_header>, the fields returned are
550 defined by the supplied customer fields setting, or if no customer fields
551 setting is supplied, the <B>cust-fields</B> configuration value.
567 Returns an array or scalar (depending on context) of customer information
570 As with L<the cust_header subroutine|/cust_header>, the fields returned are
571 defined by the supplied customer fields setting, or if no customer fields
572 setting is supplied, the <B>cust-fields</B> configuration value.
580 join('', @cust_aligns);
586 Returns an array of links to view/cust_main.cgi, for use with cust_fields.
591 my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ];
593 return map { $_ eq 'cust_status_label' ? '' : $link }
599 Utility function to determine if the client is a mobile browser.
604 my $ua = $ENV{'HTTP_USER_AGENT'} || '';
605 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 ) {
616 # begin JSRPC code...
619 package FS::UI::Web::JSRPC;
624 use Storable qw(nfreeze);
628 use FS::Record qw(qsearchs);
630 use FS::CGI qw(rooturl);
644 croak "CGI object required as second argument" unless $self->{'cgi'};
653 my $cgi = $self->{'cgi'};
655 # XXX this should parse JSON foo and build a proper data structure
656 my @args = $cgi->param('arg');
658 #work around konqueror bug!
659 @args = map { s/\x00$//; $_; } @args;
661 my $sub = $cgi->param('sub'); #????
663 warn "FS::UI::Web::JSRPC::process:\n".
666 " args=".join(', ',@args)."\n"
669 if ( $sub eq 'start_job' ) {
671 $self->start_job(@args);
673 } elsif ( $sub eq 'job_status' ) {
675 $self->job_status(@args);
679 die "unknown sub $sub";
688 warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
692 my( $field, $value ) = splice(@_, 0, 2);
693 unless ( exists( $param{$field} ) ) {
694 $param{$field} = $value;
695 } elsif ( ! ref($param{$field}) ) {
696 $param{$field} = [ $param{$field}, $value ];
698 push @{$param{$field}}, $value;
701 $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
702 $param{RootURL} = rooturl($self->{cgi}->self_url);
703 warn "FS::UI::Web::start_job\n".
705 if ( ref($param{$_}) ) {
706 " $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
708 " $_ => $param{$_}\n";
713 #first get the CGI params shipped off to a job ASAP so an id can be returned
716 my $job = new FS::queue { 'job' => $self->{'job'} };
718 #too slow to insert all the cgi params as individual args..,?
719 #my $error = $queue->insert('_JOB', $cgi->Vars);
721 #rely on FS::queue smartness to freeze/encode the param hash
723 my $error = $job->insert( '_JOB', \%param );
727 warn "job not inserted: $error\n"
730 $error; #this doesn't seem to be handled well,
731 # will trigger "illegal jobnum" below?
732 # (should never be an error inserting the job, though, only thing
733 # would be Pg f%*kage)
736 warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
745 my( $self, $jobnum ) = @_; #$url ???
747 sleep 1; # XXX could use something better...
750 if ( $jobnum =~ /^(\d+)$/ ) {
751 $job = qsearchs('queue', { 'jobnum' => $jobnum } );
753 die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
757 if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
758 my ($progress, $action) = split ',', $job->statustext, 2;
759 $action ||= 'Server processing job';
760 @return = ( 'progress', $progress, $action );
761 } elsif ( !$job ) { #handle job gone case : job successful
762 # so close popup, redirect parent window...
763 @return = ( 'complete' );
764 } elsif ( $job->status eq 'done' ) {
765 @return = ( 'done', $job->statustext, '' );
767 @return = ( 'error', $job ? $job->statustext : $jobnum );
770 encode_json \@return;