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