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 ( qsearch({table=>'phone_type', order_by=>'weight'}) ) {
 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
 379   my %header2colormethod = (
 380     'Cust. Status' => 'cust_statuscolor',
 381   );
 382   my %header2style = (
 383     'Cust. Status' => 'b',
 384   );
 385   my %header2align = (
 386     'Cust. Status' => 'c',
 387     'Cust#'        => 'r',
 388   );
 389
 390   my $cust_fields;
 391   my @cust_header;
 392   if ( @_ && $_[0] ) {
 393
 394     warn "  using supplied cust-fields override".
 395           " (ignoring cust-fields config file)"
 396       if $DEBUG;
 397     $cust_fields = shift;
 398
 399   } else {
 400
 401     if (    $conf->exists('cust-fields')
 402          && $conf->config('cust-fields') =~ /^([\w\. \|\#\(\)]+):?/
 403        )
 404     {
 405       warn "  found cust-fields configuration value"
 406         if $DEBUG;
 407       $cust_fields = $1;
 408     } else {
 409       warn "  no cust-fields configuration value found; using default 'Cust. Status | Customer'"
 410         if $DEBUG;
 411       $cust_fields = 'Cust. Status | Customer';
 412     }
 413
 414   }
 415
 416   @cust_header = split(/ \| /, $cust_fields);
 417   @cust_fields = map { $header2method{$_} || $_ } @cust_header;
 418   @cust_colors = map { exists $header2colormethod{$_}
 419                          ? $header2colormethod{$_}
 420                          : ''
 421                      }
 422                      @cust_header;
 423   @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' }
 424                      @cust_header;
 425   @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' }
 426                      @cust_header;
 427
 428   #my $svc_x = shift;
 429   @cust_header;
 430 }
 431
 432 sub cust_sort_fields {
 433   cust_header(@_) if( @_ or !@cust_fields );
 434   #inefficientish, but tiny lists and only run once per page
 435
 436   my @sort_fields;
 437   foreach (@cust_fields) {
 438     if ($_ eq "custnum") { push @sort_fields, 'custnum'; }
 439     elsif ($_ eq "contact" || $_ eq "name") { push @sort_fields, '(last, first)'; }
 440     elsif ($_ eq "company") { push @sort_fields, 'company'; }
 441     else { push @sort_fields, ''; }
 442   }
 443   return @sort_fields;
 444
 445 }
 446
 447 =item cust_sql_fields [ CUST_FIELDS_VALUE ]
 448
 449 Returns a list of fields for the SELECT portion of an SQL query.
 450
 451 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 452 defined by the supplied customer fields setting, or if no customer fields
 453 setting is supplied, the <B>cust-fields</B> configuration value.
 454
 455 =cut
 456
 457 sub cust_sql_fields {
 458
 459   my @fields = qw( last first company );
 460 #  push @fields, map "ship_$_", @fields;
 461
 462   cust_header(@_) if( @_ or !@cust_fields );
 463   #inefficientish, but tiny lists and only run once per page
 464
 465   my @location_fields;
 466   foreach my $field (qw( address1 address2 city state zip latitude longitude )) {
 467     foreach my $pre ('bill_','ship_') {
 468       if ( grep { $_ eq $pre.$field } @cust_fields ) {
 469         push @location_fields, $pre.'location.'.$field.' AS '.$pre.$field;
 470       }
 471     }
 472   }
 473   foreach my $pre ('bill_','ship_') {
 474     if ( grep { $_ eq $pre.'country_full' } @cust_fields ) {
 475       push @location_fields, $pre.'locationnum';
 476     }
 477   }
 478
 479   foreach my $field (qw(daytime night mobile fax )) {
 480     push @fields, $field if (grep { $_ eq $field } @cust_fields);
 481   }
 482   push @fields, 'agent_custid';
 483
 484   push @fields, 'agentnum' if grep { $_ eq 'agent_name' } @cust_fields;
 485
 486   my @extra_fields = ();
 487   if (grep { $_ eq 'current_balance' } @cust_fields) {
 488     push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
 489   }
 490
 491   push @extra_fields, 'part_referral_x.referral AS referral'
 492     if grep { $_ eq 'referral' } @cust_fields;
 493
 494   map("cust_main.$_", @fields), @location_fields, @extra_fields;
 495 }
 496
 497 =item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ]
 498
 499 Returns an SQL join phrase for the FROM clause so that the fields listed
 500 in L</cust_sql_fields> will be available.  Currently joins to cust_main
 501 itself, as well as cust_location (under the aliases 'bill_location' and
 502 'ship_location') if address fields are needed.  L</cust_header> should have
 503 been called already.
 504
 505 All of these will be left joins; if you want to exclude rows with no linked
 506 cust_main record (or bill_location/ship_location), you can do so in the
 507 WHERE clause.
 508
 509 TABLE is the table containing the custnum field.  If CUSTNUM (a field name
 510 in that table) is specified, that field will be joined to cust_main.custnum.
 511 Otherwise, this function will assume the field is named "custnum".  If the
 512 argument isn't present at all, the join will just say "USING (custnum)",
 513 which might work.
 514
 515 As a special case, if TABLE is 'cust_main', only the joins to cust_location
 516 will be returned.
 517
 518 LOCATION_TABLE is an optional table name to use for joining ship_location,
 519 in case your query also includes package information and you want the
 520 "service address" columns to reflect package addresses.
 521
 522 =cut
 523
 524 sub join_cust_main {
 525   my ($cust_table, $location_table) = @_;
 526   my ($custnum, $locationnum);
 527   ($cust_table, $custnum) = split(/\./, $cust_table);
 528   $custnum ||= 'custnum';
 529   ($location_table, $locationnum) = split(/\./, $location_table);
 530   $locationnum ||= 'locationnum';
 531
 532   my $sql = '';
 533   if ( $cust_table ) {
 534     $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)"
 535       unless $cust_table eq 'cust_main';
 536   } else {
 537     $sql = " LEFT JOIN cust_main USING (custnum)";
 538   }
 539
 540   if ( !@cust_fields or grep /^bill_/, @cust_fields ) {
 541
 542     $sql .= ' LEFT JOIN cust_location bill_location'.
 543             ' ON (bill_location.locationnum = cust_main.bill_locationnum)';
 544
 545   }
 546
 547   if ( !@cust_fields or grep /^ship_/, @cust_fields ) {
 548
 549     if (!$location_table) {
 550       $location_table = 'cust_main';
 551       $locationnum = 'ship_locationnum';
 552     }
 553
 554     $sql .= ' LEFT JOIN cust_location ship_location'.
 555             " ON (ship_location.locationnum = $location_table.$locationnum) ";
 556   }
 557
 558   if ( !@cust_fields or grep { $_ eq 'referral' } @cust_fields ) {
 559     $sql .= ' LEFT JOIN (select refnum, referral from part_referral) AS part_referral_x ON (cust_main.refnum = part_referral_x.refnum) ';
 560   }
 561
 562   $sql;
 563 }
 564
 565 =item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
 566
 567 Given an object that contains fields from cust_main (say, from a
 568 JOINed search.  See httemplate/search/svc_* for examples), returns an array
 569 of customer information, or "(unlinked)" if this service is not linked to a
 570 customer.
 571
 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.
 575
 576 =cut
 577
 578
 579 sub cust_fields {
 580   my $record = shift;
 581   warn "FS::UI::Web::cust_fields called for $record ".
 582        "(cust_fields: @cust_fields)"
 583     if $DEBUG > 1;
 584
 585   #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
 586   #                                     #override incase we were passed as a sub
 587
 588   my $seen_unlinked = 0;
 589
 590   map {
 591     if ( $record->custnum ) {
 592       warn "  $record -> $_" if $DEBUG > 1;
 593       encode_entities( $record->$_(@_) );
 594     } else {
 595       warn "  ($record unlinked)" if $DEBUG > 1;
 596       $seen_unlinked++ ? '' : '(unlinked)';
 597     }
 598   } @cust_fields;
 599 }
 600
 601 =item cust_fields_subs
 602
 603 Returns an array of subroutine references for returning customer field values.
 604 This is similar to cust_fields, but returns each field's sub as a distinct
 605 element.
 606
 607 =cut
 608
 609 sub cust_fields_subs {
 610   my $unlinked_warn = 0;
 611
 612   return map {
 613     my $f = $_;
 614     if ( $unlinked_warn++ ) {
 615
 616       sub {
 617         my $record = shift;
 618         if ( $record->custnum ) {
 619           encode_entities( $record->$f(@_) );
 620         } else {
 621           '(unlinked)'
 622         };
 623       };
 624
 625     } else {
 626
 627       sub {
 628         my $record = shift;
 629         $record->custnum ? encode_entities( $record->$f(@_) ) : '';
 630       };
 631
 632     }
 633
 634   } @cust_fields;
 635 }
 636
 637 =item cust_colors
 638
 639 Returns an array of subroutine references (or empty strings) for returning
 640 customer information colors.
 641
 642 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 643 defined by the supplied customer fields setting, or if no customer fields
 644 setting is supplied, the <B>cust-fields</B> configuration value.
 645
 646 =cut
 647
 648 sub cust_colors {
 649   map {
 650     my $method = $_;
 651     if ( $method ) {
 652       sub { shift->$method(@_) };
 653     } else {
 654       '';
 655     }
 656   } @cust_colors;
 657 }
 658
 659 =item cust_styles
 660
 661 Returns an array of customer information styles.
 662
 663 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 664 defined by the supplied customer fields setting, or if no customer fields
 665 setting is supplied, the <B>cust-fields</B> configuration value.
 666
 667 =cut
 668
 669 sub cust_styles {
 670   map {
 671     if ( $_ ) {
 672       $_;
 673     } else {
 674       '';
 675     }
 676   } @cust_styles;
 677 }
 678
 679 =item cust_aligns
 680
 681 Returns an array or scalar (depending on context) of customer information
 682 alignments.
 683
 684 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 685 defined by the supplied customer fields setting, or if no customer fields
 686 setting is supplied, the <B>cust-fields</B> configuration value.
 687
 688 =cut
 689
 690 sub cust_aligns {
 691   if ( wantarray ) {
 692     @cust_aligns;
 693   } else {
 694     join('', @cust_aligns);
 695   }
 696 }
 697
 698 =item cust_links
 699
 700 Returns an array of links to view/cust_main.cgi, for use with cust_fields.
 701
 702 =cut
 703
 704 sub cust_links {
 705   my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ];
 706
 707   return map { $_ eq 'cust_status_label' ? '' : $link }
 708     @cust_fields;
 709 }
 710
 711 =item is_mobile
 712
 713 Utility function to determine if the client is a mobile browser.
 714
 715 =cut
 716
 717 sub is_mobile {
 718   my $ua = $ENV{'HTTP_USER_AGENT'} || '';
 719   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 ) {
 720     return 1;
 721   }
 722   return 0;
 723 }
 724
 725 =item random_id [ DIGITS ]
 726
 727 Returns a random number of length DIGITS, or if unspecified, a long random
 728 identifier consisting of the timestamp, process ID, and a random number.
 729 Anything in the UI that needs a random identifier should use this.
 730
 731 =cut
 732
 733 sub random_id {
 734   my $digits = shift;
 735   if (!defined $NO_RANDOM_IDS) {
 736     my $conf = FS::Conf->new;
 737     $NO_RANDOM_IDS = $conf->exists('no_random_ids') ? 1 : 0;
 738     warn "TEST MODE--RANDOM ID NUMBERS DISABLED\n" if $NO_RANDOM_IDS;
 739   }
 740   if ( $NO_RANDOM_IDS ) {
 741     if ( $digits > 0 ) {
 742       return 0;
 743     } else {
 744       return '0000000000-0000-000000000.000000';
 745     }
 746   } else {
 747     if ($digits > 0) {
 748       return int(rand(10 ** $digits));
 749     } else {
 750       return time . "-$$-" . rand() * 2**32;
 751     }
 752   }
 753 }
 754
 755 =back
 756
 757 =cut
 758
 759 ###
 760 # begin JSRPC code...
 761 ###
 762
 763 package FS::UI::Web::JSRPC;
 764
 765 use strict;
 766 use vars qw($DEBUG);
 767 use Carp;
 768 use Storable qw(nfreeze);
 769 use MIME::Base64;
 770 use Cpanel::JSON::XS;
 771 use FS::CurrentUser;
 772 use FS::Record qw(qsearchs);
 773 use FS::queue;
 774 use FS::CGI qw(rooturl);
 775 use FS::Report::Queued::FutureAutobill;
 776
 777 $DEBUG = 0;
 778
 779 sub new {
 780         my $class = shift;
 781         my $self  = {
 782                 env => {},
 783                 job => shift,
 784                 cgi => shift,
 785         };
 786
 787         bless $self, $class;
 788
 789         croak "CGI object required as second argument" unless $self->{'cgi'};
 790
 791         return $self;
 792 }
 793
 794 sub process {
 795
 796   my $self = shift;
 797
 798   my $cgi = $self->{'cgi'};
 799
 800   # XXX this should parse JSON foo and build a proper data structure
 801   my @args = $cgi->param('arg');
 802
 803   #work around konqueror bug!
 804   @args = map { s/\x00$//; $_; } @args;
 805
 806   my $sub = $cgi->param('sub'); #????
 807
 808   warn "FS::UI::Web::JSRPC::process:\n".
 809        "  cgi=$cgi\n".
 810        "  sub=$sub\n".
 811        "  args=".join(', ',@args)."\n"
 812     if $DEBUG;
 813
 814   if ( $sub eq 'start_job' ) {
 815
 816     $self->start_job(@args);
 817
 818   } elsif ( $sub eq 'job_status' ) {
 819
 820     $self->job_status(@args);
 821
 822   } else {
 823
 824     die "unknown sub $sub";
 825
 826   }
 827
 828 }
 829
 830 sub start_job {
 831   my $self = shift;
 832
 833   warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
 834 #  my %param = @_;
 835   my %param = ();
 836   while ( @_ ) {
 837     my( $field, $value ) = splice(@_, 0, 2);
 838     unless ( exists( $param{$field} ) ) {
 839       $param{$field} = $value;
 840     } elsif ( ! ref($param{$field}) ) {
 841       $param{$field} = [ $param{$field}, $value ];
 842     } else {
 843       push @{$param{$field}}, $value;
 844     }
 845   }
 846   $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
 847   $param{RootURL} = rooturl($self->{cgi}->self_url);
 848   warn "FS::UI::Web::start_job\n".
 849        join('', map {
 850                       if ( ref($param{$_}) ) {
 851                         "  $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
 852                       } else {
 853                         "  $_ => $param{$_}\n";
 854                       }
 855                     } keys %param )
 856     if $DEBUG;
 857
 858   #first get the CGI params shipped off to a job ASAP so an id can be returned
 859   #to the caller
 860
 861   my $job = new FS::queue { 'job' => $self->{'job'} };
 862
 863   #too slow to insert all the cgi params as individual args..,?
 864   #my $error = $queue->insert('_JOB', $cgi->Vars);
 865
 866   #rely on FS::queue smartness to freeze/encode the param hash
 867
 868   my $error = $job->insert( '_JOB', \%param );
 869
 870   if ( $error ) {
 871
 872     warn "job not inserted: $error\n"
 873       if $DEBUG;
 874
 875     $error;  #this doesn't seem to be handled well,
 876              # will trigger "illegal jobnum" below?
 877              # (should never be an error inserting the job, though, only thing
 878              #  would be Pg f%*kage)
 879   } else {
 880
 881     warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
 882       if $DEBUG;
 883
 884     $job->jobnum;
 885   }
 886
 887 }
 888
 889 sub job_status {
 890   my( $self, $jobnum ) = @_; #$url ???
 891
 892   sleep 1; # XXX could use something better...
 893
 894   my $job;
 895   if ( $jobnum =~ /^(\d+)$/ ) {
 896     $job = qsearchs('queue', { 'jobnum' => $jobnum } );
 897   } else {
 898     die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
 899   }
 900
 901   my @return;
 902   if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
 903     my ($progress, $action) = split ',', $job->statustext, 2;
 904     $action ||= 'Server processing job';
 905     @return = ( 'progress', $progress, $action );
 906   } elsif ( !$job ) { #handle job gone case : job successful
 907                       # so close popup, redirect parent window...
 908     @return = ( 'complete' );
 909   } elsif ( $job->status eq 'done' ) {
 910     @return = ( 'done', $job->statustext, '' );
 911   } else {
 912     @return = ( 'error', $job ? $job->statustext : $jobnum );
 913   }
 914
 915   encode_json \@return;
 916
 917 }
 918
 919 1;
 920