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