From: Ivan Kohler Date: Sun, 19 Oct 2014 19:19:17 +0000 (-0700) Subject: Merge branch 'master' of git.freeside.biz:/home/git/freeside X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=706da330626bab472bf6f4e50cf3c181bfa0cf9f;hp=686acdfba1e10deaceea97cde1dccd99c928263a Merge branch 'master' of git.freeside.biz:/home/git/freeside --- diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 98f66e904..3a4a1695d 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -664,37 +664,10 @@ sub cust_bill_pkg_discount { } -sub pkg_field_where { - my( $self, $field, $speriod, $eperiod, $agentnum, %opt ) = @_; - # someday this will use an aggregate query and return all the columns - # at once - # and I will drive a Tesla and have a live-in sushi chef who is also a - # ninja bodyguard - my @where = ( - $self->in_time_period_and_agent($speriod, - $eperiod, - $agentnum, - "cust_pkg.$field", - ), - $self->with_refnum(%opt), - $self->with_towernum(%opt), - $self->with_zip(%opt), - # can't use with_classnum here... - ); - if ($opt{classnum}) { - my $classnum = $opt{classnum}; - $classnum = [ $classnum ] if !ref($classnum); - @$classnum = grep /^\d+$/, @$classnum; - my $in = 'IN ('. join(',', @$classnum). ')'; - push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum; - } +##### churn report ##### - ' WHERE ' . join(' AND ', grep $_, @where); -} - -=item setup_pkg: The number of packages with setup dates in the period. - -This excludes packages created by package changes. Options: +=item active_pkg: The number of packages that were active at the start of +the period. The end date of the period is ignored. Options: - refnum: Limit to customers with this advertising source. - classnum: Limit to packages with this class. @@ -704,61 +677,86 @@ This excludes packages created by package changes. Options: Except for zip, any of these can be an arrayref to allow multiple values for the field. -=item susp_pkg: The number of suspended packages that were last suspended -in the period. Options are as for setup_pkg. +=item setup_pkg: The number of packages with setup dates in the period. This +excludes packages created by package changes. Options are as for active_pkg. + +=item susp_pkg: The number of packages that were suspended in the period +(and not canceled). Options are as for active_pkg. + +=item unsusp_pkg: The number of packages that were unsuspended in the period. +Options are as for active_pkg. =item cancel_pkg: The number of packages with cancel dates in the period. Excludes packages that were canceled to be changed to a new package. Options -are as for setup_pkg. +are as for active_pkg. =cut +sub active_pkg { + my $self = shift; + $self->churn_pkg('active', @_); +} + sub setup_pkg { my $self = shift; - my $sql = 'SELECT COUNT(*) FROM cust_pkg - LEFT JOIN part_pkg USING (pkgpart) - LEFT JOIN cust_main USING (custnum)'. - $self->pkg_field_where('setup', @_) . - ' AND change_pkgnum IS NULL'; + $self->churn_pkg('setup', @_); +} - $self->scalar_sql($sql); +sub cancel_pkg { + my $self = shift; + $self->churn_pkg('cancel', @_); } sub susp_pkg { - # number of currently suspended packages that were suspended in the period my $self = shift; - my $sql = 'SELECT COUNT(*) FROM cust_pkg - LEFT JOIN part_pkg USING (pkgpart) - LEFT JOIN cust_main USING (custnum) '. - $self->pkg_field_where('susp', @_); + $self->churn_pkg('susp', @_); +} - $self->scalar_sql($sql); +sub unsusp_pkg { + my $self = shift; + $self->churn_pkg('unsusp', @_); } -sub cancel_pkg { - # number of packages canceled in the period and not changed to another - # package +sub churn_pkg { my $self = shift; - my $sql = 'SELECT COUNT(*) FROM cust_pkg - LEFT JOIN part_pkg USING (pkgpart) - LEFT JOIN cust_main USING (custnum) - LEFT JOIN cust_pkg changed_to_pkg ON( - cust_pkg.pkgnum = changed_to_pkg.change_pkgnum - ) '. - $self->pkg_field_where('cancel', @_) . - ' AND changed_to_pkg.pkgnum IS NULL'; + my ( $status, $speriod, $eperiod, $agentnum, %opt ) = @_; + my ($from, @where) = + FS::h_cust_pkg->churn_fromwhere_sql( $status, $speriod, $eperiod); + + push @where, $self->pkg_where(%opt, 'agentnum' => $agentnum); + + my $sql = "SELECT COUNT(*) FROM $from + JOIN part_pkg ON (cust_pkg.pkgpart = part_pkg.pkgpart) + JOIN cust_main ON (cust_pkg.custnum = cust_main.custnum)"; + $sql .= ' WHERE '.join(' AND ', @where) + if scalar(@where); $self->scalar_sql($sql); } -#this is going to be harder.. -#sub unsusp_pkg { -# my( $self, $speriod, $eperiod, $agentnum ) = @_; -# $self->scalar_sql(" -# SELECT COUNT(*) FROM h_cust_pkg -# WHERE -# -#} +sub pkg_where { + my $self = shift; + my %opt = @_; + my @where = ( + "part_pkg.freq != '0'", + $self->with_refnum(%opt), + $self->with_towernum(%opt), + $self->with_zip(%opt), + ); + if ($opt{agentnum} =~ /^(\d+)$/) { + push @where, "cust_main.agentnum = $1"; + } + if ($opt{classnum}) { + my $classnum = $opt{classnum}; + $classnum = [ $classnum ] if !ref($classnum); + @$classnum = grep /^\d+$/, @$classnum; + my $in = 'IN ('. join(',', @$classnum). ')'; + push @where, "COALESCE(part_pkg.classnum, 0) $in" if scalar @$classnum; + } + @where; +} + +##### end of churn report stuff ##### sub in_time_period_and_agent { my( $self, $speriod, $eperiod, $agentnum ) = splice(@_, 0, 4); diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm index b8e52ae63..0ff7efd16 100644 --- a/FS/FS/Report/Table/Monthly.pm +++ b/FS/FS/Report/Table/Monthly.pm @@ -88,6 +88,13 @@ hidden rows (due to C) filtered out, which is the only reason to do this. Now that we have C it's probably better to use that. +=item PROCESSING + +=item normalize: Set this to an item index to have all other items expressed +as a percentage of that one. That item will then be omitted from the output. +If the normalization item is zero in some period, all the values in that +period will be undef. + =head1 RETURNED DATA The C method runs the report and returns a hashref of the following: @@ -180,7 +187,7 @@ sub data { my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); push @{$data{eperiod}}, $eperiod; - my $col = 0; + my $col = 0; # a "column" here is the data corresponding to an item my @items = @{$self->{'items'}}; my $i; @@ -214,7 +221,30 @@ sub data { $data{'colors'} = $self->{'colors'}; $data{'links'} = $self->{'links'} || []; - if ( !$self->{'cross_params'} and $self->{'remove_empty'} ) { + if ( defined $self->{'normalize'} ) { + my $norm_col = $self->{'normalize'}; + my $norm_data = $data{data}->[$norm_col]; + + my $row = 0; + while ( exists $data{speriod}->[$row] ) { + my $col = 0; + while ( exists $data{items}->[$col ] ) { + if ( $col != $norm_col ) { + if ( $norm_data->[$row] == 0 ) { + $data{data}->[$col][$row] = undef; + } else { + $data{data}->[$col][$row] = + ( $data{data}->[$col][$row] * 100 / $norm_data->[$row] ); + } + } + $col++; + } + $row++; + } + } + + if ( !$self->{'cross_params'} ) { + # remove unnecessary rows my $col = 0; #these need to get generalized, sheesh @@ -228,6 +258,12 @@ sub data { my @indices = (); foreach my $item ( @{$self->{'items'}} ) { + # if remove_empty, then remove rows of zeroes + my $is_nonzero = scalar( grep { $_ != 0 } @{ $data{'data'}->[$col] }); + next if ($self->{'remove_empty'} and $is_nonzero == 0); + # if normalizing, strip out the norm column + next if (defined($self->{'normalize'}) and $self->{'normalize'} == $col); + if ( grep { $_ != 0 } @{$data{'data'}->[$col]} ) { push @newitems, $data{'items'}->[$col]; push @newlabels, $data{'item_labels'}->[$col]; @@ -236,7 +272,7 @@ sub data { push @newlinks, $data{'links'}->[$col]; push @indices, $col; } - + } continue { $col++; } @@ -248,6 +284,7 @@ sub data { $data{'indices'} = \@indices; } + # clean up after ourselves #dbh->rollback; # leave in until development is finished, for diagnostics diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 4d6c2e9f2..0b82f91a5 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -4151,9 +4151,9 @@ sub tables_hashref { [ 'job' ], [ 'svcnum' ], [ 'custnum' ], [ 'status' ], ], 'foreign_keys' => [ - { columns => [ 'svcnum' ], - table => 'cust_svc', - }, +# { columns => [ 'svcnum' ], +# table => 'cust_svc', +# }, { columns => [ 'custnum' ], table => 'cust_main', }, @@ -4808,9 +4808,10 @@ sub tables_hashref { 'rate' => { 'columns' => [ - 'ratenum', 'serial', '', '', '', '', - 'ratename', 'varchar', '', $char_d, '', '', - 'agentnum', 'int', 'NULL', '', '', '', + 'ratenum', 'serial', '', '', '', '', + 'ratename', 'varchar', '',$char_d, '', '', + 'agentnum', 'int', 'NULL', '', '', '', + 'default_detailnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'ratenum', 'unique' => [], @@ -4827,7 +4828,7 @@ sub tables_hashref { 'ratedetailnum', 'serial', '', '', '', '', 'ratenum', 'int', '', '', '', '', 'orig_regionnum', 'int', 'NULL', '', '', '', - 'dest_regionnum', 'int', '', '', '', '', + 'dest_regionnum', 'int', 'NULL', '', '', '', 'min_included', 'int', '', '', '', '', 'conn_charge', 'decimal', '', '10,4', '0.0000', '', 'conn_cost', 'decimal', '', '10,4', '0.0000', '', @@ -4839,6 +4840,8 @@ sub tables_hashref { 'classnum', 'int', 'NULL', '', '', '', 'cdrtypenum', 'int', 'NULL', '', '', '', 'region_group', 'char', 'NULL', 1, '', '', + 'upstream_mult_charge', 'decimal', '', '10,4', '0.0000', '', + 'upstream_mult_cost', 'decimal', '', '10,4', '0.0000', '', ], 'primary_key' => 'ratedetailnum', 'unique' => [ [ 'ratenum', 'orig_regionnum', 'dest_regionnum' ] ], diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index 9859dfade..7a5668d52 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -799,8 +799,8 @@ sub rate_prefix { } + my $regionnum = $rate_detail->dest_regionnum; my $rate_region = $rate_detail->dest_region; - my $regionnum = $rate_region->regionnum; warn " found rate for regionnum $regionnum ". "and rate detail $rate_detail\n" if $DEBUG; @@ -842,6 +842,11 @@ sub rate_prefix { my $charge = 0; my $connection_charged = 0; + # before doing anything else, if there's an upstream multiplier and + # an upstream price, add that to the charge. (usually the rate detail + # will then have a minute charge of zero, but not necessarily.) + $charge += ($self->upstream_price || 0) * $rate_detail->upstream_mult_charge; + my $etime; while($seconds_left) { my $ratetimenum = $rate_detail->ratetimenum; # may be empty @@ -989,7 +994,7 @@ sub rate_prefix { $price, $opt{'svcnum'}, 'rated_pretty_dst' => $pretty_dst, - 'rated_regionname' => $rate_region->regionname, + 'rated_regionname' => ($rate_region ? $rate_region->regionname : ''), 'rated_seconds' => $rated_seconds, #$seconds, 'rated_granularity' => $rate_detail->sec_granularity, #$granularity 'rated_ratedetailnum' => $rate_detail->ratedetailnum, @@ -1073,10 +1078,15 @@ sub rate_cost { my $rate_detail = qsearchs('rate_detail', { 'ratedetailnum' => $self->rated_ratedetailnum } ); - return $rate_detail->min_cost if $self->rated_granularity == 0; + my $charge = 0; + $charge += ($self->upstream_price || 0) * ($rate_detail->upstream_mult_cost); - my $minutes = $self->rated_seconds / 60; - my $charge = $rate_detail->conn_cost + $minutes * $rate_detail->min_cost; + if ( $self->rated_granularity == 0 ) { + $charge += $rate_detail->min_cost; + } else { + my $minutes = $self->rated_seconds / 60; + $charge += $rate_detail->conn_cost + $minutes * $rate_detail->min_cost; + } sprintf('%.2f', $charge + .00001 ); diff --git a/FS/FS/cdr/zintel.pm b/FS/FS/cdr/zintel.pm index 1d2236c38..eb08038ff 100644 --- a/FS/FS/cdr/zintel.pm +++ b/FS/FS/cdr/zintel.pm @@ -16,7 +16,17 @@ use Date::Parse; 'accountcode', #customer 'src', #anumber - 'dst', #bnumber + sub { my ($cdr, $dst) = @_; # Handling cosolidated local calls in the CDR formats + + my $src = $cdr->src; + + if ($dst =~ /^64\/U$/) { + $cdr->set('dst', $src); + } else { + $cdr->set('dst', $dst); + } + }, #bnumber + sub { my ($cdr, $calldate) = @_; $cdr->set('calldate', $calldate); diff --git a/FS/FS/cust_pkg/Search.pm b/FS/FS/cust_pkg/Search.pm index 77196568b..9cd1ff063 100644 --- a/FS/FS/cust_pkg/Search.pm +++ b/FS/FS/cust_pkg/Search.pm @@ -281,6 +281,21 @@ sub search { } ### + # parse refnum (advertising source) + ### + + if ( exists($params->{'refnum'}) ) { + my @refnum; + if (ref $params->{'refnum'}) { + @refnum = @{ $params->{'refnum'} }; + } else { + @refnum = ( $params->{'refnum'} ); + } + my $in = join(',', grep /^\d+$/, @refnum); + push @where, "refnum IN($in)" if length $in; + } + + ### # parse package report options ### diff --git a/FS/FS/h_Common.pm b/FS/FS/h_Common.pm index ca13e1ba5..9b5ad09d9 100644 --- a/FS/FS/h_Common.pm +++ b/FS/FS/h_Common.pm @@ -110,6 +110,55 @@ sub sql_h_searchs { ($select, $where, $cacheobj, $as); } +=item sql_diff START_TIMESTAMP, END_TIMESTAMP[, WHERE] + +Returns a complete SQL statement to find all records that were changed +between START_TIMESTAMP and END_TIMESTAMP. This finds only replacements, +not new or deleted records. + +For each modified record, this will return I row (not two rows as in +the history table) with the primary key of the record, "old_historynum" +(the historynum of the last modification before START_TIMESTAMP), and +"new_historynum" (the last modification before END_TIMESTAMP). Join these +back to the h_* table to retrieve the actual field values. + +Within the query, the last history records as of START and END are aliased +as "old" and "new"; you can append a WHERE clause to take advantage of this. + +=cut + +sub sql_diff { + my $class = shift; + my $table = $class->table; + my ($real_table) = ($table =~ /^h_(\w+)$/); + my $pkey = dbdef->table($real_table)->primary_key; + my @fields = "FS::$real_table"->fields; + + my ($sdate, $edate) = @_; + ($sdate, $edate) = ($edate, $sdate) if $edate < $sdate; + + my @select = ( + "old.$pkey", + 'old.historynum AS old_historynum', + 'new.historynum AS new_historynum', + ); + my $new = + "SELECT DISTINCT ON ($pkey) * FROM $table + WHERE history_action = 'replace_new' + AND history_date >= $sdate AND history_date < $edate + ORDER BY $pkey ASC, history_date DESC"; + my $old = + "SELECT DISTINCT ON ($pkey) * FROM $table + WHERE (history_action = 'replace_new' OR history_action = 'insert') + AND history_date < $sdate + ORDER BY $pkey ASC, history_date DESC"; + + my $from = "($new) AS new JOIN ($old) AS old USING ($pkey)"; + + return "SELECT ".join(',', @select)." FROM $from"; +} + + =back =head1 BUGS diff --git a/FS/FS/h_cust_pkg.pm b/FS/FS/h_cust_pkg.pm index 99037c22f..0c3db107f 100644 --- a/FS/FS/h_cust_pkg.pm +++ b/FS/FS/h_cust_pkg.pm @@ -67,7 +67,7 @@ sub search { # make some adjustments $query->{'table'} = 'h_cust_pkg'; - foreach (qw(select addl_from extra_sql count_query)) { + foreach (qw(select addl_from extra_sql count_query order_by)) { $query->{$_} =~ s/cust_pkg\b/h_cust_pkg/g; $query->{$_} =~ s/cust_main\b/h_cust_main/g; } @@ -92,9 +92,95 @@ sub search { $query; } +=item churn_fromwhere_sql STATUS, START, END + +Returns SQL fragments to do queries related to "package churn". STATUS +is one of "active", "setup", "cancel", "susp", or "unsusp". These do NOT +correspond directly to package statuses. START and END define a date range. + +- active: limit to packages that were active on START. END is ignored. +- setup: limit to packages that were set up between START and END, except +those created by package changes. +- cancel: limit to packages that were canceled between START and END, except +those changed into other packages. +- susp: limit to packages that were suspended between START and END. +- unsusp: limit to packages that were unsuspended between START and END. + +The logic of these may change in the future, especially with respect to +package changes. Watch this space. + +Returns a list of: +- a fragment usable as a FROM clause (without the keyword FROM), in which + the package table is named or aliased to 'cust_pkg' +- one or more conditions to include in the WHERE clause + +=cut + +sub churn_fromwhere_sql { + my ($self, $status, $speriod, $eperiod) = @_; + + my ($from, @where); + if ( $status eq 'active' ) { + # for all packages that were setup before $speriod, find the pkgnum + # and the most recent update of the package before $speriod + my $setup_before = "SELECT DISTINCT ON (pkgnum) pkgnum, historynum + FROM h_cust_pkg + WHERE setup < $speriod + AND history_date < $speriod + AND history_action IN('insert', 'replace_new') + ORDER BY pkgnum ASC, history_date DESC"; + # for each of these, exclude if the package was suspended or canceled + # in the most recent update before $speriod + $from = "h_cust_pkg AS cust_pkg + JOIN ($setup_before) AS setup_before USING (historynum)"; + @where = ( 'susp IS NULL', 'cancel IS NULL' ); + } elsif ( $status eq 'setup' ) { + # the simple case, because packages should only get set up once + # (but exclude those that were created due to a package change) + # XXX or should we include if they were created by a pkgpart change? + $from = "cust_pkg"; + @where = ( + "setup >= $speriod", + "setup < $eperiod", + "change_pkgnum IS NULL" + ); + } elsif ( $status eq 'cancel' ) { + # also simple, because packages should only be canceled once + # (exclude those that were canceled due to a package change) + $from = "cust_pkg"; + @where = ( + "cust_pkg.cancel >= $speriod", + "cust_pkg.cancel < $eperiod", + "NOT EXISTS(SELECT 1 FROM cust_pkg AS changed_to_pkg ". + "WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum)", + ); + } elsif ( $status eq 'susp' ) { + # more complicated + # find packages that were changed from susp = null to susp != null + my $susp_during = $self->sql_diff($speriod, $eperiod) . + ' WHERE old.susp IS NULL AND new.susp IS NOT NULL'; + $from = "h_cust_pkg AS cust_pkg + JOIN ($susp_during) AS susp_during + ON (susp_during.new_historynum = cust_pkg.historynum)"; + @where = ( 'cust_pkg.cancel IS NULL' ); + } elsif ( $status eq 'unsusp' ) { + # similar to 'susp' + my $unsusp_during = $self->sql_diff($speriod, $eperiod) . + ' WHERE old.susp IS NOT NULL AND new.susp IS NULL'; + $from = "h_cust_pkg AS cust_pkg + JOIN ($unsusp_during) AS unsusp_during + ON (unsusp_during.new_historynum = cust_pkg.historynum)"; + @where = ( 'cust_pkg.cancel IS NULL' ); + } else { + die "'$status' makes no sense"; + } + return ($from, @where); +} =head1 BUGS +churn_fromwhere_sql fails on MySQL. + =head1 SEE ALSO L, L, L, schema.html from the base @@ -104,4 +190,3 @@ documentation. 1; - diff --git a/FS/FS/part_pkg/agent_cdr.pm b/FS/FS/part_pkg/agent_cdr.pm index 55792f2d2..a638b5b5a 100644 --- a/FS/FS/part_pkg/agent_cdr.pm +++ b/FS/FS/part_pkg/agent_cdr.pm @@ -23,7 +23,7 @@ tie my %temporalities, 'Tie::IxHash', %info = ( 'name' => 'Wholesale CDR cost billing, for master customers of an agent.', - 'shortname' => 'Whilesale CDR cost billing for agent.', + 'shortname' => 'Wholesale CDR cost billing for agent', 'inherit_fields' => [ 'prorate_Mixin', 'global_Mixin' ], 'fields' => { #false laziness w/cdr_termination @@ -177,7 +177,11 @@ sub calc_recur { my $classnum = ''; #usage class? #option to turn off? or just use squelch_cdr for the customer probably - push @$details, [ 'C', $call_details, $cost, $classnum ]; + # XXX use detail_format for this at some point + push @$details, { 'format' => 'C', + 'detail' => $call_details, + 'amount' => $cost, + 'classnum' => $classnum }; #eofalse laziness w/cdr_termination diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index aef9d8bec..9a5b90546 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -46,6 +46,16 @@ Rate name Optional agent (see L) for agent-virtualized rates. +=item default_detailnum + +Optional rate detail to apply when a call doesn't match any region in the +rate plan. If this is not set, the call will either be left unrated (though +it may still be processed under a different pricing addon package), or be +marked as 'skipped', or throw a fatal error, depending on the setting of +the 'ignore_unrateable' package option. + +=item + =back =head1 METHODS @@ -268,6 +278,7 @@ sub check { $self->ut_numbern('ratenum') || $self->ut_text('ratename') #|| $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_numbern('default_detailnum') ; return $error if $error; @@ -277,8 +288,8 @@ sub check { =item dest_detail REGIONNUM | RATE_REGION_OBJECTD | HASHREF Returns the rate detail (see L) for this rate to the -specificed destination, or the empty string if no rate can be found for -the given destination. +specificed destination. If no rate can be found, returns the default +rate if there is one, and an empty string otherwise. Destination can be specified as an FS::rate_detail object or regionnum (see L), or as a hashref containing the following keys: @@ -379,8 +390,8 @@ sub dest_detail { foreach (@details) { return $_ if $_->ratetimenum eq ''; } - # found nothing - return; + # if still nothing, return the global default rate for this plan + return $self->default_detail; } =item rate_detail @@ -389,6 +400,18 @@ Returns all region-specific details (see L) for this rate. =back +=item default_detail + +Returns the default rate detail, if there is one. + +=cut + +sub default_detail { + my $self = shift; + $self->default_detailnum ? + FS::rate_detail->by_key($self->default_detailnum) : '' +} + =head1 SUBROUTINES =over 4 diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm index d81d9dbda..d50c89f80 100644 --- a/FS/FS/rate_detail.pm +++ b/FS/FS/rate_detail.pm @@ -60,6 +60,13 @@ inherits from FS::Record. The following fields are currently supported: =item region_group - Group in region group for rate plan +=item upstream_mult_charge - the multiplier to apply to the upstream price. +Defaults to zero, and should stay zero unless this rate is intended to include +a markup on pre-rated CDRs. + +=item upstream_mult_cost - the multiplier to apply to the upstream price to +calculate the wholesale cost. + =back =head1 METHODS @@ -124,7 +131,7 @@ sub check { $self->ut_numbern('ratedetailnum') || $self->ut_foreign_key('ratenum', 'rate', 'ratenum') || $self->ut_foreign_keyn('orig_regionnum', 'rate_region', 'regionnum' ) - || $self->ut_foreign_key('dest_regionnum', 'rate_region', 'regionnum' ) + || $self->ut_foreign_keyn('dest_regionnum', 'rate_region', 'regionnum' ) || $self->ut_number('min_included') #|| $self->ut_money('min_charge') @@ -138,6 +145,9 @@ sub check { || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum' ) || $self->ut_enum('region_group', [ '', 'Y' ]) + + || $self->ut_floatn('upstream_mult_charge') + || $self->ut_floatn('upstream_mult_cost') ; return $error if $error; @@ -182,10 +192,11 @@ with this call plan rate. sub dest_regionname { my $self = shift; - $self->dest_region->regionname; + my $dest_region = $self->dest_region; + $dest_region ? $dest_region->regionname : 'Global default'; } -=item dest_regionname +=item dest_prefixes_short Returns a short list of the prefixes for the destination region (see L) associated with this call plan rate. @@ -194,7 +205,8 @@ Returns a short list of the prefixes for the destination region sub dest_prefixes_short { my $self = shift; - $self->dest_region->prefixes_short; + my $dest_region = $self->dest_region; + $dest_region ? $dest_region->prefixes_short : ''; } =item rate_time diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 4a2d61786..e4591720d 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -804,6 +804,9 @@ If there is an error, returns the error, otherwise returns false. =cut sub set_auto_inventory { + # don't try to do this during an upgrade + return '' if $FS::CurrentUser::upgrade_hack; + my $self = shift; my $old = @_ ? shift : ''; diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 50279172d..d773ff534 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -433,7 +433,9 @@ sub taxline { my $maxtype = $self->maxtype || 0; if ($maxtype != 0 && $maxtype != 1 - && $maxtype != 14 && $maxtype != 15) { + && $maxtype != 14 && $maxtype != 15 + && $maxtype != 18 # sigh + ) { return $self->_fatal_or_null( 'tax with "'. $self->maxtype_name. '" threshold' ); diff --git a/httemplate/edit/elements/rate_detail.html b/httemplate/edit/elements/rate_detail.html index 14b52110b..7b5ec314a 100644 --- a/httemplate/edit/elements/rate_detail.html +++ b/httemplate/edit/elements/rate_detail.html @@ -47,34 +47,85 @@ with row headers showing the region name and prefixes. % } % foreach my $rate_time (@rate_time, '') { -% my $detail = $details[$row][$col]; -% if($detail) { + <& .detail_box, + detail => $details[$row][$col], + ratetimenum => ($rate_time ? $rate_time->ratetimenum : ''), + cdrtypenum => $cdrtypenum, + regionnum => $region->regionnum, + ratenum => $rate->ratenum + &> +% $col++; + +% } # foreach @rate_time + +% $row++; +% }# foreach @rate_region +% if ( !$opt{regionnum} ) { +%# global default + + + Global default (for calls not matching any prefix) + + +% # default rate: set a null region + + <& .detail_box, + detail => $rate->default_detail, + ratetimenum => '', + cdrtypenum => '', + regionnum => '', + ratenum => $rate->ratenum + &> + + +% } + +<%def .detail_box> +<%args> +$detail => undef, +$ratetimenum +$cdrtypenum +$regionnum +$ratenum + +% if ($detail) { - <% granularity_detail($detail) %> <% min_included_detail($detail) %> <% conn_charge_detail($detail) %> -
<% edit_link($detail) %><% $money_char.$detail->min_charge %> +
<% edit_link($detail) %> +% if ( $detail->min_charge > 0 or $detail->conn_charge > 0) { + <% $money_char.$detail->min_charge %> <% $detail->sec_granularity ? ' / minute':' / call' %> % if ( $detail->min_cost ) { (<% $money_char.$detail->min_cost %> cost) % } +% if ( $detail->upstream_mult_charge > 0 +% or $detail->upstream_mult_cost > 0) { +
+ +% } +% } +% if ( $detail->upstream_mult_charge > 0 +% or $detail->upstream_mult_cost > 0) { + <% $detail->upstream_mult_charge %> × upstream price +% if ( $detail->upstream_mult_cost > 0 ) { + (<% $detail->upstream_mult_cost %> cost) +% } +% } +% if ( $detail->upstream_mult_charge == 0 +% and $detail->min_charge == 0 +% and $detail->conn_charge == 0 ) { + Free +% } <% $edit_hint %>
<% ( $rate_time || $cdrtypenum ) ? delete_link($detail) : '' %> +
<% ( $ratetimenum || $cdrtypenum ) ? delete_link($detail) : '' %>
-% } -% else { #!$detail - <% add_link($rate, $region, $rate_time, $cdrtypenum) %> -% } -% $col++; - -% } # foreach @rate_time - -% $row++; -% }# foreach @rate_region - - +% } else { + <% add_link($ratenum, $regionnum, $ratetimenum, $cdrtypenum) %> +% } + <%once> tie my %granularity, 'Tie::IxHash', FS::rate_detail::granularities(); @@ -95,25 +146,27 @@ sub edit_link { include( '/elements/popup_link_onclick.html', 'action' => "${p}edit/rate_detail.html?$ratedetailnum", 'actionlabel' => 'Edit rate', - 'height' => 460, + 'height' => 550, + 'width' => 580, #default# 'width' => 540, #default# 'color' => '#333399', ) . '">' } sub add_link { - my ($rate, $region, $rate_time, $cdrtypenum) = @_; + my ($ratenum, $regionnum, $ratetimenum, $cdrtypenum) = @_; ' 'Add rate', - 'height' => 460, + 'width' => 580, + 'height' => 550, ).'">'.small('(add)').'' } @@ -133,7 +186,10 @@ sub delete_link { sub granularity_detail { my $rate_detail = shift; - if($rate_detail->sec_granularity != 60 && $rate_detail->sec_granularity > 0) { + if( + $rate_detail->sec_granularity != 60 + && $rate_detail->sec_granularity > 0 + && $rate_detail->min_charge > 0) { ''. small('in '.$granularity{$rate_detail->sec_granularity}.' increments'). ''; diff --git a/httemplate/edit/process/rate_detail.html b/httemplate/edit/process/rate_detail.html index 6200d615f..0709d5079 100644 --- a/httemplate/edit/process/rate_detail.html +++ b/httemplate/edit/process/rate_detail.html @@ -1,13 +1,35 @@ -<% include( 'elements/process.html', - 'table' => 'rate_detail', - 'popup_reload' => 'Rate changed', #a popup "parent reload" for now +<& elements/process.html, + 'table' => 'rate_detail', + 'popup_reload' => 'Rate changed', #a popup "parent reload" for now #someday change the individual element and go away instead - ) -%> + 'noerror_callback' => $set_default_detail +&> <%init> my $conf = new FS::Conf; die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); +my $set_default_detail = sub { + my ($cgi, $rate_detail) = @_; +warn Dumper $rate_detail; + if (!$rate_detail->dest_regionnum) { + # then this is a global default rate + my $rate = $rate_detail->rate; + if ($rate->default_detailnum) { + if ($rate->default_detailnum == $rate_detail->ratedetailnum) { + return; + } else { + # there's somehow an existing default rate. remove it. + my $old_default = $rate->default_detail; + my $error = $old_default->delete; + die "$error (removing old default rate)\n" if $error; + } + } + $rate->set('default_detailnum' => $rate_detail->ratedetailnum); + my $error = $rate->replace; + die "$error (setting default rate)\n" if $error; + } +}; + diff --git a/httemplate/edit/rate_detail.html b/httemplate/edit/rate_detail.html index 0de6ecc1e..3e800726e 100644 --- a/httemplate/edit/rate_detail.html +++ b/httemplate/edit/rate_detail.html @@ -15,6 +15,8 @@ 'conn_cost' => 'Wholesale connection cost', 'min_cost' => 'Wholesale cost per minute/call', 'classnum' => 'Usage class', + 'upstream_mult_charge'=> 'Upstream multiplier (retail)', + 'upstream_mult_cost' => 'Upstream multiplier (cost)', }, 'fields' => [ { field=>'ratenum', type=>'hidden', }, @@ -46,13 +48,15 @@ labels => \%granularity, disable_empty => 1, }, - { field =>'classnum', - type =>'select-table', - table =>'usage_class', - name_col =>'classname', - empty_label =>'(default)', - hashref =>{ disabled => '' }, + { field => 'classnum', + type => 'select-table', + table => 'usage_class', + name_col => 'classname', + empty_label => '(default)', + hashref => { disabled => '' }, }, + { field => 'upstream_mult_charge', type => 'text', }, + { field => 'upstream_mult_cost', type => 'text', }, ], 'new_hashref_callback' => sub { @@ -62,6 +66,8 @@ cdrtypenum => scalar($cgi->param('cdrtypenum')), min_included => 0, conn_charge => 0, + upstream_mult_charge => 0, + upstream_mult_cost => 0, } }, ) @@ -85,8 +91,8 @@ if ( $keywords =~ /^(\d+)$/ || $cgi->param('ratedetailnum') =~ /^(\d+)$/ ) { my $rate_detail = qsearchs('rate_detail', { 'ratedetailnum' => $1 } ) or die "unknown ratedetailnum $1"; - $name = - $rate_detail->rate->ratename. ' rate for '. $rate_detail->dest_regionname; + $name = $rate_detail->rate->ratename. ' rate for '. + ($rate_detail->dest_regionname || 'global default'); } #sec_granularity should default to 60! for new rates when this gets used for em diff --git a/httemplate/graph/cust_pkg.cgi b/httemplate/graph/cust_pkg.cgi deleted file mode 100644 index cdd95e10a..000000000 --- a/httemplate/graph/cust_pkg.cgi +++ /dev/null @@ -1,161 +0,0 @@ -<& elements/monthly.html, - 'title' => $agentname. 'Package Churn', - 'items' => \@items, - 'labels' => \@labels, - 'graph_labels' => \@labels, - 'colors' => \@colors, - 'links' => \@links, - 'params' => \@params, - 'agentnum' => $agentnum, - 'sprintf' => '%u', - 'disable_money' => 1, - 'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0), -&> -<%init> - -#XXX use a different ACL for package churn? -my $curuser = $FS::CurrentUser::CurrentUser; -die "access denied" - unless $curuser->access_right('Financial reports'); - -#false laziness w/money_time.cgi, cust_bill_pkg.cgi - -#XXX or virtual -my( $agentnum, $agent ) = ('', ''); -if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) { - $agentnum = $1; - $agent = qsearchs('agent', { 'agentnum' => $agentnum } ); - die "agentnum $agentnum not found!" unless $agent; -} - -my $agentname = $agent ? $agent->agent.' ' : ''; - -my @base_items = qw( setup_pkg susp_pkg cancel_pkg ); - -my %base_labels = ( - 'setup_pkg' => 'New orders', - 'susp_pkg' => 'Suspensions', -# 'unsusp' => 'Unsuspensions', - 'cancel_pkg' => 'Cancellations', -); - -my %base_colors = ( - 'setup_pkg' => '00cc00', #green - 'susp_pkg' => 'ff9900', #yellow - #'unsusp' => '', #light green? - 'cancel_pkg' => 'cc0000', #red ? 'ff0000' -); - -my %base_links = ( - 'setup_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;", - 'fromparam' => 'setup_begin', - 'toparam' => 'setup_end', - }, - 'susp_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;", - 'fromparam' => 'susp_begin', - 'toparam' => 'susp_end', - }, - 'cancel_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;", - 'fromparam' => 'cancel_begin', - 'toparam' => 'cancel_end', - }, -); - -my %filter_params = ( - # not agentnum, that's elsewhere - 'refnum' => [ $cgi->param('refnum') ], - 'classnum' => [ $cgi->param('classnum') ], - 'towernum' => [ $cgi->param('towernum') ], -); -if ( $cgi->param('zip') =~ /^(\w+)/ ) { - $filter_params{zip} = $1; -} -foreach my $link (values %base_links) { - foreach my $key (keys(%filter_params)) { - my $value = $filter_params{$key}; - if (ref($value)) { - $value = join(',', @$value); - } - $link->{'link'} .= "$key=$value;" if length($value); - } -} - - -# In order to keep this from being the same trainwreck as cust_bill_pkg.cgi, -# we allow ONE breakdown axis, besides the setup/susp/cancel inherent in -# the report. - -my $breakdown = $cgi->param('breakdown_by'); -my ($name_col, $table); -if ($breakdown eq 'classnum') { - $table = 'pkg_class'; - $name_col = 'classname'; -} elsif ($breakdown eq 'refnum') { - $table = 'part_referral'; - $name_col = 'referral'; -} elsif ($breakdown eq 'towernum') { - $table = 'tower'; - $name_col = 'towername'; -} elsif ($breakdown) { - die "unknown breakdown column '$breakdown'\n"; -} - -my @group_keys; -my @group_labels; -if ( $table ) { - my @groups; - if ( $cgi->param($breakdown) ) { - foreach my $key ($cgi->param($breakdown)) { - next if $key =~ /\D/; - push @groups, qsearch( $table, { $breakdown => $key }); - } - } else { - @groups = qsearch( $table ); - } - foreach (@groups) { - push @group_keys, $_->get($breakdown); - push @group_labels, $_->get($name_col); - } -} - -my (@items, @labels, @colors, @links, @params); -if (scalar(@group_keys) > 1) { - my $hue = 180; - foreach my $key (@group_keys) { - # this gives a decent level of contrast as long as there aren't too many - # result sets - my $scheme = Color::Scheme->new - ->scheme('triade') - ->from_hue($hue) - ->distance(0.5); - my $label = shift @group_labels; - my $i = 0; # item index - foreach (@base_items) { - # append the item - push @items, $_; - # and its parameters - push @params, [ - %filter_params, - $breakdown => $key - ]; - # and a label prefixed with the group label - push @labels, "$label - $base_labels{$_}"; - # and colors (?!) - push @colors, $scheme->colorset->[$i]->[1]; - # and links... - my %this_link = %{ $base_links{$_} }; - $this_link{link} .= "$breakdown=$key;"; - push @links, \%this_link; - $i++; - } #foreach (@base_items - $hue += 35; - } # foreach @group_keys -} else { - @items = @base_items; - @labels = @base_labels{@base_items}; - @colors = @base_colors{@base_items}; - @links = @base_links{@base_items}; - @params = map { [ %filter_params ] } @base_items; -} - - diff --git a/httemplate/graph/cust_pkg.html b/httemplate/graph/cust_pkg.html new file mode 100644 index 000000000..3b6552ba8 --- /dev/null +++ b/httemplate/graph/cust_pkg.html @@ -0,0 +1,159 @@ +<& elements/monthly.html, + 'title' => $agentname. 'Package Churn', + 'items' => \@items, + 'labels' => \@labels, + 'graph_labels' => \@labels, + 'colors' => \@colors, + 'links' => \@links, + 'params' => \@params, + 'agentnum' => $agentnum, + 'sprintf' => ( $normalize ? '%0.1f%%' : '%u'), + 'normalize' => ( $normalize ? 0 : undef ), + 'disable_money' => 1, + 'remove_empty' => (scalar(@group_keys) > 1 ? 1 : 0), + 'nototal' => 1, + 'no_graph' => [ 1, 0, 0, 0, 0 ], # don't graph 'active' +&> +<%init> + +#XXX use a different ACL for package churn? +my $curuser = $FS::CurrentUser::CurrentUser; +die "access denied" + unless $curuser->access_right('Financial reports'); + +#false laziness w/money_time.cgi, cust_bill_pkg.cgi + +#XXX or virtual +my( $agentnum, $agent ) = ('', ''); +if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) { + $agentnum = $1; + $agent = qsearchs('agent', { 'agentnum' => $agentnum } ); + die "agentnum $agentnum not found!" unless $agent; +} + +my $agentname = $agent ? $agent->agent.' ' : ''; + +my @base_items = qw( active_pkg setup_pkg susp_pkg unsusp_pkg cancel_pkg ); + +my %base_labels = ( + 'active_pkg' => 'Active packages', + 'setup_pkg' => 'New orders', + 'susp_pkg' => 'Suspensions', + 'unsusp_pkg' => 'Unsuspensions', + 'cancel_pkg' => 'Cancellations', +); + +my %base_colors = ( + 'active_pkg' => '000000', #black + 'setup_pkg' => '00cc00', #green + 'susp_pkg' => 'ff9900', #yellow + 'unsusp_pkg' => '44ff44', #light green + 'cancel_pkg' => 'cc0000', #red +); + +my %base_links; +foreach my $status (qw(active setup cancel susp unsusp)) { + $base_links{$status.'_pkg'} = + "${p}search/cust_pkg_churn.html?agentnum=$agentnum;status=$status;"; +} + +my %filter_params = ( + # not agentnum, that's elsewhere + 'refnum' => [ $cgi->param('refnum') ], + 'classnum' => [ $cgi->param('classnum') ], + 'towernum' => [ $cgi->param('towernum') ], +); +if ( $cgi->param('zip') =~ /^(\w+)/ ) { + $filter_params{zip} = $1; +} +foreach my $link (values %base_links) { + foreach my $key (keys(%filter_params)) { + my $value = $filter_params{$key}; + if (ref($value)) { + $value = join(',', @$value); + } + $link .= "$key=$value;" if length($value); + } +} + + +# In order to keep this from being the same trainwreck as cust_bill_pkg.cgi, +# we allow ONE breakdown axis, besides the setup/susp/cancel inherent in +# the report. + +my $breakdown = $cgi->param('breakdown_by'); +my ($name_col, $table); +if ($breakdown eq 'classnum') { + $table = 'pkg_class'; + $name_col = 'classname'; +} elsif ($breakdown eq 'refnum') { + $table = 'part_referral'; + $name_col = 'referral'; +} elsif ($breakdown eq 'towernum') { + $table = 'tower'; + $name_col = 'towername'; +} elsif ($breakdown) { + die "unknown breakdown column '$breakdown'\n"; +} + +my @group_keys; +my @group_labels; +if ( $table ) { + my @groups; + if ( $cgi->param($breakdown) ) { + foreach my $key ($cgi->param($breakdown)) { + next if $key =~ /\D/; + push @groups, qsearch( $table, { $breakdown => $key }); + } + } else { + @groups = qsearch( $table ); + } + foreach (@groups) { + push @group_keys, $_->get($breakdown); + push @group_labels, $_->get($name_col); + } +} + +my (@items, @labels, @colors, @links, @params); +if (scalar(@group_keys) > 1) { + my $hue = 180; + foreach my $key (@group_keys) { + # this gives a decent level of contrast as long as there aren't too many + # result sets + my $scheme = Color::Scheme->new + ->scheme('triade') + ->from_hue($hue) + ->distance(0.5); + my $label = shift @group_labels; + my $i = 0; # item index + foreach (@base_items) { + # append the item + push @items, $_; + # and its parameters + push @params, [ + %filter_params, + $breakdown => $key + ]; + # and a label prefixed with the group label + push @labels, "$label - $base_labels{$_}"; + # and colors (?!) + push @colors, $scheme->colorset->[$i]->[1]; + # and links... + my $this_link = $base_links{$_}; + $this_link .= "$breakdown=$key;"; + push @links, $this_link; + $i++; + } #foreach (@base_items + $hue += 35; + } # foreach @group_keys +} else { + @items = @base_items; + @labels = @base_labels{@base_items}; + @colors = @base_colors{@base_items}; + @links = @base_links{@base_items}; + @params = map { [ %filter_params ] } @base_items; +} + +my $normalize = $cgi->param('normalize'); + + diff --git a/httemplate/graph/elements/monthly.html b/httemplate/graph/elements/monthly.html index 939f18a35..4b988f166 100644 --- a/httemplate/graph/elements/monthly.html +++ b/httemplate/graph/elements/monthly.html @@ -125,6 +125,7 @@ my %reportopts = ( 'cust_classnum'=> $opt{'cust_classnum'}, 'remove_empty' => $opt{'remove_empty'}, 'doublemonths' => $opt{'doublemonths'}, + 'normalize' => $opt{'normalize'}, ); warn Dumper({ 'REPORTOPTS' => \%reportopts }) if $opt{'debug'}; @@ -147,17 +148,12 @@ $col_labels = $data->{label} if $opt{'daily'}; my @colors; my @graph_labels; my @no_graph; -if ( $opt{'remove_empty'} ) { +#if ( $opt{'remove_empty'} ) { # no, always do this # then filter out per-item things for collapsed rows - foreach my $i (@{ $data->{'indices'} }) { - push @colors, $opt{'colors'}[$i]; - push @graph_labels, $opt{'graph_labels'}[$i]; - push @no_graph, $opt{'no_graph'}[$i]; - } -} else { - @colors = @{ $opt{'colors'} }; - @graph_labels = @{ $opt{'graph_labels'} }; - @no_graph = @{ $opt{'no_graph'} || [] }; +foreach my $i (@{ $data->{'indices'} }) { + push @colors, $opt{'colors'}[$i]; + push @graph_labels, $opt{'graph_labels'}[$i]; + push @no_graph, $opt{'no_graph'}[$i]; } my @links; diff --git a/httemplate/graph/elements/report.html b/httemplate/graph/elements/report.html index b3ba9ee22..cffc82816 100644 --- a/httemplate/graph/elements/report.html +++ b/httemplate/graph/elements/report.html @@ -108,11 +108,11 @@ any delimiter and linked from the elements in @data. % foreach ( @{ shift( @data ) } ) { % $total += $_; % $bottom_total[$col-1] += $_ unless $opt{no_graph}[$row]; -% $worksheet->write($row, $col++, sprintf($sprintf, $_) ); +% $worksheet->write_number($row, $col++, sprintf($sprintf, $_) ); % } % if ( !$opt{'nototal'} ) { % $bottom_total[$col-1] += $total unless $opt{no_graph}[$row]; -% $worksheet->write($row, $col++, sprintf($sprintf, $total) ); +% $worksheet->write_number($row, $col++, sprintf($sprintf, $total) ); % } % } % @@ -120,7 +120,7 @@ any delimiter and linked from the elements in @data. % if ( $opt{'bottom_total'} ) { % $row++; % $worksheet->write($row, $col++, 'Total'); -% $worksheet->write($row, $col++, sprintf($sprintf, $_)) foreach @bottom_total; +% $worksheet->write_number($row, $col++, sprintf($sprintf, $_)) foreach @bottom_total; % } % % $workbook->close();# or die "Error creating .xls file: $!"; diff --git a/httemplate/graph/report_cust_pkg.html b/httemplate/graph/report_cust_pkg.html index 1425ff089..0da5016a7 100644 --- a/httemplate/graph/report_cust_pkg.html +++ b/httemplate/graph/report_cust_pkg.html @@ -1,6 +1,6 @@ <% include('/elements/header.html', 'Package Churn Summary' ) %> -
+ @@ -54,6 +54,12 @@ }, &> +<& /elements/tr-checkbox.html, + 'field' => 'normalize', + 'value' => 1, + 'label' => 'Show percentages' +&> +

diff --git a/httemplate/search/cust_pkg_churn.html b/httemplate/search/cust_pkg_churn.html new file mode 100644 index 000000000..0ab99aa97 --- /dev/null +++ b/httemplate/search/cust_pkg_churn.html @@ -0,0 +1,186 @@ +<& elements/search.html, + 'title' => $title, + 'name' => 'packages', + 'query' => $sql_query, + 'count_query' => $count_query, + 'header' => [ emt('#'), + emt('Quantity'), + emt('Package'), + emt('Class'), + emt('Sales Person'), + emt('Ordered by'), + emt('Setup Fee'), + emt('Base Recur'), + emt('Freq.'), + emt('Setup'), + emt('Last bill'), + emt('Next bill'), + emt('Susp.'), + emt('Changed'), + emt('Cancel'), + #emt('Reason'), # hard to do this right + FS::UI::Web::cust_header( + $cgi->param('cust_fields') + ), + #emt('Services'), # even harder + ], + 'fields' => [ + 'pkgnum', + 'quantity', + 'pkg', + 'classname', + 'salesperson', + 'otaker', + sub { sprintf( $money_char.'%.2f', + shift->part_pkg->option('setup_fee'), + ); + }, + sub { my $c = shift; + sprintf( $money_char.'%.2f', + $c->part_pkg->base_recur($c) + ); + }, + sub { FS::part_pkg::freq_pretty(shift); }, + + ( map { time_or_blank($_) } + qw( setup last_bill bill susp change_date cancel ) ), + + \&FS::UI::Web::cust_fields, + ], + 'sort_fields' => [ + 'cust_pkg.pkgnum', + ('') x 5, # can use as-is + ('') x 3, # can't use at all + # use the plain SQL column names + qw( setup last_bill bill susp change_date cancel ), + # cust_fields can take care of themselves + ], + 'color' => [ + ('') x 15, + FS::UI::Web::cust_colors(), + ], + 'style' => [ ('') x 15, + FS::UI::Web::cust_styles() ], + 'size' => [ '', '', '', '', '-1' ], + 'align' => 'rrlcccrrlrrrrrr'. FS::UI::Web::cust_aligns(). 'r', + 'links' => [ + $link, + $link, + $link, + ('') x 12, + ( map { $_ ne 'Cust. Status' ? $clink : '' } + FS::UI::Web::cust_header( + $cgi->param('cust_fields') + ) + ), + ], +&> +<%once> +my %title = ( + 'active' => 'Active packages as of ', + 'setup' => 'Packages started between ', + 'cancel' => 'Packages canceled between ', + 'susp' => 'Packages suspended between ', + 'unsusp' => 'Packages unsuspended between ', +); + +<%init> + +my $curuser = $FS::CurrentUser::CurrentUser; + +die "access denied" + unless $curuser->access_right('List packages'); + +my $conf = new FS::Conf; +my $money_char = $conf->config('money_char') || '$'; + +my %search_hash = (); + +# pass a very limited set of parameters through +#scalars +for (qw( agentnum zip )) +{ + $search_hash{$_} = $cgi->param($_) if length($cgi->param($_)); +} + +#arrays / comma-separated lists +for my $param (qw( pkgpart classnum refnum towernum )) { + my @values = map { split(',') } $cgi->param($param); + $search_hash{$param} = \@values if scalar(@values); +} + +### +# do not pass dates to FS::cust_pkg->search; use the special churn_fromwhere +# logic. +### + +my $pkg_query = FS::cust_pkg->search(\%search_hash); +#warn Dumper $pkg_query; + +my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi); +my $status = $cgi->param('status'); + +my $title = emt($title{$status}) . + time2str('%b %o %Y', $beginning); +if ($status ne 'active') { + $title .= emt(' to ') . time2str('%b %o %Y', $ending); +} + +my ($from, @where) = FS::h_cust_pkg->churn_fromwhere_sql($status, $beginning, $ending); + +push @where, "freq != '0'"; + +# split off the primary table name +$from =~ s/^(\w+)(.*)$/$2/s; +my $table = $1; + +# merge with $pkg_query +$from .= ' ' . $pkg_query->{addl_from}; + +my $extra_sql; +if ($pkg_query->{extra_sql}) { + $extra_sql = $pkg_query->{extra_sql} . ' AND '; +} else { + $extra_sql = 'WHERE '; +} +$extra_sql .= join(' AND ', @where); + +my $sql_query = { + 'table' => $table, + 'addl_from' => $from, + 'extra_sql' => $extra_sql, +}; +warn (Dumper $sql_query) if $cgi->param('debug'); + +my $count_query = "SELECT COUNT(*) FROM $table $from $extra_sql"; + +my $show = $curuser->default_customer_view =~ /^(jumbo|packages)$/ + ? '' + : ';show=packages'; + +my $link = sub { + my $self = shift; + my $frag = 'cust_pkg'. $self->pkgnum; #hack for IE ignoring real #fragment + [ "${p}view/cust_main.cgi?custnum=".$self->custnum. + "$show;fragment=$frag#cust_pkg", + 'pkgnum' + ]; +}; + +my $clink = sub { + my $cust_pkg = shift; + $cust_pkg->cust_main_custnum + ? [ "${p}view/cust_main.cgi?", 'custnum' ] + : ''; +}; + +sub time_or_blank { + my $column = shift; + return sub { + my $record = shift; + my $value = $record->get($column); #mmm closures + $value ? time2str('%b %d %Y', $value ) : ''; + }; +} + +