FS/FS/UI/Web.pm

   1 package FS::UI::Web;
   2
   3 use vars qw($DEBUG);
   4 use FS::Conf;
   5 use FS::Record qw(dbdef);
   6
   7 #use vars qw(@ISA);
   8 #use FS::UI
   9 #@ISA = qw( FS::UI );
  10
  11 $DEBUG = 0;
  12
  13 use Date::Parse;
  14 sub parse_beginning_ending {
  15   my($cgi) = @_;
  16
  17   my $beginning = 0;
  18   if ( $cgi->param('begin') =~ /^(\d+)$/ ) {
  19     $beginning = $1;
  20   } elsif ( $cgi->param('beginning') =~ /^([ 0-9\-\/]{1,64})$/ ) {
  21     $beginning = str2time($1) || 0;
  22   }
  23
  24   my $ending = 4294967295; #2^32-1
  25   if ( $cgi->param('end') =~ /^(\d+)$/ ) {
  26     $ending = $1 - 1;
  27   } elsif ( $cgi->param('ending') =~ /^([ 0-9\-\/]{1,64})$/ ) {
  28     #probably need an option to turn off the + 86399
  29     $ending = str2time($1) + 86399;
  30   }
  31
  32   ( $beginning, $ending );
  33 }
  34
  35 sub parse_lt_gt {
  36   my($cgi, $field) = @_;
  37
  38   my @search = ();
  39
  40   my %op = (
  41     'lt' => '<',
  42     'gt' => '>',
  43   );
  44
  45   foreach my $op (keys %op) {
  46
  47     warn "checking for ${field}_$op field\n"
  48       if $DEBUG;
  49
  50     if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*([\d\,\s]+(\.\d\d)?)\s*$/ ) {
  51
  52       my $num = $1;
  53       $num =~ s/[\,\s]+//g;
  54       my $search = "$field $op{$op} $num";
  55       push @search, $search;
  56
  57       warn "found ${field}_$op field; adding search element $search\n"
  58         if $DEBUG;
  59     }
  60
  61   }
  62
  63   @search;
  64
  65 }
  66
  67 sub bytecount_unexact {
  68   my $bc = shift;
  69   return("$bc bytes")
  70     if ($bc < 1000);
  71   return(sprintf("%.2f Kbytes", $bc/1000))
  72     if ($bc < 1000000);
  73   return(sprintf("%.2f Mbytes", $bc/1000000))
  74     if ($bc < 1000000000);
  75   return(sprintf("%.2f Gbytes", $bc/1000000000));
  76 }
  77
  78 ###
  79 # cust_main report subroutines
  80 ###
  81
  82
  83 =item cust_header [ CUST_FIELDS_VALUE ]
  84
  85 Returns an array of customer information headers according to the supplied
  86 customer fields value, or if no value is supplied, the B<cust-fields>
  87 configuration value.
  88
  89 =cut
  90
  91 use vars qw( @cust_fields );
  92
  93 sub cust_header {
  94
  95   warn "FS::svc_Common::cust_header called"
  96     if $DEBUG;
  97
  98   my %header2method = (
  99     'Customer'                 => 'name',
 100     'Cust#'                    => 'custnum',
 101     'Name'                     => 'contact',
 102     'Company'                  => 'company',
 103     '(bill) Customer'          => 'name',
 104     '(service) Customer'       => 'ship_name',
 105     '(bill) Name'              => 'contact',
 106     '(service) Name'           => 'ship_contact',
 107     '(bill) Company'           => 'company',
 108     '(service) Company'        => 'ship_company',
 109     'Address 1'                => 'address1',
 110     'Address 2'                => 'address2',
 111     'City'                     => 'city',
 112     'State'                    => 'state',
 113     'Zip'                      => 'zip',
 114     'Country'                  => 'country_full',
 115     'Day phone'                => 'daytime', # XXX should use msgcat, but how?
 116     'Night phone'              => 'night',   # XXX should use msgcat, but how?
 117     'Invoicing email(s)'       => 'invoicing_list_emailonly',
 118   );
 119
 120   my $cust_fields;
 121   my @cust_header;
 122   if ( @_ && $_[0] ) {
 123
 124     warn "  using supplied cust-fields override".
 125           " (ignoring cust-fields config file)"
 126       if $DEBUG;
 127     $cust_fields = shift;
 128
 129   } else {
 130
 131     my $conf = new FS::Conf;
 132     if (    $conf->exists('cust-fields')
 133          && $conf->config('cust-fields') =~ /^([\w \|\#\(\)]+):?/
 134        )
 135     {
 136       warn "  found cust-fields configuration value"
 137         if $DEBUG;
 138       $cust_fields = $1;
 139     } else {
 140       warn "  no cust-fields configuration value found; using default 'Customer'"
 141         if $DEBUG;
 142       $cust_fields = 'Customer';
 143     }
 144
 145   }
 146
 147   @cust_header = split(/ \| /, $cust_fields);
 148   @cust_fields = map { $header2method{$_} } @cust_header;
 149
 150   #my $svc_x = shift;
 151   @cust_header;
 152 }
 153
 154 =item cust_sql_fields [ CUST_FIELDS_VALUE ]
 155
 156 Returns a list of fields for the SELECT portion of an SQL query.
 157
 158 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 159 defined by the supplied customer fields setting, or if no customer fields
 160 setting is supplied, the <B>cust-fields</B> configuration value.
 161
 162 =cut
 163
 164 sub cust_sql_fields {
 165
 166   my @fields = qw( last first company );
 167   push @fields, map "ship_$_", @fields;
 168   push @fields, 'country';
 169
 170   cust_header(@_);
 171   #inefficientish, but tiny lists and only run once per page
 172   push @fields,
 173     grep { my $field = $_; grep { $_ eq $field } @cust_fields }
 174          qw( address1 address2 city state zip daytime night );
 175
 176   map "cust_main.$_", @fields;
 177 }
 178
 179 =item cust_fields SVC_OBJECT [ CUST_FIELDS_VALUE ]
 180
 181 Given a svc_ object that contains fields from cust_main (say, from a
 182 JOINed search.  See httemplate/search/svc_* for examples), returns an array
 183 of customer information, or "(unlinked)" if this service is not linked to a
 184 customer.
 185
 186 As with L<the cust_header subroutine|/cust_header>, the fields returned are
 187 defined by the supplied customer fields setting, or if no customer fields
 188 setting is supplied, the <B>cust-fields</B> configuration value.
 189
 190 =cut
 191
 192 sub cust_fields {
 193   my $svc_x = shift;
 194   warn "FS::svc_Common::cust_fields called for $svc_x ".
 195        "(cust_fields: @cust_fields)"
 196     if $DEBUG > 1;
 197
 198   #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
 199   #                                     #override incase we were passed as a sub
 200
 201   my $seen_unlinked = 0;
 202   map {
 203     if ( $svc_x->custnum ) {
 204       warn "  $svc_x -> $_"
 205         if $DEBUG > 1;
 206       $svc_x->$_(@_);
 207     } else {
 208       warn "  ($svc_x unlinked)"
 209         if $DEBUG > 1;
 210       $seen_unlinked++ ? '' : '(unlinked)';
 211     }
 212   } @cust_fields;
 213 }
 214
 215 ###
 216 # begin JSRPC code...
 217 ###
 218
 219 package FS::UI::Web::JSRPC;
 220
 221 use strict;
 222 use vars qw($DEBUG);
 223 use Carp;
 224 use Storable qw(nfreeze);
 225 use MIME::Base64;
 226 use JSON;
 227 use FS::UID;
 228 use FS::Record qw(qsearchs);
 229 use FS::queue;
 230
 231 $DEBUG = 0;
 232
 233 sub new {
 234         my $class = shift;
 235         my $self  = {
 236                 env => {},
 237                 job => shift,
 238                 cgi => shift,
 239         };
 240
 241         bless $self, $class;
 242
 243         croak "CGI object required as second argument" unless $self->{'cgi'};
 244
 245         return $self;
 246 }
 247
 248 sub process {
 249
 250   my $self = shift;
 251
 252   my $cgi = $self->{'cgi'};
 253
 254   # XXX this should parse JSON foo and build a proper data structure
 255   my @args = $cgi->param('arg');
 256
 257   #work around konqueror bug!
 258   @args = map { s/\x00$//; $_; } @args;
 259
 260   my $sub = $cgi->param('sub'); #????
 261
 262   warn "FS::UI::Web::JSRPC::process:\n".
 263        "  cgi=$cgi\n".
 264        "  sub=$sub\n".
 265        "  args=".join(', ',@args)."\n"
 266     if $DEBUG;
 267
 268   if ( $sub eq 'start_job' ) {
 269
 270     $self->start_job(@args);
 271
 272   } elsif ( $sub eq 'job_status' ) {
 273
 274     $self->job_status(@args);
 275
 276   } else {
 277
 278     die "unknown sub $sub";
 279
 280   }
 281
 282 }
 283
 284 sub start_job {
 285   my $self = shift;
 286
 287   warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG;
 288 #  my %param = @_;
 289   my %param = ();
 290   while ( @_ ) {
 291     my( $field, $value ) = splice(@_, 0, 2);
 292     unless ( exists( $param{$field} ) ) {
 293       $param{$field} = $value;
 294     } elsif ( ! ref($param{$field}) ) {
 295       $param{$field} = [ $param{$field}, $value ];
 296     } else {
 297       push @{$param{$field}}, $value;
 298     }
 299   }
 300   warn "FS::UI::Web::start_job\n".
 301        join('', map {
 302                       if ( ref($param{$_}) ) {
 303                         "  $_ => [ ". join(', ', @{$param{$_}}). " ]\n";
 304                       } else {
 305                         "  $_ => $param{$_}\n";
 306                       }
 307                     } keys %param )
 308     if $DEBUG;
 309
 310   #first get the CGI params shipped off to a job ASAP so an id can be returned
 311   #to the caller
 312
 313   my $job = new FS::queue { 'job' => $self->{'job'} };
 314
 315   #too slow to insert all the cgi params as individual args..,?
 316   #my $error = $queue->insert('_JOB', $cgi->Vars);
 317
 318   #warn 'froze string of size '. length(nfreeze(\%param)). " for job args\n"
 319   #  if $DEBUG;
 320
 321   my $error = $job->insert( '_JOB', encode_base64(nfreeze(\%param)) );
 322
 323   if ( $error ) {
 324
 325     warn "job not inserted: $error\n"
 326       if $DEBUG;
 327
 328     $error;  #this doesn't seem to be handled well,
 329              # will trigger "illegal jobnum" below?
 330              # (should never be an error inserting the job, though, only thing
 331              #  would be Pg f%*kage)
 332   } else {
 333
 334     warn "job inserted successfully with jobnum ". $job->jobnum. "\n"
 335       if $DEBUG;
 336
 337     $job->jobnum;
 338   }
 339
 340 }
 341
 342 sub job_status {
 343   my( $self, $jobnum ) = @_; #$url ???
 344
 345   sleep 1; # XXX could use something better...
 346
 347   my $job;
 348   if ( $jobnum =~ /^(\d+)$/ ) {
 349     $job = qsearchs('queue', { 'jobnum' => $jobnum } );
 350   } else {
 351     die "FS::UI::Web::job_status: illegal jobnum $jobnum\n";
 352   }
 353
 354   my @return;
 355   if ( $job && $job->status ne 'failed' ) {
 356     @return = ( 'progress', $job->statustext );
 357   } elsif ( !$job ) { #handle job gone case : job successful
 358                       # so close popup, redirect parent window...
 359     @return = ( 'complete' );
 360   } else {
 361     @return = ( 'error', $job ? $job->statustext : $jobnum );
 362   }
 363
 364   objToJson(\@return);
 365
 366 }
 367
 368 1;
 369