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