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