X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FUI%2FWeb.pm;h=c9eaf50120d959d8c8e1b74e22e13280cd37c054;hb=39fd666a49b2be516967131a46891f17ce0101da;hp=d5c7168434941959c0cdee0b4b11fec00e097956;hpb=d6047391feb3236374e16fd73240d9821d77fe06;p=freeside.git diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index d5c716843..c9eaf5012 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -1,24 +1,222 @@ package FS::UI::Web; +use vars qw($DEBUG); +use FS::Conf; +use FS::Record qw(dbdef); + #use vars qw(@ISA); #use FS::UI #@ISA = qw( FS::UI ); +$DEBUG = 0; + +use Date::Parse; +sub parse_beginning_ending { + my($cgi) = @_; + + my $beginning = 0; + if ( $cgi->param('begin') =~ /^(\d+)$/ ) { + $beginning = $1; + } elsif ( $cgi->param('beginning') =~ /^([ 0-9\-\/]{1,64})$/ ) { + $beginning = str2time($1) || 0; + } + + my $ending = 4294967295; #2^32-1 + if ( $cgi->param('end') =~ /^(\d+)$/ ) { + $ending = $1 - 1; + } elsif ( $cgi->param('ending') =~ /^([ 0-9\-\/]{1,64})$/ ) { + #probably need an option to turn off the + 86399 + $ending = str2time($1) + 86399; + } + + ( $beginning, $ending ); +} + +sub parse_lt_gt { + my($cgi, $field) = @_; + + my @search = (); + + my %op = ( + 'lt' => '<', + 'gt' => '>', + ); + + foreach my $op (keys %op) { + + warn "checking for ${field}_$op field\n" + if $DEBUG; + + if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*([\d\,\s]+(\.\d\d)?)\s*$/ ) { + + my $num = $1; + $num =~ s/[\,\s]+//g; + my $search = "$field $op{$op} $num"; + push @search, $search; + + warn "found ${field}_$op field; adding search element $search\n" + if $DEBUG; + } + + } + + @search; + +} + +### +# cust_main report subroutines +### + + +=item cust_header [ CUST_FIELDS_VALUE ] + +Returns an array of customer information headers according to the supplied +customer fields value, or if no value is supplied, the B +configuration value. + +=cut + +use vars qw( @cust_fields ); + +sub cust_header { + + warn "FS::svc_Common::cust_header called" + if $DEBUG; + + my %header2method = ( + 'Customer' => 'name', + 'Cust#' => 'custnum', + 'Name' => 'contact', + 'Company' => 'company', + '(bill) Customer' => 'name', + '(service) Customer' => 'ship_name', + '(bill) Name' => 'contact', + '(service) Name' => 'ship_contact', + '(bill) Company' => 'company', + '(service) Company' => 'ship_company', + 'Address 1' => 'address1', + 'Address 2' => 'address2', + 'City' => 'city', + 'State' => 'state', + 'Zip' => 'zip', + 'Country' => 'country_full', + 'Day phone' => 'daytime', # XXX should use msgcat, but how? + 'Night phone' => 'night', # XXX should use msgcat, but how? + 'Invoicing email(s)' => 'invoicing_list_emailonly', + ); + + my $cust_fields; + my @cust_header; + if ( @_ && $_[0] ) { + + warn " using supplied cust-fields override". + " (ignoring cust-fields config file)" + if $DEBUG; + $cust_fields = shift; + + } else { + + my $conf = new FS::Conf; + if ( $conf->exists('cust-fields') + && $conf->config('cust-fields') =~ /^([\w \|\#\(\)]+):?/ + ) + { + warn " found cust-fields configuration value" + if $DEBUG; + $cust_fields = $1; + } else { + warn " no cust-fields configuration value found; using default 'Customer'" + if $DEBUG; + $cust_fields = 'Customer'; + } + + } + + @cust_header = split(/ \| /, $cust_fields); + @cust_fields = map { $header2method{$_} } @cust_header; + + #my $svc_x = shift; + @cust_header; +} + +=item cust_sql_fields [ CUST_FIELDS_VALUE ] +Returns a list of fields for the SELECT portion of an SQL query. + +As with L, the fields returned are +defined by the supplied customer fields setting, or if no customer fields +setting is supplied, the cust-fields configuration value. + +=cut + +sub cust_sql_fields { + + my @fields = qw( last first company ); + push @fields, map "ship_$_", @fields; + push @fields, 'country'; + + cust_header(@_); + #inefficientish, but tiny lists and only run once per page + push @fields, + grep { my $field = $_; grep { $_ eq $field } @cust_fields } + qw( address1 address2 city state zip daytime night ); + + map "cust_main.$_", @fields; +} + +=item cust_fields SVC_OBJECT [ CUST_FIELDS_VALUE ] + +Given a svc_ object that contains fields from cust_main (say, from a +JOINed search. See httemplate/search/svc_* for examples), returns an array +of customer information, or "(unlinked)" if this service is not linked to a +customer. + +As with L, the fields returned are +defined by the supplied customer fields setting, or if no customer fields +setting is supplied, the cust-fields configuration value. + +=cut + +sub cust_fields { + my $svc_x = shift; + warn "FS::svc_Common::cust_fields called for $svc_x ". + "(cust_fields: @cust_fields)" + if $DEBUG > 1; + + #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields + # #override incase we were passed as a sub + + my $seen_unlinked = 0; + map { + if ( $svc_x->custnum ) { + warn " $svc_x -> $_" + if $DEBUG > 1; + $svc_x->$_(@_); + } else { + warn " ($svc_x unlinked)" + if $DEBUG > 1; + $seen_unlinked++ ? '' : '(unlinked)'; + } + } @cust_fields; +} + +### # begin JSRPC code... +### package FS::UI::Web::JSRPC; use strict; -use vars qw(@ISA $DEBUG); +use vars qw($DEBUG); +use Carp; use Storable qw(nfreeze); use MIME::Base64; -use JavaScript::RPC::Server::CGI; +use JSON; use FS::UID; use FS::Record qw(qsearchs); use FS::queue; -@ISA = qw( JavaScript::RPC::Server::CGI ); $DEBUG = 0; sub new { @@ -26,19 +224,76 @@ sub new { my $self = { env => {}, job => shift, + cgi => shift, }; bless $self, $class; + croak "CGI object required as second argument" unless $self->{'cgi'}; + return $self; } +sub process { + + my $self = shift; + + my $cgi = $self->{'cgi'}; + + # XXX this should parse JSON foo and build a proper data structure + my @args = $cgi->param('arg'); + + #work around konqueror bug! + @args = map { s/\x00$//; $_; } @args; + + my $sub = $cgi->param('sub'); #???? + + warn "FS::UI::Web::JSRPC::process:\n". + " cgi=$cgi\n". + " sub=$sub\n". + " args=".join(', ',@args)."\n" + if $DEBUG; + + if ( $sub eq 'start_job' ) { + + $self->start_job(@args); + + } elsif ( $sub eq 'job_status' ) { + + $self->job_status(@args); + + } else { + + die "unknown sub $sub"; + + } + +} + sub start_job { my $self = shift; - my %param = @_; + warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG; +# my %param = @_; + my %param = (); + while ( @_ ) { + my( $field, $value ) = splice(@_, 0, 2); + unless ( exists( $param{$field} ) ) { + $param{$field} = $value; + } elsif ( ! ref($param{$field}) ) { + $param{$field} = [ $param{$field}, $value ]; + } else { + push @{$param{$field}}, $value; + } + } warn "FS::UI::Web::start_job\n". - join('', map " $_ => $param{$_}\n", keys %param ) + join('', map { + if ( ref($param{$_}) ) { + " $_ => [ ". join(', ', @{$param{$_}}). " ]\n"; + } else { + " $_ => $param{$_}\n"; + } + } keys %param ) if $DEBUG; #first get the CGI params shipped off to a job ASAP so an id can be returned @@ -55,8 +310,19 @@ sub start_job { my $error = $job->insert( '_JOB', encode_base64(nfreeze(\%param)) ); if ( $error ) { - $error; + + warn "job not inserted: $error\n" + if $DEBUG; + + $error; #this doesn't seem to be handled well, + # will trigger "illegal jobnum" below? + # (should never be an error inserting the job, though, only thing + # would be Pg f%*kage) } else { + + warn "job inserted successfully with jobnum ". $job->jobnum. "\n" + if $DEBUG; + $job->jobnum; } @@ -65,7 +331,7 @@ sub start_job { sub job_status { my( $self, $jobnum ) = @_; #$url ??? - sleep 5; #could use something better... + sleep 1; # XXX could use something better... my $job; if ( $jobnum =~ /^(\d+)$/ ) { @@ -77,18 +343,16 @@ sub job_status { my @return; if ( $job && $job->status ne 'failed' ) { @return = ( 'progress', $job->statustext ); - } elsif ( !$job ) { #handle job gone case : job sucessful + } elsif ( !$job ) { #handle job gone case : job successful # so close popup, redirect parent window... @return = ( 'complete' ); } else { @return = ( 'error', $job ? $job->statustext : $jobnum ); } - join("\n",@return); + objToJson(\@return); } -sub get_new_query { - FS::UID::cgi(); -} +1;