FS/FS/UI/Web.pm

   1 package FS::UI::Web;
   2
   3 use strict;
   4 use vars qw($DEBUG @ISA @EXPORT_OK $me);
   5 use Exporter;
   6 use Carp qw( confess );
   7 use HTML::Entities;
   8 use FS::Conf;
   9 use FS::Misc::DateTime qw( parse_datetime day_end );
  10 use FS::Record qw(dbdef qsearch);
  11 use FS::cust_main;  # are sql_balance and sql_date_balance in the right module?
  12
  13 #use vars qw(@ISA);
  14 #use FS::UI
  15 #@ISA = qw( FS::UI );
  16 @ISA = qw( Exporter );
  17
  18 @EXPORT_OK = qw( get_page_pref set_page_pref svc_url random_id );
  19
  20 $DEBUG = 0;
  21 $me = '[FS::UID::Web]';
  22
  23 our $NO_RANDOM_IDS;
  24
  25 ###
  26 # user prefs
  27 ###
  28
  29 =item get_page_pref NAME, TABLENUM
  30
  31 Returns the user's page preference named NAME for the current page. If the
  32 page is a view or edit page or otherwise shows a single record at a time,
  33 it should use TABLENUM to link the preference to that record.
  34
  35 =cut
  36
  37 sub get_page_pref {
  38   my ($prefname, $tablenum) = @_;
  39
  40   my $m = $HTML::Mason::Commands::m
  41     or die "can't get page pref when running outside the UI";
  42   # what's more useful: to tie prefs to the base_comp (usually where
  43   # code is executing right now), or to the request_comp (approximately the
  44   # one in the URL)? not sure.
  45   $FS::CurrentUser::CurrentUser->get_page_pref( $m->request_comp->path,
  46                                                 $prefname,
  47                                                 $tablenum
  48                                               );
  49 }
  50
  51 =item set_page_pref NAME, TABLENUM, VALUE
  52
  53 Sets the user's page preference named NAME for the current page. Use TABLENUM
  54 as for get_page_pref.
  55
  56 If VALUE is an empty string, the preference will be deleted (and
  57 C<get_page_pref> will return an empty string).
  58
  59   my $mypref = set_page_pref('mypref', '', 100);
  60
  61 =cut
  62
  63 sub set_page_pref {
  64   my ($prefname, $tablenum, $prefvalue) = @_;
  65
  66   my $m = $HTML::Mason::Commands::m
  67     or die "can't set page pref when running outside the UI";
  68   $FS::CurrentUser::CurrentUser->set_page_pref( $m->request_comp->path,
  69                                                 $prefname,
  70                                                 $tablenum,
  71                                                 $prefvalue );
  72 }
  73
  74 ###
  75 # date parsing
  76 ###
  77
  78 =item parse_beginning_ending CGI [, PREFIX ]
  79
  80 Parses a beginning/ending date range, as used on many reports. This function
  81 recognizes two sets of CGI params: "begin" and "end", the integer timestamp
  82 values, and "beginning" and "ending", the user-readable date fields.
  83
  84 If "begin" contains an integer, that's passed through as the beginning date.
  85 Otherwise, "beginning" is passed to L<DateTime::Format::Natural> and turned
  86 into an integer. If this fails or it doesn't have a value, zero is used as the
  87 beginning date.
  88
  89 The same happens for "end" and "ending", except that if "ending" contains a
  90 date without a time, it gets moved to the end of that day, and if there's no
  91 value, the value returned is the highest unsigned 32-bit time value (some time
  92 in 2037).
  93
  94 PREFIX is optionally a string to prepend (with '_' as a delimiter) to the form
  95 field names.
  96
  97 =cut
  98
  99 use Date::Parse;
 100 sub parse_beginning_ending {
 101   my($cgi, $prefix) = @_;
 102   $prefix .= '_' if $prefix;
 103
 104   my $beginning = 0;
 105   if ( $cgi->param($prefix.'begin') =~ /^(\d+)$/ ) {
 106     $beginning = $1;
 107   } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
 108     $beginning = parse_datetime($1) || 0;
 109   }
 110
 111   my $ending = 4294967295; #2^32-1
 112   if ( $cgi->param($prefix.'end') =~ /^(\d+)$/ ) {
 113     $ending = $1 - 1;
 114   } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
 115     $ending = parse_datetime($1);
 116     $ending = day_end($ending) unless $ending =~ /:/;
 117   }
 118
 119   ( $beginning, $ending );
 120 }
 121
 122 =item svc_url
 123
 124 Returns a service URL, first checking to see if there is a service-specific
 125 page to link to, otherwise to a generic service handling page.  Options are
 126 passed as a list of name-value pairs, and include:
 127
 128 =over 4
 129
 130 =item * m - Mason request object ($m)
 131
 132 =item * action - The action for which to construct "edit", "view", or "search"
 133
 134 =item ** part_svc - Service definition (see L<FS::part_svc>)
 135
 136 =item ** svcdb - Service table
 137
 138 =item *** query - Query string
 139
 140 =item *** svc   - FS::cust_svc or FS::svc_* object
 141
 142 =item ahref - Optional flag, if set true returns <A HREF="$url"> instead of just the URL.
 143
 144 =back
 145
 146 * Required fields
 147
 148 ** part_svc OR svcdb is required
 149
 150 *** query OR svc is required
 151
 152 =cut
 153
 154   # ##
 155   # #required
 156   # ##
 157   #  'm'        => $m, #mason request object
 158   #  'action'   => 'edit', #or 'view'
 159   #
 160   #  'part_svc' => $part_svc, #usual
 161   #   #OR
 162   #  'svcdb'    => 'svc_table',
 163   #
 164   #  'query'    => #optional query string
 165   #                # (pass a blank string if you want a "raw" URL to add your
 166   #                #  own svcnum to)
 167   #   #OR
 168   #  'svc'      => $svc_x, #or $cust_svc, it just needs a svcnum
 169   #
 170   # ##
 171   # #optional
 172   # ##
 173   #  'ahref'    => 1, # if set true, returns <A HREF="$url">
 174
 175 use FS::CGI qw(rooturl);
 176 sub svc_url {
 177   my %opt = @_;
 178
 179   #? return '' unless ref($opt{part_svc});
 180
 181   my $svcdb = $opt{svcdb} || $opt{part_svc}->svcdb;
 182   my $query = exists($opt{query}) ? $opt{query} : $opt{svc}->svcnum;
 183   my $url;
 184   warn "$me [svc_url] checking for /$opt{action}/$svcdb.cgi component"
 185     if $DEBUG;
 186   if ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.cgi") ) {
 187     $url = "$svcdb.cgi?";
 188   } elsif ( $opt{m}->interp->comp_exists("/$opt{action}/$svcdb.html") ) {
 189     $url = "$svcdb.html?";
 190   } else {
 191     my $generic = $opt{action} eq 'search' ? 'cust_svc' : 'svc_Common';
 192
 193     $url = "$generic.html?svcdb=$svcdb;";
 194     $url .= 'svcnum=' if $query =~ /^\d+(;|$)/ or $query eq '';
 195   }
 196
 197   my $return = FS::CGI::rooturl(). "$opt{action}/$url$query";
 198
 199   $return = qq!<A HREF="$return">! if $opt{ahref};
 200
 201   $return;
 202 }
 203
 204 sub svc_link {
 205   my($m, $part_svc, $cust_svc) = @_ or return '';
 206   svc_X_link( $part_svc->svc, @_ );
 207 }
 208
 209 sub svc_label_link {
 210   my($m, $part_svc, $cust_svc) = @_ or return '';
 211   my($svc, $label, $svcdb) = $cust_svc->label;
 212   svc_X_link( $label, @_ );
 213 }
 214
 215 sub svc_X_link {
 216   my ($x, $m, $part_svc, $cust_svc) = @_ or return '';
 217
 218   return $x
 219    unless $FS::CurrentUser::CurrentUser->access_right('View customer services');
 220
 221   confess "svc_X_link called without a service ($x, $m, $part_svc, $cust_svc)\n"
 222     unless $cust_svc;
 223
 224   my $ahref = svc_url(
 225     'ahref'    => 1,
 226     'm'        => $m,
 227     'action'   => 'view',
 228     'part_svc' => $part_svc,
 229     'svc'      => $cust_svc,
 230   );
 231
 232   "$ahref$x</A>";
 233 }
 234
 235 #this probably needs an ACL too...
 236 sub svc_export_links {
 237   my ($m, $part_svc, $cust_svc) = @_ or return '';
 238
 239   my $ahref = $cust_svc->export_links;
 240
 241   join('', @$ahref);
 242 }
 243
 244 sub parse_lt_gt {
 245   my($cgi, $field) = (shift, shift);
 246   my $table = ( @_ && length($_[0]) ) ? shift.'.' : '';
 247
 248   my @search = ();
 249
 250   my %op = (
 251     'lt' => '<',
 252     'gt' => '>',
 253   );
 254
 255   foreach my $op (keys %op) {
 256
 257     warn "checking for ${field}_$op field\n"
 258       if $DEBUG;
 259
 260     if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*(-?[\d\,\s]+(\.\d\d)?)\s*$/ ) {
 261
 262       my $num = $1;
 263       $num =~ s/[\,\s]+//g;
 264       my $search = "$table$field $op{$op} $num";
 265       push @search, $search;
 266
 267       warn "found ${field}_$op field; adding search element $search\n"
 268         if $DEBUG;
 269     }
 270
 271   }
 272
 273   @search;
 274
 275 }
 276
 277 ###
 278 # cust_main report subroutines
 279 ###
 280
 281 =over 4
 282
 283 =item cust_header [ CUST_FIELDS_VALUE ]
 284
 285 Returns an array of customer information headers according to the supplied
 286 customer fields value, or if no value is supplied, the B<cust-fields>
 287 configuration value.
 288
 289 =cut
 290
 291 use vars qw( @cust_fields @cust_colors @cust_styles @cust_aligns );
 292
 293 sub cust_header {
 294
 295   warn "FS::UI:Web::cust_header called"
 296     if $DEBUG;
 297
 298   my $conf = new FS::Conf;
 299
 300   my %header2method = (
 301     'Customer'                 => 'name',
 302     'Cust. Status'             => 'cust_status_label',
 303     'Cust#'                    => 'display_custnum',
 304     'Name'                     => 'contact',
 305     'Company'                  => 'company',
 306
 307     # obsolete but might still be referenced in configuration
 308     '(bill) Customer'          => 'name',
 309     '(service) Customer'       => 'ship_name',
 310     '(bill) Name'              => 'contact',
 311     '(service) Name'           => 'ship_contact',
 312     '(bill) Company'           => 'company',
 313     '(service) Company'        => 'ship_company',
 314     '(bill) Day phone'         => 'daytime',
 315     '(bill) Night phone'       => 'night',
 316     '(bill) Fax number'        => 'fax',
 317
 318     'Customer'                 => 'name',
 319     'Address 1'                => 'bill_address1',
 320     'Address 2'                => 'bill_address2',
 321     'City'                     => 'bill_city',
 322     'State'                    => 'bill_state',
 323     'Zip'                      => 'bill_zip',
 324     'Country'                  => 'bill_country_full',
 325     'Day phone'                => 'daytime', # XXX should use msgcat, but how?
 326     'Night phone'              => 'night',   # XXX should use msgcat, but how?
 327     'Mobile phone'             => 'mobile',  # XXX should use msgcat, but how?
 328     'Fax number'               => 'fax',
 329     '(bill) Address 1'         => 'bill_address1',
 330     '(bill) Address 2'         => 'bill_address2',
 331     '(bill) City'              => 'bill_city',
 332     '(bill) State'             => 'bill_state',
 333     '(bill) Zip'               => 'bill_zip',
 334     '(bill) Country'           => 'bill_country_full',
 335     '(bill) Latitude'          => 'bill_latitude',
 336     '(bill) Longitude'         => 'bill_longitude',
 337     '(service) Address 1'      => 'ship_address1',
 338     '(service) Address 2'      => 'ship_address2',
 339     '(service) City'           => 'ship_city',
 340     '(service) State'          => 'ship_state',
 341     '(service) Zip'            => 'ship_zip',
 342     '(service) Country'        => 'ship_country_full',
 343     '(service) Latitude'       => 'ship_latitude',
 344     '(service) Longitude'      => 'ship_longitude',
 345     'Invoicing email(s)'       => 'invoicing_list_emailonly_scalar',
 346     'Contact email(s)'         => 'contact_list_emailonly',
 347     'Invoices'                 => 'contact_list_cust_invoice_only',
 348     'Messages'                 => 'contact_list_cust_message_only',
 349 # FS::Upgrade::upgrade_config removes this from existing cust-fields settings
 350 #    'Payment Type'             => 'cust_payby',
 351     'Current Balance'          => 'current_balance',
 352     'Agent Cust#'              => 'agent_custid',
 353     'Agent'                    => 'agent_name',
 354     'Agent Cust# or Cust#'     => 'display_custnum',
 355     'Advertising Source'       => 'referral',
 356   );
 357   $header2method{'Cust#'} = 'display_custnum'
 358     if $conf->exists('cust_main-default_agent_custid');
 359
 360 foreach my $phone_type ( FS::phone_type->get_phone_types() ) {
 361   $header2method{'Contact '.$phone_type->typename.' phone(s)'} = sub {
 362     my $self = shift;
 363     my $num = $phone_type->phonetypenum;
 364
 365     my @phones;
 366     foreach ($self->contact_list_name_phones) {
 367       my $data = [
 368         {
 369           'data'  => $_->first.' '.$_->last.' '.FS::contact_phone::phonenum_pretty($_),
 370         },
 371       ];
 372       push @phones, $data if $_->phonetypenum eq $phone_type->phonetypenum;
 373     }
 374   return \@phones;
 375   };
 376 }
 377
 378   my %header2colormethod = (
 379     'Cust. Status' => 'cust_statuscolor',
 380   );
 381   my %header2style = (
 382     'Cust. Status' => 'b',
 383   );
 384   my %header2align = (
 385     'Cust. Status' => 'c',
 386     'Cust#'        => 'r',
 387   );
 388
 389   my $cust_fields;
 390   my @cust_header;
 391   if ( @_ && $_[0] ) {
 392
 393     warn "  using supplied cust-fields override".
 394           " (ignoring cust-fields config file)"
 395       if $DEBUG;
 396     $cust_fields = shift;
 397
 398   } else {
 399
 400     if (    $conf->exists('cust-fields')
 401          && $conf->config('cust-fields') =~ /^([\w\. \|\#\(\)]+):?/
 402        )
 403     {
 404       warn "  found cust-fields configuration value"
 405         if $DEBUG;
 406       $cust_fields = $1;
 407     } else {
 408       warn "  no cust-fields configuration value found; using default 'Cust. Status | Customer'"
 409         if $DEBUG;
 410       $cust_fields = 'Cust. Status | Customer';
 411     }
 412
 413   }
 414
 415   @cust_header = split(/ \| /, $cust_fields);
 416   @cust_fields = map { $header2method{$_} || $_ } @cust_header;
 417   @cust_colors = map { exists $header2colormethod{$_}
 418                          ? $header2colormethod{$_}
 419                          : ''
 420                      }
 421                      @cust_header;
 422   @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' }
 423                      @cust_header;
 424   @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' }
 425                      @cust_header;
 426
 427   #my $svc_x = shift;
 428   @cust_header;
 429 }
 430
 431 sub cust_sort_fields {
 432   cust_header(@_) if( @_ or !@cust_fields );
 433   #inefficientish, but tiny lists and only run once per page
 434
 435   my @sort_fields;
 436   foreach (@cust_fields) {
 437     if ($_ eq "custnum") { push @sort_fields, 'custnum'; }
 438     elsif ($_ eq "contact" || $_ eq "name") { push @sort_fields, '(last, first)'; }
 439     elsif ($_ eq "company") { push @sort_fields, 'company'; }
 440     else { push @sort_fields, ''; }
 441   }
 442   return @sort_fields;
 443
 444 }
 445
 446 =item cust_sql_fields [ CUST_FIELDS_VALUE ]
 447
 448 Returns a list of fields for the SELECT portion of an SQL query.
 449
 450 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 451 defined by the supplied customer fields setting, or if no customer fields
 452 setting is supplied, the <B>cust-fields</B> configuration value.
 453
 454 =cut
 455
 456 sub cust_sql_fields {
 457
 458   my @fields = qw( last first company );
 459 #  push @fields, map "ship_$_", @fields;
 460
 461   cust_header(@_) if( @_ or !@cust_fields );
 462   #inefficientish, but tiny lists and only run once per page
 463
 464   my @location_fields;
 465   foreach my $field (qw( address1 address2 city state zip latitude longitude )) {
 466     foreach my $pre ('bill_','ship_') {
 467       if ( grep { $_ eq $pre.$field } @cust_fields ) {
 468         push @location_fields, $pre.'location.'.$field.' AS '.$pre.$field;
 469       }
 470     }
 471   }
 472   foreach my $pre ('bill_','ship_') {
 473     if ( grep { $_ eq $pre.'country_full' } @cust_fields ) {
 474       push @location_fields, $pre.'locationnum';
 475     }
 476   }
 477
 478   foreach my $field (qw(daytime night mobile fax)) {
 479     push @fields, $field if (grep { $_ eq $field } @cust_fields);
 480   }
 481   push @fields, 'agent_custid';
 482
 483   push @fields, 'agentnum' if grep { $_ eq 'agent_name' } @cust_fields;
 484
 485   my @extra_fields = ();
 486   if (grep { $_ eq 'current_balance' } @cust_fields) {
 487     push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
 488   }
 489
 490   push @extra_fields, 'part_referral_x.referral AS referral'
 491     if grep { $_ eq 'referral' } @cust_fields;
 492
 493   map("cust_main.$_", @fields), @location_fields, @extra_fields;
 494 }
 495
 496 =item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ]
 497
 498 Returns an SQL join phrase for the FROM clause so that the fields listed
 499 in L</cust_sql_fields> will be available.  Currently joins to cust_main
 500 itself, as well as cust_location (under the aliases 'bill_location' and
 501 'ship_location') if address fields are needed.  L</cust_header> should have
 502 been called already.
 503
 504 All of these will be left joins; if you want to exclude rows with no linked
 505 cust_main record (or bill_location/ship_location), you can do so in the
 506 WHERE clause.
 507
 508 TABLE is the table containing the custnum field.  If CUSTNUM (a field name
 509 in that table) is specified, that field will be joined to cust_main.custnum.
 510 Otherwise, this function will assume the field is named "custnum".  If the
 511 argument isn't present at all, the join will just say "USING (custnum)",
 512 which might work.
 513
 514 As a special case, if TABLE is 'cust_main', only the joins to cust_location
 515 will be returned.
 516
 517 LOCATION_TABLE is an optional table name to use for joining ship_location,
 518 in case your query also includes package information and you want the
 519 "service address" columns to reflect package addresses.
 520
 521 =cut
 522
 523 sub join_cust_main {
 524   my ($cust_table, $location_table) = @_;
 525   my ($custnum, $locationnum);
 526   ($cust_table, $custnum) = split(/\./, $cust_table);
 527   $custnum ||= 'custnum';
 528   ($location_table, $locationnum) = split(/\./, $location_table);
 529   $locationnum ||= 'locationnum';
 530
 531   my $sql = '';
 532   if ( $cust_table ) {
 533     $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)"
 534       unless $cust_table eq 'cust_main';
 535   } else {
 536     $sql = " LEFT JOIN cust_main USING (custnum)";
 537   }
 538
 539   if ( !@cust_fields or grep /^bill_/, @cust_fields ) {
 540
 541     $sql .= ' LEFT JOIN cust_location bill_location'.
 542             ' ON (bill_location.locationnum = cust_main.bill_locationnum)';
 543
 544   }
 545
 546   if ( !@cust_fields or grep /^ship_/, @cust_fields ) {
 547
 548     if (!$location_table) {
 549       $location_table = 'cust_main';
 550       $locationnum = 'ship_locationnum';
 551     }
 552
 553     $sql .= ' LEFT JOIN cust_location ship_location'.
 554             " ON (ship_location.locationnum = $location_table.$locationnum) ";
 555   }
 556
 557   if ( !@cust_fields or grep { $_ eq 'referral' } @cust_fields ) {
 558     $sql .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
 559   }
 560
 561   $sql;
 562 }
 563
 564 =item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
 565
 566 Given an object that contains fields from cust_main (say, from a
 567 JOINed search.  See httemplate/search/svc_* for examples), returns an array
 568 of customer information, or "(unlinked)" if this service is not linked to a
 569 customer.
 570
 571 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 572 defined by the supplied customer fields setting, or if no customer fields
 573 setting is supplied, the <B>cust-fields</B> configuration value.
 574
 575 =cut
 576
 577
 578 sub cust_fields {
 579   my $record = shift;
 580   warn "FS::UI::Web::cust_fields called for $record ".
 581        "(cust_fields: @cust_fields)"
 582     if $DEBUG > 1;
 583
 584   #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
 585   #                                     #override incase we were passed as a sub
 586
 587   my $seen_unlinked = 0;
 588
 589   map {
 590     if ( $record->custnum ) {
 591       warn "  $record -> $_" if $DEBUG > 1;
 592       encode_entities( $record->$_(@_) );
 593     } else {
 594       warn "  ($record unlinked)" if $DEBUG > 1;
 595       $seen_unlinked++ ? '' : '(unlinked)';
 596     }
 597   } @cust_fields;
 598 }
 599
 600 =item cust_fields_subs
 601
 602 Returns an array of subroutine references for returning customer field values.
 603 This is similar to cust_fields, but returns each field's sub as a distinct
 604 element.
 605
 606 =cut
 607
 608 sub cust_fields_subs {
 609   my $unlinked_warn = 0;
 610
 611   return map {
 612     my $f = $_;
 613     if ( $unlinked_warn++ ) {
 614
 615       sub {
 616         my $record = shift;
 617         if ( $record->custnum ) {
 618           encode_entities( $record->$f(@_) );
 619         } else {
 620           '(unlinked)'
 621         };
 622       };
 623
 624     } else {
 625
 626       sub {
 627         my $record = shift;
 628         $record->custnum ? encode_entities( $record->$f(@_) ) : '';
 629       };
 630
 631     }
 632
 633   } @cust_fields;
 634 }
 635
 636 =item cust_colors
 637
 638 Returns an array of subroutine references (or empty strings) for returning
 639 customer information colors.
 640
 641 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 642 defined by the supplied customer fields setting, or if no customer fields
 643 setting is supplied, the <B>cust-fields</B> configuration value.
 644
 645 =cut
 646
 647 sub cust_colors {
 648   map {
 649     my $method = $_;
 650     if ( $method ) {
 651       sub { shift->$method(@_) };
 652     } else {
 653       '';
 654     }
 655   } @cust_colors;
 656 }
 657
 658 =item cust_styles
 659
 660 Returns an array of customer information styles.
 661
 662 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 663 defined by the supplied customer fields setting, or if no customer fields
 664 setting is supplied, the <B>cust-fields</B> configuration value.
 665
 666 =cut
 667
 668 sub cust_styles {
 669   map {
 670     if ( $_ ) {
 671       $_;
 672     } else {
 673       '';
 674     }
 675   } @cust_styles;
 676 }
 677
 678 =item cust_aligns
 679
 680 Returns an array or scalar (depending on context) of customer information
 681 alignments.
 682
 683 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 684 defined by the supplied customer fields setting, or if no customer fields
 685 setting is supplied, the <B>cust-fields</B> configuration value.
 686
 687 =cut
 688
 689 sub cust_aligns {
 690   if ( wantarray ) {
 691     @cust_aligns;
 692   } else {
 693     join('', @cust_aligns);
 694   }
 695 }
 696
 697 =item cust_links
 698
 699 Returns an array of links to view/cust_main.cgi, for use with cust_fields.
 700
 701 =cut
 702
 703 sub cust_links {
 704   my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ];
 705
 706   return map { $_ eq 'cust_status_label' ? '' : $link }
 707     @cust_fields;
 708 }
 709
 710 =item is_mobile
 711
 712 Utility function to determine if the client is a mobile browser.
 713
 714 =cut
 715
 716 sub is_mobile {
 717   my $ua = $ENV{'HTTP_USER_AGENT'} || '';
 718   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 ) {
 719     return 1;
 720   }
 721   return 0;
 722 }
 723
 724 =item random_id [ DIGITS ]
 725
 726 Returns a random number of length DIGITS, or if unspecified, a long random
 727 identifier consisting of the timestamp, process ID, and a random number.
 728 Anything in the UI that needs a random identifier should use this.
 729
 730 =cut
 731
 732 sub random_id {
 733   my $digits = shift;
 734   if (!defined $NO_RANDOM_IDS) {
 735     my $conf = FS::Conf->new;
 736     $NO_RANDOM_IDS = $conf->exists('no_random_ids') ? 1 : 0;
 737     warn "TEST MODE--RANDOM ID NUMBERS DISABLED\n" if $NO_RANDOM_IDS;
 738   }
 739   if ( $NO_RANDOM_IDS ) {
 740     if ( $digits > 0 ) {
 741       return 0;
 742     } else {
 743       return '0000000000-0000-000000000.000000';
 744     }
 745   } else {
 746     if ($digits > 0) {
 747       return int(rand(10 ** $digits));
 748     } else {
 749       return time . "-$$-" . rand() * 2**32;
 750     }
 751   }
 752 }
 753
 754 =back
 755
 756 =cut
 757
 758 ###
 759 # begin JSRPC code...
 760 ###
 761
 762 package FS::UI::Web::JSRPC;
 763
 764 use strict;
 765 use vars qw($DEBUG);
 766 use Carp;
 767 use Storable qw(nfreeze);
 768 use MIME::Base64;
 769 use Cpanel::JSON::XS;
 770 use FS::CurrentUser;
 771 use FS::Record qw(qsearchs);
 772 use FS::queue;
 773 use FS::CGI qw(rooturl);
 774 use FS::Report::Queued::FutureAutobill;
 775
 776 $DEBUG = 0;
 777
 778 sub new {
 779         my $class = shift;
 780         my $self  = {
 781                 env => {},
 782                 job => shift,
 783                 cgi => shift,
 784         };
 785
 786         bless $self, $class;
 787
 788         croak "CGI object required as second argument" unless $self->{'cgi'};
 789
 790         return $self;
 791 }
 792
 793 sub process {
 794
 795   my $self = shift;
 796
 797   my $cgi = $self->{'cgi'};
 798
 799   # XXX this should parse JSON foo and build a proper data structure
 800   my @args = $cgi->param('arg');
 801
 802   #work around konqueror bug!
 803   @args = map { s/\x00$//; $_; } @args;
 804
 805   my $sub = $cgi->param('sub'); #????
 806
 807   warn "FS::UI::Web::JSRPC::process:\n".
 808        "  cgi=$cgi\n".
 809        "  sub=$sub\n".
 810        "  args=".join(', ',@args)."\n"
 811     if $DEBUG;
 812
 813   if ( $sub eq 'start_job' ) {
 814
 815     $self->start_job(@args);
 816
 817   } elsif ( $sub eq 'job_status' ) {
 818
 819     $self->job_status(@args);
 820
 821   } else {
 822
 823     die "unknown sub $sub";
 824
 825   }
 826
 827 }
 828
 829 sub start_job {
 830   my $self = shift;
 831
 832   warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
 833 #  my %param = @_;
 834   my %param = ();
 835   while ( @_ ) {
 836     my( $field, $value ) = splice(@_, 0, 2);
 837     unless ( exists( $param{$field} ) ) {
 838       $param{$field} = $value;
 839     } elsif ( ! ref($param{$field}) ) {
 840       $param{$field} = [ $param{$field}, $value ];
 841     } else {
 842       push @{$param{$field}}, $value;
 843     }
 844   }
 845   $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
 846   $param{RootURL} = rooturl($self->{cgi}->self_url);
 847   warn "FS::UI::Web::start_job\n".
 848        join('', map {
 849                       if ( ref($param{$_}) ) {
 850                         "  $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
 851                       } else {
 852                         "  $_ => $param{$_}\n";
 853                       }
 854                     } keys %param )
 855     if $DEBUG;
 856
 857   #first get the CGI params shipped off to a job ASAP so an id can be returned
 858   #to the caller
 859
 860   my $job = new FS::queue { 'job' => $self->{'job'} };
 861
 862   #too slow to insert all the cgi params as individual args..,?
 863   #my $error = $queue->insert('_JOB', $cgi->Vars);
 864
 865   #rely on FS::queue smartness to freeze/encode the param hash
 866
 867   my $error = $job->insert( '_JOB', \%param );
 868
 869   if ( $error ) {
 870
 871     warn "job not inserted: $error\n"
 872       if $DEBUG;
 873
 874     $error;  #this doesn't seem to be handled well,
 875              # will trigger "illegal jobnum" below?
 876              # (should never be an error inserting the job, though, only thing
 877              #  would be Pg f%*kage)
 878   } else {
 879
 880     warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
 881       if $DEBUG;
 882
 883     $job->jobnum;
 884   }
 885
 886 }
 887
 888 sub job_status {
 889   my( $self, $jobnum ) = @_; #$url ???
 890
 891   sleep 1; # XXX could use something better...
 892
 893   my $job;
 894   if ( $jobnum =~ /^(\d+)$/ ) {
 895     $job = qsearchs('queue', { 'jobnum' => $jobnum } );
 896   } else {
 897     die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
 898   }
 899
 900   my @return;
 901   if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
 902     my ($progress, $action) = split ',', $job->statustext, 2;
 903     $action ||= 'Server processing job';
 904     @return = ( 'progress', $progress, $action );
 905   } elsif ( !$job ) { #handle job gone case : job successful
 906                       # so close popup, redirect parent window...
 907     @return = ( 'complete' );
 908   } elsif ( $job->status eq 'done' ) {
 909     @return = ( 'done', $job->statustext, '' );
 910   } else {
 911     @return = ( 'error', $job ? $job->statustext : $jobnum );
 912   }
 913
 914   encode_json \@return;
 915
 916 }
 917
 918 1;
 919