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