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