X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FUI%2FWeb.pm;h=c9eaf50120d959d8c8e1b74e22e13280cd37c054;hb=39fd666a49b2be516967131a46891f17ce0101da;hp=213a219752bcb2841e3df8de7ccbbb9285f29d65;hpb=76161f1a2ae0f96470bed4089b00eff5abb16cff;p=freeside.git diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 213a21975..c9eaf5012 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -8,6 +8,8 @@ use FS::Record qw(dbdef); #use FS::UI #@ISA = qw( FS::UI ); +$DEBUG = 0; + use Date::Parse; sub parse_beginning_ending { my($cgi) = @_; @@ -30,74 +32,149 @@ sub parse_beginning_ending { ( $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 methods +# cust_main report subroutines ### -=item cust_header -Returns an array of customer information headers according to the -B configuration setting. +=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_sql_fields { - my @fields = qw( last first company ); - push @fields, map "ship_$_", @fields - if dbdef->table('cust_main')->column('ship_last'); - map "cust_main.$_", @fields; -} - sub cust_header { warn "FS::svc_Common::cust_header called" if $DEBUG; - my $conf = new FS::Conf; - 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', + '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 ( $conf->exists('cust-fields') - && $conf->config('cust-fields') =~ /^([\w \|\#\(\)]+):/ - ) - { - warn " found cust-fields configuration value" - if $DEBUG; + if ( @_ && $_[0] ) { - my $cust_fields = $1; - @cust_header = split(/ \| /, $cust_fields); - @cust_fields = map { $header2method{$_} } @cust_header; - } else { - warn " no cust-fields configuration value found; using default 'Customer'" + warn " using supplied cust-fields override". + " (ignoring cust-fields config file)" if $DEBUG; - @cust_header = ( 'Customer' ); - @cust_fields = ( 'name' ); + $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_fields +=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 according to the cust-fields configuration -setting, or "(unlinked)" if this service is not linked to a customer. +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 @@ -107,7 +184,8 @@ sub cust_fields { "(cust_fields: @cust_fields)" if $DEBUG > 1; - cust_header() unless @cust_fields; + #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 { @@ -130,15 +208,15 @@ sub cust_fields { 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 { @@ -151,6 +229,8 @@ sub new { bless $self, $class; + croak "CGI object required as second argument" unless $self->{'cgi'}; + return $self; } @@ -163,6 +243,9 @@ sub process { # 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". @@ -179,6 +262,10 @@ sub process { $self->job_status(@args); + } else { + + die "unknown sub $sub"; + } } @@ -223,11 +310,19 @@ sub start_job { my $error = $job->insert( '_JOB', encode_base64(nfreeze(\%param)) ); if ( $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; } @@ -248,30 +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); - - #XXX should use JSON! - @return = map { - s/\\/\\\\/g; - s/\n/\\n/g; - s/"/\"/g; - $_ - } @return; - - '[ '. join(', ', map { qq("$_") } @return). " ]\n"; + objToJson(\@return); } -#sub get_new_query { -# FS::UID::cgi(); -#} - 1;