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',
277 $header2method{'Cust#'} = 'display_custnum'
278 if $conf->exists('cust_main-default_agent_custid');
280 my %header2colormethod = (
281 'Cust. Status' => 'cust_statuscolor',
284 'Cust. Status' => 'b',
287 'Cust. Status' => 'c',
295 warn " using supplied cust-fields override".
296 " (ignoring cust-fields config file)"
298 $cust_fields = shift;
302 if ( $conf->exists('cust-fields')
303 && $conf->config('cust-fields') =~ /^([\w\. \|\#\(\)]+):?/
306 warn " found cust-fields configuration value"
310 warn " no cust-fields configuration value found; using default 'Cust. Status | Customer'"
312 $cust_fields = 'Cust. Status | Customer';
317 @cust_header = split(/ \| /, $cust_fields);
318 @cust_fields = map { $header2method{$_} || $_ } @cust_header;
319 @cust_colors = map { exists $header2colormethod{$_}
320 ? $header2colormethod{$_}
324 @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' }
326 @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' }
333 sub cust_sort_fields {
334 cust_header(@_) if( @_ or !@cust_fields );
335 #inefficientish, but tiny lists and only run once per page
337 map { $_ eq 'custnum' ? 'custnum' : '' } @cust_fields;
341 =item cust_sql_fields [ CUST_FIELDS_VALUE ]
343 Returns a list of fields for the SELECT portion of an SQL query.
345 As with L<the cust_header subroutine|/cust_header>, the fields returned are
346 defined by the supplied customer fields setting, or if no customer fields
347 setting is supplied, the <B>cust-fields</B> configuration value.
351 sub cust_sql_fields {
353 my @fields = qw( last first company );
354 # push @fields, map "ship_$_", @fields;
356 cust_header(@_) if( @_ or !@cust_fields );
357 #inefficientish, but tiny lists and only run once per page
360 foreach my $field (qw( address1 address2 city state zip latitude longitude )) {
361 foreach my $pre ('bill_','ship_') {
362 if ( grep { $_ eq $pre.$field } @cust_fields ) {
363 push @location_fields, $pre.'location.'.$field.' AS '.$pre.$field;
367 foreach my $pre ('bill_','ship_') {
368 if ( grep { $_ eq $pre.'country_full' } @cust_fields ) {
369 push @location_fields, $pre.'locationnum';
373 foreach my $field (qw(daytime night mobile fax payby)) {
374 push @fields, $field if (grep { $_ eq $field } @cust_fields);
376 push @fields, 'agent_custid';
378 my @extra_fields = ();
379 if (grep { $_ eq 'current_balance' } @cust_fields) {
380 push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
383 map("cust_main.$_", @fields), @location_fields, @extra_fields;
386 =item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ]
388 Returns an SQL join phrase for the FROM clause so that the fields listed
389 in L<cust_sql_fields> will be available. Currently joins to cust_main
390 itself, as well as cust_location (under the aliases 'bill_location' and
391 'ship_location') if address fields are needed. L<cust_header()> should have
394 All of these will be left joins; if you want to exclude rows with no linked
395 cust_main record (or bill_location/ship_location), you can do so in the
398 TABLE is the table containing the custnum field. If CUSTNUM (a field name
399 in that table) is specified, that field will be joined to cust_main.custnum.
400 Otherwise, this function will assume the field is named "custnum". If the
401 argument isn't present at all, the join will just say "USING (custnum)",
404 As a special case, if TABLE is 'cust_main', only the joins to cust_location
407 LOCATION_TABLE is an optional table name to use for joining ship_location,
408 in case your query also includes package information and you want the
409 "service address" columns to reflect package addresses.
414 my ($cust_table, $location_table) = @_;
415 my ($custnum, $locationnum);
416 ($cust_table, $custnum) = split(/\./, $cust_table);
417 $custnum ||= 'custnum';
418 ($location_table, $locationnum) = split(/\./, $location_table);
419 $locationnum ||= 'locationnum';
423 $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)"
424 unless $cust_table eq 'cust_main';
426 $sql = " LEFT JOIN cust_main USING (custnum)";
429 if ( !@cust_fields or grep /^bill_/, @cust_fields ) {
431 $sql .= ' LEFT JOIN cust_location bill_location'.
432 ' ON (bill_location.locationnum = cust_main.bill_locationnum)';
436 if ( !@cust_fields or grep /^ship_/, @cust_fields ) {
438 if (!$location_table) {
439 $location_table = 'cust_main';
440 $locationnum = 'ship_locationnum';
443 $sql .= ' LEFT JOIN cust_location ship_location'.
444 " ON (ship_location.locationnum = $location_table.$locationnum) ";
450 =item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
452 Given an object that contains fields from cust_main (say, from a
453 JOINed search. See httemplate/search/svc_* for examples), returns an array
454 of customer information, or "(unlinked)" if this service is not linked to a
457 As with L<the cust_header subroutine|/cust_header>, the fields returned are
458 defined by the supplied customer fields setting, or if no customer fields
459 setting is supplied, the <B>cust-fields</B> configuration value.
466 warn "FS::UI::Web::cust_fields called for $record ".
467 "(cust_fields: @cust_fields)"
470 #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
471 # #override incase we were passed as a sub
473 my $seen_unlinked = 0;
476 if ( $record->custnum ) {
477 warn " $record -> $_" if $DEBUG > 1;
478 encode_entities( $record->$_(@_) );
480 warn " ($record unlinked)" if $DEBUG > 1;
481 $seen_unlinked++ ? '' : '(unlinked)';
486 =item cust_fields_subs
488 Returns an array of subroutine references for returning customer field values.
489 This is similar to cust_fields, but returns each field's sub as a distinct
494 sub cust_fields_subs {
495 my $unlinked_warn = 0;
499 if ( $unlinked_warn++ ) {
503 if ( $record->custnum ) {
504 encode_entities( $record->$f(@_) );
514 $record->custnum ? encode_entities( $record->$f(@_) ) : '';
524 Returns an array of subroutine references (or empty strings) for returning
525 customer information colors.
527 As with L<the cust_header subroutine|/cust_header>, the fields returned are
528 defined by the supplied customer fields setting, or if no customer fields
529 setting is supplied, the <B>cust-fields</B> configuration value.
537 sub { shift->$method(@_) };
546 Returns an array of customer information styles.
548 As with L<the cust_header subroutine|/cust_header>, the fields returned are
549 defined by the supplied customer fields setting, or if no customer fields
550 setting is supplied, the <B>cust-fields</B> configuration value.
566 Returns an array or scalar (depending on context) of customer information
569 As with L<the cust_header subroutine|/cust_header>, the fields returned are
570 defined by the supplied customer fields setting, or if no customer fields
571 setting is supplied, the <B>cust-fields</B> configuration value.
579 join('', @cust_aligns);
585 Returns an array of links to view/cust_main.cgi, for use with cust_fields.
590 my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ];
592 return map { $_ eq 'cust_status_label' ? '' : $link }
598 Utility function to determine if the client is a mobile browser.
603 my $ua = $ENV{'HTTP_USER_AGENT'} || '';
604 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 # begin JSRPC code...
618 package FS::UI::Web::JSRPC;
623 use Storable qw(nfreeze);
627 use FS::Record qw(qsearchs);
629 use FS::CGI qw(rooturl);
643 croak "CGI object required as second argument" unless $self->{'cgi'};
652 my $cgi = $self->{'cgi'};
654 # XXX this should parse JSON foo and build a proper data structure
655 my @args = $cgi->param('arg');
657 #work around konqueror bug!
658 @args = map { s/\x00$//; $_; } @args;
660 my $sub = $cgi->param('sub'); #????
662 warn "FS::UI::Web::JSRPC::process:\n".
665 " args=".join(', ',@args)."\n"
668 if ( $sub eq 'start_job' ) {
670 $self->start_job(@args);
672 } elsif ( $sub eq 'job_status' ) {
674 $self->job_status(@args);
678 die "unknown sub $sub";
687 warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
691 my( $field, $value ) = splice(@_, 0, 2);
692 unless ( exists( $param{$field} ) ) {
693 $param{$field} = $value;
694 } elsif ( ! ref($param{$field}) ) {
695 $param{$field} = [ $param{$field}, $value ];
697 push @{$param{$field}}, $value;
700 $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
701 $param{RootURL} = rooturl($self->{cgi}->self_url);
702 warn "FS::UI::Web::start_job\n".
704 if ( ref($param{$_}) ) {
705 " $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
707 " $_ => $param{$_}\n";
712 #first get the CGI params shipped off to a job ASAP so an id can be returned
715 my $job = new FS::queue { 'job' => $self->{'job'} };
717 #too slow to insert all the cgi params as individual args..,?
718 #my $error = $queue->insert('_JOB', $cgi->Vars);
720 #rely on FS::queue smartness to freeze/encode the param hash
722 my $error = $job->insert( '_JOB', \%param );
726 warn "job not inserted: $error\n"
729 $error; #this doesn't seem to be handled well,
730 # will trigger "illegal jobnum" below?
731 # (should never be an error inserting the job, though, only thing
732 # would be Pg f%*kage)
735 warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
744 my( $self, $jobnum ) = @_; #$url ???
746 sleep 1; # XXX could use something better...
749 if ( $jobnum =~ /^(\d+)$/ ) {
750 $job = qsearchs('queue', { 'jobnum' => $jobnum } );
752 die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
756 if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
757 my ($progress, $action) = split ',', $job->statustext, 2;
758 $action ||= 'Server processing job';
759 @return = ( 'progress', $progress, $action );
760 } elsif ( !$job ) { #handle job gone case : job successful
761 # so close popup, redirect parent window...
762 @return = ( 'complete' );
763 } elsif ( $job->status eq 'done' ) {
764 @return = ( 'done', $job->statustext, '' );
766 @return = ( 'error', $job ? $job->statustext : $jobnum );
769 encode_json \@return;