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   }
 627   if ( $NO_RANDOM_IDS ) {
 628     if ( $digits > 0 ) {
 629       return 0;
 630     } else {
 631       return '0000000000-0000-000000000.000000';
 632     }
 633   } else {
 634     if ($digits > 0) {
 635       return int(rand(10 ** $digits));
 636     } else {
 637       return time . "-$$-" . rand() * 2**32;
 638     }
 639   }
 640 }
 641
 642 =back
 643
 644 =cut
 645
 646 ###
 647 # begin JSRPC code...
 648 ###
 649
 650 package FS::UI::Web::JSRPC;
 651
 652 use strict;
 653 use vars qw($DEBUG);
 654 use Carp;
 655 use Storable qw(nfreeze);
 656 use MIME::Base64;
 657 use JSON::XS;
 658 use FS::CurrentUser;
 659 use FS::Record qw(qsearchs);
 660 use FS::queue;
 661 use FS::CGI qw(rooturl);
 662
 663 $DEBUG = 0;
 664
 665 sub new {
 666         my $class = shift;
 667         my $self  = {
 668                 env => {},
 669                 job => shift,
 670                 cgi => shift,
 671         };
 672
 673         bless $self, $class;
 674
 675         croak "CGI object required as second argument" unless $self->{'cgi'};
 676
 677         return $self;
 678 }
 679
 680 sub process {
 681
 682   my $self = shift;
 683
 684   my $cgi = $self->{'cgi'};
 685
 686   # XXX this should parse JSON foo and build a proper data structure
 687   my @args = $cgi->param('arg');
 688
 689   #work around konqueror bug!
 690   @args = map { s/\x00$//; $_; } @args;
 691
 692   my $sub = $cgi->param('sub'); #????
 693
 694   warn "FS::UI::Web::JSRPC::process:\n".
 695        "  cgi=$cgi\n".
 696        "  sub=$sub\n".
 697        "  args=".join(', ',@args)."\n"
 698     if $DEBUG;
 699
 700   if ( $sub eq 'start_job' ) {
 701
 702     $self->start_job(@args);
 703
 704   } elsif ( $sub eq 'job_status' ) {
 705
 706     $self->job_status(@args);
 707
 708   } else {
 709
 710     die "unknown sub $sub";
 711
 712   }
 713
 714 }
 715
 716 sub start_job {
 717   my $self = shift;
 718
 719   warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
 720 #  my %param = @_;
 721   my %param = ();
 722   while ( @_ ) {
 723     my( $field, $value ) = splice(@_, 0, 2);
 724     unless ( exists( $param{$field} ) ) {
 725       $param{$field} = $value;
 726     } elsif ( ! ref($param{$field}) ) {
 727       $param{$field} = [ $param{$field}, $value ];
 728     } else {
 729       push @{$param{$field}}, $value;
 730     }
 731   }
 732   $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
 733   $param{RootURL} = rooturl($self->{cgi}->self_url);
 734   warn "FS::UI::Web::start_job\n".
 735        join('', map {
 736                       if ( ref($param{$_}) ) {
 737                         "  $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
 738                       } else {
 739                         "  $_ => $param{$_}\n";
 740                       }
 741                     } keys %param )
 742     if $DEBUG;
 743
 744   #first get the CGI params shipped off to a job ASAP so an id can be returned
 745   #to the caller
 746
 747   my $job = new FS::queue { 'job' => $self->{'job'} };
 748
 749   #too slow to insert all the cgi params as individual args..,?
 750   #my $error = $queue->insert('_JOB', $cgi->Vars);
 751
 752   #rely on FS::queue smartness to freeze/encode the param hash
 753
 754   my $error = $job->insert( '_JOB', \%param );
 755
 756   if ( $error ) {
 757
 758     warn "job not inserted: $error\n"
 759       if $DEBUG;
 760
 761     $error;  #this doesn't seem to be handled well,
 762              # will trigger "illegal jobnum" below?
 763              # (should never be an error inserting the job, though, only thing
 764              #  would be Pg f%*kage)
 765   } else {
 766
 767     warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
 768       if $DEBUG;
 769
 770     $job->jobnum;
 771   }
 772
 773 }
 774
 775 sub job_status {
 776   my( $self, $jobnum ) = @_; #$url ???
 777
 778   sleep 1; # XXX could use something better...
 779
 780   my $job;
 781   if ( $jobnum =~ /^(\d+)$/ ) {
 782     $job = qsearchs('queue', { 'jobnum' => $jobnum } );
 783   } else {
 784     die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
 785   }
 786
 787   my @return;
 788   if ( $job && $job->status ne 'failed' && $job->status ne 'done' ) {
 789     my ($progress, $action) = split ',', $job->statustext, 2;
 790     $action ||= 'Server processing job';
 791     @return = ( 'progress', $progress, $action );
 792   } elsif ( !$job ) { #handle job gone case : job successful
 793                       # so close popup, redirect parent window...
 794     @return = ( 'complete' );
 795   } elsif ( $job->status eq 'done' ) {
 796     @return = ( 'done', $job->statustext, '' );
 797   } else {
 798     @return = ( 'error', $job ? $job->statustext : $jobnum );
 799   }
 800
 801   encode_json \@return;
 802
 803 }
 804
 805 1;
 806