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