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