X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FUI%2FWeb.pm;h=2e9261bc0100ed12e44cdb8b0dec5fb46551cb7a;hb=2c90d42ca355e77804fbd0d4fe158dcdc38392c6;hp=23f0e83c4958c2371df75e193513652a21988d81;hpb=6af586392aef95c6fe35326ced1a9073b068a78c;p=freeside.git diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 23f0e83c4..2e9261bc0 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -1,13 +1,18 @@ package FS::UI::Web; use strict; -use vars qw($DEBUG $me); +use vars qw($DEBUG @ISA @EXPORT_OK $me); +use Exporter; use FS::Conf; use FS::Record qw(dbdef); +use FS::cust_main; # are sql_balance and sql_date_balance in the right module? #use vars qw(@ISA); #use FS::UI #@ISA = qw( FS::UI ); +@ISA = qw( Exporter ); + +@EXPORT_OK = qw( svc_url ); $DEBUG = 0; $me = '[FS::UID::Web]'; @@ -18,19 +23,20 @@ $me = '[FS::UID::Web]'; use Date::Parse; sub parse_beginning_ending { - my($cgi) = @_; + my($cgi, $prefix) = @_; + $prefix .= '_' if $prefix; my $beginning = 0; - if ( $cgi->param('begin') =~ /^(\d+)$/ ) { + if ( $cgi->param($prefix.'begin') =~ /^(\d+)$/ ) { $beginning = $1; - } elsif ( $cgi->param('beginning') =~ /^([ 0-9\-\/]{1,64})$/ ) { + } elsif ( $cgi->param($prefix.'beginning') =~ /^([ 0-9\-\/]{1,64})$/ ) { $beginning = str2time($1) || 0; } my $ending = 4294967295; #2^32-1 - if ( $cgi->param('end') =~ /^(\d+)$/ ) { + if ( $cgi->param($prefix.'end') =~ /^(\d+)$/ ) { $ending = $1 - 1; - } elsif ( $cgi->param('ending') =~ /^([ 0-9\-\/]{1,64})$/ ) { + } elsif ( $cgi->param($prefix.'ending') =~ /^([ 0-9\-\/]{1,64})$/ ) { #probably need an option to turn off the + 86399 $ending = str2time($1) + 86399; } @@ -112,6 +118,7 @@ sub svc_url { $url .= 'svcnum=' if $query =~ /^\d+(;|$)/ or $query eq ''; } + import FS::CGI 'rooturl'; #WTF! why is this necessary my $return = rooturl(). "$opt{action}/$url$query"; $return = qq!! if $opt{ahref}; @@ -131,6 +138,10 @@ sub svc_label_link { sub svc_X_link { my ($x, $m, $part_svc, $cust_svc) = @_ or return ''; + + return $x + unless $FS::CurrentUser::CurrentUser->access_right('View customer services'); + my $ahref = svc_url( 'ahref' => 1, 'm' => $m, @@ -142,6 +153,15 @@ sub svc_X_link { "$ahref$x"; } +#this probably needs an ACL too... +sub svc_export_links { + my ($m, $part_svc, $cust_svc) = @_ or return ''; + + my $ahref = $cust_svc->export_links; + + join('', @$ahref); +} + sub parse_lt_gt { my($cgi, $field) = @_; @@ -157,7 +177,7 @@ sub parse_lt_gt { warn "checking for ${field}_$op field\n" if $DEBUG; - if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*([\d\,\s]+(\.\d\d)?)\s*$/ ) { + if ( $cgi->param($field."_$op") =~ /^\s*\$?\s*(-?[\d\,\s]+(\.\d\d)?)\s*$/ ) { my $num = $1; $num =~ s/[\,\s]+//g; @@ -174,17 +194,6 @@ sub parse_lt_gt { } -sub bytecount_unexact { - my $bc = shift; - return("$bc bytes") - if ($bc < 1000); - return(sprintf("%.2f Kbytes", $bc/1000)) - if ($bc < 1000000); - return(sprintf("%.2f Mbytes", $bc/1000000)) - if ($bc < 1000000000); - return(sprintf("%.2f Gbytes", $bc/1000000000)); -} - ### # cust_main report subroutines ### @@ -198,15 +207,16 @@ configuration value. =cut -use vars qw( @cust_fields ); +use vars qw( @cust_fields @cust_colors @cust_styles @cust_aligns ); sub cust_header { - warn "FS::svc_Common::cust_header called" + warn "FS::UI:Web::cust_header called" if $DEBUG; my %header2method = ( 'Customer' => 'name', + 'Cust. Status' => 'ucfirst_cust_status', 'Cust#' => 'custnum', 'Name' => 'contact', 'Company' => 'company', @@ -224,7 +234,20 @@ sub cust_header { 'Country' => 'country_full', 'Day phone' => 'daytime', # XXX should use msgcat, but how? 'Night phone' => 'night', # XXX should use msgcat, but how? + 'Fax number' => 'fax', 'Invoicing email(s)' => 'invoicing_list_emailonly_scalar', + 'Payment Type' => 'payby', + 'Current Balance' => 'current_balance', + ); + + my %header2colormethod = ( + 'Cust. Status' => 'cust_statuscolor', + ); + my %header2style = ( + 'Cust. Status' => 'b', + ); + my %header2align = ( + 'Cust. Status' => 'c', ); my $cust_fields; @@ -240,22 +263,31 @@ sub cust_header { my $conf = new FS::Conf; if ( $conf->exists('cust-fields') - && $conf->config('cust-fields') =~ /^([\w \|\#\(\)]+):?/ + && $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'" + warn " no cust-fields configuration value found; using default 'Cust. Status | Customer'" if $DEBUG; - $cust_fields = 'Customer'; + $cust_fields = 'Cust. Status | Customer'; } } @cust_header = split(/ \| /, $cust_fields); @cust_fields = map { $header2method{$_} } @cust_header; + @cust_colors = map { exists $header2colormethod{$_} + ? $header2colormethod{$_} + : '' + } + @cust_header; + @cust_styles = map { exists $header2style{$_} ? $header2style{$_} : '' } + @cust_header; + @cust_aligns = map { exists $header2align{$_} ? $header2align{$_} : 'l' } + @cust_header; #my $svc_x = shift; @cust_header; @@ -281,14 +313,19 @@ sub cust_sql_fields { #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 ); + qw( address1 address2 city state zip daytime night fax payby ); - map "cust_main.$_", @fields; + my @extra_fields = (); + if (grep { $_ eq 'current_balance' } @cust_fields) { + push @extra_fields, FS::cust_main->balance_sql . " AS current_balance"; + } + + map("cust_main.$_", @fields), @extra_fields; } -=item cust_fields SVC_OBJECT [ CUST_FIELDS_VALUE ] +=item cust_fields OBJECT [ CUST_FIELDS_VALUE ] -Given a svc_ object that contains fields from cust_main (say, from a +Given an 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. @@ -300,8 +337,8 @@ 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 ". + my $record = shift; + warn "FS::UI::Web::cust_fields called for $record ". "(cust_fields: @cust_fields)" if $DEBUG > 1; @@ -310,18 +347,79 @@ sub cust_fields { my $seen_unlinked = 0; map { - if ( $svc_x->custnum ) { - warn " $svc_x -> $_" + if ( $record->custnum ) { + warn " $record -> $_" if $DEBUG > 1; - $svc_x->$_(@_); + $record->$_(@_); } else { - warn " ($svc_x unlinked)" + warn " ($record unlinked)" if $DEBUG > 1; $seen_unlinked++ ? '' : '(unlinked)'; } } @cust_fields; } +=item cust_colors + +Returns an array of subroutine references (or empty strings) for returning +customer information colors. + +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_colors { + map { + my $method = $_; + if ( $method ) { + sub { shift->$method(@_) }; + } else { + ''; + } + } @cust_colors; +} + +=item cust_styles + +Returns an array of customer information styles. + +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_styles { + map { + if ( $_ ) { + $_; + } else { + ''; + } + } @cust_styles; +} + +=item cust_aligns + +Returns an array or scalar (depending on context) of customer information +alignments. + +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_aligns { + if ( wantarray ) { + @cust_aligns; + } else { + join('', @cust_aligns); + } +} + ### # begin JSRPC code... ### @@ -334,7 +432,7 @@ use Carp; use Storable qw(nfreeze); use MIME::Base64; use JSON; -use FS::UID; +use FS::UID qw(getotaker); use FS::Record qw(qsearchs); use FS::queue; @@ -407,6 +505,7 @@ sub start_job { push @{$param{$field}}, $value; } } + $param{CurrentUser} = getotaker(); warn "FS::UI::Web::start_job\n". join('', map { if ( ref($param{$_}) ) {