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);
  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( svc_url random_id );
  19
  20 $DEBUG = 0;
  21 $me = '[FS::UID::Web]';
  22
  23 our $NO_RANDOM_IDS;
  24
  25 ###
  26 # date parsing
  27 ###
  28
  29 use Date::Parse;
  30 sub parse_beginning_ending {
  31   my($cgi, $prefix) = @_;
  32   $prefix .= '_' if $prefix;
  33
  34   my $beginning = 0;
  35   if ( $cgi->param($prefix.'begin') =~ /^(\d+)$/ ) {
  36     $beginning = $1;
  37   } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
  38     $beginning = parse_datetime($1) || 0;
  39   }
  40
  41   my $ending = 4294967295; #2^32-1
  42   if ( $cgi->param($prefix.'end') =~ /^(\d+)$/ ) {
  43     $ending = $1 - 1;
  44   } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/\:]{1,64})$/ ) {
  45     $ending = parse_datetime($1);
  46     $ending = day_end($ending) unless $ending =~ /:/;
  47   }
  48
  49   ( $beginning, $ending );
  50 }
  51
  52 =item svc_url
  53
  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:
  57
  58 =over 4
  59
  60 =item * m - Mason request object ($m)
  61
  62 =item * action - The action for which to construct "edit", "view", or "search"
  63
  64 =item ** part_svc - Service definition (see L<FS::part_svc>)
  65
  66 =item ** svcdb - Service table
  67
  68 =item *** query - Query string
  69
  70 =item *** svc   - FS::cust_svc or FS::svc_* object
  71
  72 =item ahref - Optional flag, if set true returns <A HREF="$url"> instead of just the URL.
  73
  74 =back
  75
  76 * Required fields
  77
  78 ** part_svc OR svcdb is required
  79
  80 *** query OR svc is required
  81
  82 =cut
  83
  84   # ##
  85   # #required
  86   # ##
  87   #  'm'        => $m, #mason request object
  88   #  'action'   => 'edit', #or 'view'
  89   #
  90   #  'part_svc' => $part_svc, #usual
  91   #   #OR
  92   #  'svcdb'    => 'svc_table',
  93   #
  94   #  'query'    => #optional query string
  95   #                # (pass a blank string if you want a "raw" URL to add your
  96   #                #  own svcnum to)
  97   #   #OR
  98   #  'svc'      => $svc_x, #or $cust_svc, it just needs a svcnum
  99   #
 100   # ##
 101   # #optional
 102   # ##
 103   #  'ahref'    => 1, # if set true, returns <A HREF="$url">
 104
 105 use FS::CGI qw(rooturl);
 106 sub svc_url {
 107   my %opt = @_;
 108
 109   #? return '' unless ref($opt{part_svc});
 110
 111   my $svcdb = $opt{svcdb} || $opt{part_svc}->svcdb;
 112   my $query = exists($opt{query}) ? $opt{query} : $opt{svc}->svcnum;
 113   my $url;
 114   warn "$me [svc_url] checking for /$opt{action}/$svcdb.cgi component"
 115     if $DEBUG;
 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?";
 120   } else {
 121     my $generic = $opt{action} eq 'search' ? 'cust_svc' : 'svc_Common';
 122
 123     $url = "$generic.html?svcdb=$svcdb;";
 124     $url .= 'svcnum=' if $query =~ /^\d+(;|$)/ or $query eq '';
 125   }
 126
 127   my $return = FS::CGI::rooturl(). "$opt{action}/$url$query";
 128
 129   $return = qq!<A HREF="$return">! if $opt{ahref};
 130
 131   $return;
 132 }
 133
 134 sub svc_link {
 135   my($m, $part_svc, $cust_svc) = @_ or return '';
 136   svc_X_link( $part_svc->svc, @_ );
 137 }
 138
 139 sub svc_label_link {
 140   my($m, $part_svc, $cust_svc) = @_ or return '';
 141   my($svc, $label, $svcdb) = $cust_svc->label;
 142   svc_X_link( $label, @_ );
 143 }
 144
 145 sub svc_X_link {
 146   my ($x, $m, $part_svc, $cust_svc) = @_ or return '';
 147
 148   return $x
 149    unless $FS::CurrentUser::CurrentUser->access_right('View customer services');
 150
 151   confess "svc_X_link called without a service ($x, $m, $part_svc, $cust_svc)\n"
 152     unless $cust_svc;
 153
 154   my $ahref = svc_url(
 155     'ahref'    => 1,
 156     'm'        => $m,
 157     'action'   => 'view',
 158     'part_svc' => $part_svc,
 159     'svc'      => $cust_svc,
 160   );
 161
 162   "$ahref$x</A>";
 163 }
 164
 165 #this probably needs an ACL too...
 166 sub svc_export_links {
 167   my ($m, $part_svc, $cust_svc) = @_ or return '';
 168
 169   my $ahref = $cust_svc->export_links;
 170
 171   join('', @$ahref);
 172 }
 173
 174 sub parse_lt_gt {
 175   my($cgi, $field) = (shift, shift);
 176   my $table = ( @_ && length($_[0]) ) ? shift.'.' : '';
 177
 178   my @search = ();
 179
 180   my %op = (
 181     'lt' => '<',
 182     'gt' => '>',
 183   );
 184
 185   foreach my $op (keys %op) {
 186
 187     warn "checking for ${field}_$op field\n"
 188       if $DEBUG;
 189
 190     if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*(-?[\d\,\s]+(\.\d\d)?)\s*$/ ) {
 191
 192       my $num = $1;
 193       $num =~ s/[\,\s]+//g;
 194       my $search = "$table$field $op{$op} $num";
 195       push @search, $search;
 196
 197       warn "found ${field}_$op field; adding search element $search\n"
 198         if $DEBUG;
 199     }
 200
 201   }
 202
 203   @search;
 204
 205 }
 206
 207 ###
 208 # cust_main report subroutines
 209 ###
 210
 211 =over 4
 212
 213 =item cust_header [ CUST_FIELDS_VALUE ]
 214
 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>
 217 configuration value.
 218
 219 =cut
 220
 221 use vars qw( @cust_fields @cust_colors @cust_styles @cust_aligns );
 222
 223 sub cust_header {
 224
 225   warn "FS::UI:Web::cust_header called"
 226     if $DEBUG;
 227
 228   my $conf = new FS::Conf;
 229
 230   my %header2method = (
 231     'Customer'                 => 'name',
 232     'Cust. Status'             => 'cust_status_label',
 233     'Cust#'                    => 'custnum',
 234     'Name'                     => 'contact',
 235     'Company'                  => 'company',
 236
 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',
 247
 248     'Customer'                 => 'name',
 249     'Address 1'                => 'bill_address1',
 250     'Address 2'                => 'bill_address2',
 251     'City'                     => 'bill_city',
 252     'State'                    => 'bill_state',
 253     'Zip'                      => 'bill_zip',
 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'             => 'cust_payby',
 277     'Current Balance'          => 'current_balance',
 278     'Agent Cust#'              => 'agent_custid',
 279   );
 280   $header2method{'Cust#'} = 'display_custnum'
 281     if $conf->exists('cust_main-default_agent_custid');
 282
 283   my %header2colormethod = (
 284     'Cust. Status' => 'cust_statuscolor',
 285   );
 286   my %header2style = (
 287     'Cust. Status' => 'b',
 288   );
 289   my %header2align = (
 290     'Cust. Status' => 'c',
 291     'Cust#'        => 'r',
 292   );
 293
 294   my $cust_fields;
 295   my @cust_header;
 296   if ( @_ && $_[0] ) {
 297
 298     warn "  using supplied cust-fields override".
 299           " (ignoring cust-fields config file)"
 300       if $DEBUG;
 301     $cust_fields = shift;
 302
 303   } else {
 304
 305     if (    $conf->exists('cust-fields')
 306          && $conf->config('cust-fields') =~ /^([\w\. \|\#\(\)]+):?/
 307        )
 308     {
 309       warn "  found cust-fields configuration value"
 310         if $DEBUG;
 311       $cust_fields = $1;
 312     } else {
 313       warn "  no cust-fields configuration value found; using default 'Cust. Status | Customer'"
 314         if $DEBUG;
 315       $cust_fields = 'Cust. Status | Customer';
 316     }
 317
 318   }
 319
 320   @cust_header = split(/ \| /, $cust_fields);
 321   @cust_fields = map { $header2method{$_} || $_ } @cust_header;
 322   @cust_colors = map { exists $header2colormethod{$_}
 323                          ? $header2colormethod{$_}
 324                          : ''
 325                      }
 326                      @cust_header;
 327   @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' }
 328                      @cust_header;
 329   @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' }
 330                      @cust_header;
 331
 332   #my $svc_x = shift;
 333   @cust_header;
 334 }
 335
 336 sub cust_sort_fields {
 337   cust_header(@_) if( @_ or !@cust_fields );
 338   #inefficientish, but tiny lists and only run once per page
 339
 340   map { $_ eq 'custnum' ? 'custnum' : '' } @cust_fields;
 341
 342 }
 343
 344 =item cust_sql_fields [ CUST_FIELDS_VALUE ]
 345
 346 Returns a list of fields for the SELECT portion of an SQL query.
 347
 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.
 351
 352 =cut
 353
 354 sub cust_sql_fields {
 355
 356   my @fields = qw( last first company );
 357 #  push @fields, map "ship_$_", @fields;
 358
 359   cust_header(@_) if( @_ or !@cust_fields );
 360   #inefficientish, but tiny lists and only run once per page
 361
 362   my @location_fields;
 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;
 367       }
 368     }
 369   }
 370   foreach my $pre ('bill_','ship_') {
 371     if ( grep { $_ eq $pre.'country_full' } @cust_fields ) {
 372       push @location_fields, $pre.'locationnum';
 373     }
 374   }
 375
 376   foreach my $field (qw(daytime night mobile fax )) {
 377     push @fields, $field if (grep { $_ eq $field } @cust_fields);
 378   }
 379   push @fields, "payby AS cust_payby"
 380     if grep { $_ eq 'cust_payby' } @cust_fields;
 381   push @fields, 'agent_custid';
 382
 383   my @extra_fields = ();
 384   if (grep { $_ eq 'current_balance' } @cust_fields) {
 385     push @extra_fields, FS::cust_main->balance_sql . " AS current_balance";
 386   }
 387
 388   map("cust_main.$_", @fields), @location_fields, @extra_fields;
 389 }
 390
 391 =item join_cust_main [ TABLE[.CUSTNUM] ] [ LOCATION_TABLE[.LOCATIONNUM] ]
 392
 393 Returns an SQL join phrase for the FROM clause so that the fields listed
 394 in L<cust_sql_fields> will be available.  Currently joins to cust_main
 395 itself, as well as cust_location (under the aliases 'bill_location' and
 396 'ship_location') if address fields are needed.  L<cust_header()> should have
 397 been called already.
 398
 399 All of these will be left joins; if you want to exclude rows with no linked
 400 cust_main record (or bill_location/ship_location), you can do so in the
 401 WHERE clause.
 402
 403 TABLE is the table containing the custnum field.  If CUSTNUM (a field name
 404 in that table) is specified, that field will be joined to cust_main.custnum.
 405 Otherwise, this function will assume the field is named "custnum".  If the
 406 argument isn't present at all, the join will just say "USING (custnum)",
 407 which might work.
 408
 409 As a special case, if TABLE is 'cust_main', only the joins to cust_location
 410 will be returned.
 411
 412 LOCATION_TABLE is an optional table name to use for joining ship_location,
 413 in case your query also includes package information and you want the
 414 "service address" columns to reflect package addresses.
 415
 416 =cut
 417
 418 sub join_cust_main {
 419   my ($cust_table, $location_table) = @_;
 420   my ($custnum, $locationnum);
 421   ($cust_table, $custnum) = split(/\./, $cust_table);
 422   $custnum ||= 'custnum';
 423   ($location_table, $locationnum) = split(/\./, $location_table);
 424   $locationnum ||= 'locationnum';
 425
 426   my $sql = '';
 427   if ( $cust_table ) {
 428     $sql = " LEFT JOIN cust_main ON (cust_main.custnum = $cust_table.$custnum)"
 429       unless $cust_table eq 'cust_main';
 430   } else {
 431     $sql = " LEFT JOIN cust_main USING (custnum)";
 432   }
 433
 434   if ( !@cust_fields or grep /^bill_/, @cust_fields ) {
 435
 436     $sql .= ' LEFT JOIN cust_location bill_location'.
 437             ' ON (bill_location.locationnum = cust_main.bill_locationnum)';
 438
 439   }
 440
 441   if ( !@cust_fields or grep /^ship_/, @cust_fields ) {
 442
 443     if (!$location_table) {
 444       $location_table = 'cust_main';
 445       $locationnum = 'ship_locationnum';
 446     }
 447
 448     $sql .= ' LEFT JOIN cust_location ship_location'.
 449             " ON (ship_location.locationnum = $location_table.$locationnum) ";
 450   }
 451
 452   $sql;
 453 }
 454
 455 =item cust_fields OBJECT [ CUST_FIELDS_VALUE ]
 456
 457 Given an object that contains fields from cust_main (say, from a
 458 JOINed search.  See httemplate/search/svc_* for examples), returns an array
 459 of customer information, or "(unlinked)" if this service is not linked to a
 460 customer.
 461
 462 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 463 defined by the supplied customer fields setting, or if no customer fields
 464 setting is supplied, the <B>cust-fields</B> configuration value.
 465
 466 =cut
 467
 468
 469 sub cust_fields {
 470   my $record = shift;
 471   warn "FS::UI::Web::cust_fields called for $record ".
 472        "(cust_fields: @cust_fields)"
 473     if $DEBUG > 1;
 474
 475   #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
 476   #                                     #override incase we were passed as a sub
 477
 478   my $seen_unlinked = 0;
 479
 480   map {
 481     if ( $record->custnum ) {
 482       warn "  $record -> $_" if $DEBUG > 1;
 483       encode_entities( $record->$_(@_) );
 484     } else {
 485       warn "  ($record unlinked)" if $DEBUG > 1;
 486       $seen_unlinked++ ? '' : '(unlinked)';
 487     }
 488   } @cust_fields;
 489 }
 490
 491 =item cust_fields_subs
 492
 493 Returns an array of subroutine references for returning customer field values.
 494 This is similar to cust_fields, but returns each field's sub as a distinct
 495 element.
 496
 497 =cut
 498
 499 sub cust_fields_subs {
 500   my $unlinked_warn = 0;
 501
 502   return map {
 503     my $f = $_;
 504     if ( $unlinked_warn++ ) {
 505
 506       sub {
 507         my $record = shift;
 508         if ( $record->custnum ) {
 509           encode_entities( $record->$f(@_) );
 510         } else {
 511           '(unlinked)'
 512         };
 513       };
 514
 515     } else {
 516
 517       sub {
 518         my $record = shift;
 519         $record->custnum ? encode_entities( $record->$f(@_) ) : '';
 520       };
 521
 522     }
 523
 524   } @cust_fields;
 525 }
 526
 527 =item cust_colors
 528
 529 Returns an array of subroutine references (or empty strings) for returning
 530 customer information colors.
 531
 532 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 533 defined by the supplied customer fields setting, or if no customer fields
 534 setting is supplied, the <B>cust-fields</B> configuration value.
 535
 536 =cut
 537
 538 sub cust_colors {
 539   map {
 540     my $method = $_;
 541     if ( $method ) {
 542       sub { shift->$method(@_) };
 543     } else {
 544       '';
 545     }
 546   } @cust_colors;
 547 }
 548
 549 =item cust_styles
 550
 551 Returns an array of customer information styles.
 552
 553 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 554 defined by the supplied customer fields setting, or if no customer fields
 555 setting is supplied, the <B>cust-fields</B> configuration value.
 556
 557 =cut
 558
 559 sub cust_styles {
 560   map {
 561     if ( $_ ) {
 562       $_;
 563     } else {
 564       '';
 565     }
 566   } @cust_styles;
 567 }
 568
 569 =item cust_aligns
 570
 571 Returns an array or scalar (depending on context) of customer information
 572 alignments.
 573
 574 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 575 defined by the supplied customer fields setting, or if no customer fields
 576 setting is supplied, the <B>cust-fields</B> configuration value.
 577
 578 =cut
 579
 580 sub cust_aligns {
 581   if ( wantarray ) {
 582     @cust_aligns;
 583   } else {
 584     join('', @cust_aligns);
 585   }
 586 }
 587
 588 =item cust_links
 589
 590 Returns an array of links to view/cust_main.cgi, for use with cust_fields.
 591
 592 =cut
 593
 594 sub cust_links {
 595   my $link = [ FS::CGI::rooturl().'view/cust_main.cgi?', 'custnum' ];
 596
 597   return map { $_ eq 'cust_status_label' ? '' : $link }
 598     @cust_fields;
 599 }
 600
 601 =item is_mobile
 602
 603 Utility function to determine if the client is a mobile browser.
 604
 605 =cut
 606
 607 sub is_mobile {
 608   my $ua = $ENV{'HTTP_USER_AGENT'} || '';
 609   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 ) {
 610     return 1;
 611   }
 612   return 0;
 613 }
 614
 615 =item random_id [ DIGITS ]
 616
 617 Returns a random number of length DIGITS, or if unspecified, a long random
 618 identifier consisting of the timestamp, process ID, and a random number.
 619 Anything in the UI that needs a random identifier should use this.
 620
 621 =cut
 622
 623 sub random_id {
 624   my $digits = shift;
 625   if (!defined $NO_RANDOM_IDS) {
 626     my $conf = FS::Conf->new;
 627     $NO_RANDOM_IDS = $conf->exists('no_random_ids') ? 1 : 0;
 628     warn "TEST MODE--RANDOM ID NUMBERS DISABLED\n" if $NO_RANDOM_IDS;
 629   }
 630   if ( $NO_RANDOM_IDS ) {
 631     if ( $digits > 0 ) {
 632       return 0;
 633     } else {
 634       return '0000000000-0000-000000000.000000';
 635     }
 636   } else {
 637     if ($digits > 0) {
 638       return int(rand(10 ** $digits));
 639     } else {
 640       return time . "-$$-" . rand() * 2**32;
 641     }
 642   }
 643 }
 644
 645 =back
 646
 647 =cut
 648
 649 ###
 650 # begin JSRPC code...
 651 ###
 652
 653 package FS::UI::Web::JSRPC;
 654
 655 use strict;
 656 use vars qw($DEBUG);
 657 use Carp;
 658 use Storable qw(nfreeze);
 659 use MIME::Base64;
 660 use Cpanel::JSON::XS;
 661 use FS::CurrentUser;
 662 use FS::Record qw(qsearchs);
 663 use FS::queue;
 664 use FS::CGI qw(rooturl);
 665
 666 $DEBUG = 0;
 667
 668 sub new {
 669         my $class = shift;
 670         my $self  = {
 671                 env => {},
 672                 job => shift,
 673                 cgi => shift,
 674         };
 675
 676         bless $self, $class;
 677
 678         croak "CGI object required as second argument" unless $self->{'cgi'};
 679
 680         return $self;
 681 }
 682
 683 sub process {
 684
 685   my $self = shift;
 686
 687   my $cgi = $self->{'cgi'};
 688
 689   # XXX this should parse JSON foo and build a proper data structure
 690   my @args = $cgi->param('arg');
 691
 692   #work around konqueror bug!
 693   @args = map { s/\x00$//; $_; } @args;
 694
 695   my $sub = $cgi->param('sub'); #????
 696
 697   warn "FS::UI::Web::JSRPC::process:\n".
 698        "  cgi=$cgi\n".
 699        "  sub=$sub\n".
 700        "  args=".join(', ',@args)."\n"
 701     if $DEBUG;
 702
 703   if ( $sub eq 'start_job' ) {
 704
 705     $self->start_job(@args);
 706
 707   } elsif ( $sub eq 'job_status' ) {
 708
 709     $self->job_status(@args);
 710
 711   } else {
 712
 713     die "unknown sub $sub";
 714
 715   }
 716
 717 }
 718
 719 sub start_job {
 720   my $self = shift;
 721
 722   warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
 723 #  my %param = @_;
 724   my %param = ();
 725   while ( @_ ) {
 726     my( $field, $value ) = splice(@_, 0, 2);
 727     unless ( exists( $param{$field} ) ) {
 728       $param{$field} = $value;
 729     } elsif ( ! ref($param{$field}) ) {
 730       $param{$field} = [ $param{$field}, $value ];
 731     } else {
 732       push @{$param{$field}}, $value;
 733     }
 734   }
 735   $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
 736   $param{RootURL} = rooturl($self->{cgi}->self_url);
 737   warn "FS::UI::Web::start_job\n".
 738        join('', map {
 739                       if ( ref($param{$_}) ) {
 740                         "  $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
 741                       } else {
 742                         "  $_ => $param{$_}\n";
 743                       }
 744                     } keys %param )
 745     if $DEBUG;
 746
 747   #first get the CGI params shipped off to a job ASAP so an id can be returned
 748   #to the caller
 749
 750   my $job = new FS::queue { 'job' => $self->{'job'} };
 751
 752   #too slow to insert all the cgi params as individual args..,?
 753   #my $error = $queue->insert('_JOB', $cgi->Vars);
 754
 755   #rely on FS::queue smartness to freeze/encode the param hash
 756
 757   my $error = $job->insert( '_JOB', \%param );
 758
 759   if ( $error ) {
 760
 761     warn "job not inserted: $error\n"
 762       if $DEBUG;
 763
 764     $error;  #this doesn't seem to be handled well,
 765              # will trigger "illegal jobnum" below?
 766              # (should never be an error inserting the job, though, only thing
 767              #  would be Pg f%*kage)
 768   } else {
 769
 770     warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
 771       if $DEBUG;
 772
 773     $job->jobnum;
 774   }
 775
 776 }
 777
 778 sub job_status {
 779   my( $self, $jobnum ) = @_; #$url ???
 780
 781   sleep 1; # XXX could use something better...
 782
 783   my $job;
 784   if ( $jobnum =~ /^(\d+)$/ ) {
 785     $job = qsearchs('queue', { 'jobnum' => $jobnum } );
 786   } else {
 787     die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
 788   }
 789
 790   my @return;
 791   if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
 792     my ($progress, $action) = split ',', $job->statustext, 2;
 793     $action ||= 'Server processing job';
 794     @return = ( 'progress', $progress, $action );
 795   } elsif ( !$job ) { #handle job gone case : job successful
 796                       # so close popup, redirect parent window...
 797     @return = ( 'complete' );
 798   } elsif ( $job->status eq 'done' ) {
 799     @return = ( 'done', $job->statustext, '' );
 800   } else {
 801     @return = ( 'error', $job ? $job->statustext : $jobnum );
 802   }
 803
 804   encode_json \@return;
 805
 806 }
 807
 808 1;
 809