From 69bdaccf38c8f1b7471ff13354ccbcbb6aa20096 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Tue, 23 Sep 2014 14:34:00 -0700 Subject: [PATCH] package churn report filtering by advertising source, tower, and zip code, #26999 --- FS/FS/Report/Table.pm | 234 +++++++++++++++++++++++++++++----- FS/FS/cust_pkg.pm | 55 +++++++- httemplate/elements/select-table.html | 3 + httemplate/elements/select.html | 2 + httemplate/graph/cust_pkg.cgi | 134 ++++++++++++++++--- httemplate/graph/report_cust_pkg.html | 57 +++++++-- httemplate/search/cust_pkg.cgi | 4 +- 7 files changed, 426 insertions(+), 63 deletions(-) diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm index 924fd0506..98f66e904 100644 --- a/FS/FS/Report/Table.pm +++ b/FS/FS/Report/Table.pm @@ -1,15 +1,25 @@ package FS::Report::Table; use strict; -use vars qw( @ISA $DEBUG ); -use FS::Report; +use base 'FS::Report'; use Time::Local qw( timelocal ); use FS::UID qw( dbh driver_name ); use FS::Report::Table; use FS::CurrentUser; +use Cache::FileCache; -$DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy -@ISA = qw( FS::Report ); +our $DEBUG = 0; # turning this on will trace all SQL statements, VERY noisy + +our $CACHE; # feel free to use this for whatever + +FS::UID->install_callback(sub { + $CACHE = Cache::FileCache->new( { + 'namespace' => __PACKAGE__, + 'cache_root' => "$FS::UID::cache_dir/cache.$FS::UID::datasrc", + } ); + # reset this on startup (causes problems with database backups, etc.) + $CACHE->remove('tower_pkg_cache_update'); +}); =head1 NAME @@ -462,13 +472,10 @@ sub cust_bill_pkg_setup { $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), $self->in_time_period_and_agent($speriod, $eperiod, $agentnum), + $self->with_refnum(%opt), + $self->with_cust_classnum(%opt) ); - # yuck, false laziness - push @where, "cust_main.refnum = ". $opt{'refnum'} if $opt{'refnum'}; - - push @where, $self->with_cust_classnum(%opt); - my $total_sql = "SELECT COALESCE(SUM(cust_bill_pkg.setup),0) FROM cust_bill_pkg $cust_bill_pkg_join @@ -490,12 +497,10 @@ sub _cust_bill_pkg_recurring { '(pkgnum != 0 OR feepart IS NOT NULL)', $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_report_option(%opt), + $self->with_refnum(%opt), + $self->with_cust_classnum(%opt) ); - push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; - - push @where, $self->with_cust_classnum(%opt); - if ( $opt{'distribute'} ) { $where[0] = 'pkgnum != 0'; # specifically exclude fees push @where, "cust_main.agentnum = $agentnum" if $agentnum; @@ -574,16 +579,14 @@ sub cust_bill_pkg_detail { my @where = ( "(cust_bill_pkg.pkgnum != 0 OR cust_bill_pkg.feepart IS NOT NULL)" ); - push @where, 'cust_main.refnum = '. $opt{'refnum'} if $opt{'refnum'}; - - push @where, $self->with_cust_classnum(%opt); - $agentnum ||= $opt{'agentnum'}; push @where, $self->with_classnum($opt{'classnum'}, $opt{'use_override'}), $self->with_usageclass($opt{'usageclass'}), $self->with_report_option(%opt), + $self->with_refnum(%opt), + $self->with_cust_classnum(%opt) ; if ( $opt{'distribute'} ) { @@ -661,22 +664,91 @@ sub cust_bill_pkg_discount { } -sub setup_pkg { shift->pkg_field( 'setup', @_ ); } -sub susp_pkg { shift->pkg_field( 'susp', @_ ); } -sub cancel_pkg { shift->pkg_field( 'cancel', @_ ); } - -sub pkg_field { - my( $self, $field, $speriod, $eperiod, $agentnum ) = @_; - $self->scalar_sql(" - SELECT COUNT(*) FROM cust_pkg - LEFT JOIN cust_main USING ( custnum ) - WHERE ". $self->in_time_period_and_agent( $speriod, - $eperiod, - $agentnum, - "cust_pkg.$field", - ) +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; + } + ' 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: + +- refnum: Limit to customers with this advertising source. +- classnum: Limit to packages with this class. +- towernum: Limit to packages that have a broadband service with this tower. +- zip: Limit to packages with this service location zip code. + +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 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. + +=cut + +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->scalar_sql($sql); +} + +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->scalar_sql($sql); +} + +sub cancel_pkg { + # number of packages canceled in the period and not changed to another + # package + 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'; + + $self->scalar_sql($sql); } #this is going to be harder.. @@ -711,8 +783,11 @@ sub for_opts { if ( $opt{'custnum'} =~ /^(\d+)$/ ) { $sql .= " and custnum = $1 "; } - if ( $opt{'refnum'} =~ /^(\d+)$/ ) { - $sql .= " and refnum = $1 "; + if ( $opt{'refnum'} ) { + my $refnum = $opt{'refnum'}; + $refnum = [ $refnum ] if !ref($refnum); + my $in = join(',', grep /^\d+$/, @$refnum); + $sql .= " and refnum IN ($in)" if length $in; } if ( my $where = $self->with_cust_classnum(%opt) ) { $sql .= " and $where"; @@ -821,6 +896,49 @@ sub with_report_option { } +sub with_refnum { + my ($self, %opt) = @_; + if ( $opt{'refnum'} ) { + my $refnum = $opt{'refnum'}; + $refnum = [ $refnum ] if !ref($refnum); + my $in = join(',', grep /^\d+$/, @$refnum); + return "cust_main.refnum IN ($in)" if length $in; + } + return; +} + +sub with_towernum { + my ($self, %opt) = @_; + if ( $opt{'towernum'} ) { + my $towernum = $opt{'towernum'}; + $towernum = [ $towernum ] if !ref($towernum); + my $in = join(',', grep /^\d+$/, @$towernum); + return unless length($in); # if no towers are specified, don't restrict + + # materialize/cache the set of pkgnums that, as of the last + # svc_broadband history record, had a certain towernum + # (because otherwise this is painfully slow) + $self->_init_tower_pkg_cache; + + return "EXISTS( + SELECT 1 FROM tower_pkg_cache + WHERE towernum IN($in) + AND cust_pkg.pkgnum = tower_pkg_cache.pkgnum + )"; + } + return; +} + +sub with_zip { + my ($self, %opt) = @_; + if (length($opt{'zip'})) { + return "(SELECT zip FROM cust_location + WHERE cust_location.locationnum = cust_pkg.locationnum + ) = " . dbh->quote($opt{'zip'}); + } + return; +} + sub with_cust_classnum { my ($self, %opt) = @_; if ( $opt{'cust_classnum'} ) { @@ -830,7 +948,7 @@ sub with_cust_classnum { return 'cust_main.classnum in('. join(',',@$classnums) .')' if @$classnums; } - (); + return; } @@ -964,6 +1082,54 @@ sub extend_projection { } } +=item _init_tower_pkg_cache + +Internal method: creates a temporary table relating pkgnums to towernums. +A (pkgnum, towernum) record indicates that this package once had a +svc_broadband service which, as of its last insert or replace_new history +record, had a sectornum associated with that towernum. + +This is expensive, so it won't be done more than once an hour. Historical +data about package churn shouldn't be changing in realtime anyway. + +=cut + +sub _init_tower_pkg_cache { + my $self = shift; + my $dbh = dbh; + + my $current = $CACHE->get('tower_pkg_cache_update'); + return if $current; + + # XXX or should this be in the schema? + my $sql = "DROP TABLE IF EXISTS tower_pkg_cache"; + $dbh->do($sql) or die $dbh->errstr; + $sql = "CREATE TABLE tower_pkg_cache (towernum int, pkgnum int)"; + $dbh->do($sql) or die $dbh->errstr; + + # assumptions: + # sectornums never get reused, or move from one tower to another + # all service history is intact + # svcnums never get reused (this would be bad) + # pkgnums NEVER get reused (this would be extremely bad) + $sql = "INSERT INTO tower_pkg_cache ( + SELECT COALESCE(towernum,0), pkgnum + FROM ( SELECT DISTINCT pkgnum, svcnum FROM h_cust_svc ) AS pkgnum_svcnum + LEFT JOIN ( + SELECT DISTINCT ON(svcnum) svcnum, sectornum + FROM h_svc_broadband + WHERE (history_action = 'replace_new' + OR history_action = 'replace_old') + ORDER BY svcnum ASC, history_date DESC + ) AS svcnum_sectornum USING (svcnum) + LEFT JOIN tower_sector USING (sectornum) + )"; + $dbh->do($sql) or die $dbh->errstr; + + $CACHE->set('tower_pkg_cache_update', 1, 3600); + +}; + =head1 BUGS Documentation. diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index e0b0eaca7..ad530f7f3 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -4473,6 +4473,12 @@ Limit to packages whose locations have geocodes. Limit to packages whose locations do not have geocodes. +=item towernum + +Limit to packages associated with a svc_broadband, associated with a sector, +associated with this towernum (or any of these, if it's an arrayref) (or NO +towernum, if it's zero). This is an extreme niche case. + =back =cut @@ -4712,7 +4718,7 @@ sub search { } ### - # parse country/state + # parse country/state/zip ### for (qw(state country)) { # parsing rules are the same for these if ( exists($params->{$_}) @@ -4722,6 +4728,9 @@ sub search { push @where, "cust_location.$_ = '$1'"; } } + if ( exists($params->{zip}) ) { + push @where, "cust_location.zip = " . dbh->quote($params->{zip}); + } ### # location_* flags @@ -4794,6 +4803,9 @@ sub search { "NOT (".FS::cust_pkg->onetime_sql . ")"; } else { + my $exclude_change_from = 0; + my $exclude_change_to = 0; + foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) { next unless exists($params->{$field}); @@ -4809,6 +4821,27 @@ sub search { $orderby ||= "ORDER BY cust_pkg.$field"; + if ( $field eq 'setup' ) { + $exclude_change_from = 1; + } elsif ( $field eq 'cancel' ) { + $exclude_change_to = 1; + } elsif ( $field eq 'change_date' ) { + # if we are given setup and change_date ranges, and the setup date + # falls in _both_ ranges, then include the package whether it was + # a change or not + $exclude_change_from = 0; + } + } + + if ($exclude_change_from) { + push @where, "change_pkgnum IS NULL"; + } + if ($exclude_change_to) { + # a join might be more efficient here + push @where, "NOT EXISTS( + SELECT 1 FROM cust_pkg AS changed_to_pkg + WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum + )"; } } @@ -4848,6 +4881,26 @@ sub search { } ## + # parse the extremely weird 'towernum' param + ## + + if ($params->{towernum}) { + my $towernum = $params->{towernum}; + $towernum = [ $towernum ] if !ref($towernum); + my $in = join(',', grep /^\d+$/, @$towernum); + if (length $in) { + # inefficient, but this is an obscure feature + eval "use FS::Report::Table"; + FS::Report::Table->_init_tower_pkg_cache; # probably does nothing + push @where, "EXISTS( + SELECT 1 FROM tower_pkg_cache + WHERE tower_pkg_cache.pkgnum = cust_pkg.pkgnum + AND tower_pkg_cache.towernum IN ($in) + )" + } + } + + ## # setup queries, links, subs, etc. for the search ## diff --git a/httemplate/elements/select-table.html b/httemplate/elements/select-table.html index 9f26a3591..e73638801 100644 --- a/httemplate/elements/select-table.html +++ b/httemplate/elements/select-table.html @@ -70,6 +70,7 @@ Example: NAME = "<% $opt{'element_name'} || $opt{'field'} || $key %>" ID = "<% $opt{'id'} || $key %>" <% $onchange %> + <% $size %> <% $opt{'element_etc'} %> > @@ -212,4 +213,6 @@ unless ( !ref($value) && $value < 1 # !$value #ignore negatives too my @pre_options = $opt{pre_options} ? @{ $opt{pre_options} } : (); my @post_options = $opt{post_options} ? @{ $opt{post_options} } : (); +my $size = $opt{'size'} ? 'SIZE=' . $opt{'size'} : ''; + diff --git a/httemplate/elements/select.html b/httemplate/elements/select.html index efcf27b0e..67ef51418 100644 --- a/httemplate/elements/select.html +++ b/httemplate/elements/select.html @@ -4,6 +4,7 @@ ID = "<% $opt{id} %>" previousValue = "<% $curr_value %>" previousText = "<% $labels->{$curr_value} || $curr_value %>" + <% $size %> <% $style %> <% $opt{disabled} %> <% $onchange %> @@ -71,5 +72,6 @@ my @style = ref($opt{'style'}) my $style = scalar(@style) ? 'STYLE="'. join(';', @style). '"' : ''; +my $size = $opt{'size'} ? 'SIZE='.$opt{'size'} : ''; diff --git a/httemplate/graph/cust_pkg.cgi b/httemplate/graph/cust_pkg.cgi index 21ce07d21..cdd95e10a 100644 --- a/httemplate/graph/cust_pkg.cgi +++ b/httemplate/graph/cust_pkg.cgi @@ -1,20 +1,22 @@ -<% include('elements/monthly.html', - 'title' => $agentname. 'Package Churn', - 'items' => \@items, - 'labels' => \%label, - 'graph_labels' => \%graph_label, - 'colors' => \%color, - 'links' => \%link, - 'agentnum' => $agentnum, - 'sprintf' => '%u', - 'disable_money' => 1, - ) -%> +<& 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 $FS::CurrentUser::CurrentUser->access_right('Financial reports'); + unless $curuser->access_right('Financial reports'); #false laziness w/money_time.cgi, cust_bill_pkg.cgi @@ -28,24 +30,23 @@ if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) { my $agentname = $agent ? $agent->agent.' ' : ''; -my @items = qw( setup_pkg susp_pkg cancel_pkg ); +my @base_items = qw( setup_pkg susp_pkg cancel_pkg ); -my %label = ( +my %base_labels = ( 'setup_pkg' => 'New orders', 'susp_pkg' => 'Suspensions', # 'unsusp' => 'Unsuspensions', 'cancel_pkg' => 'Cancellations', ); -my %graph_label = %label; -my %color = ( +my %base_colors = ( 'setup_pkg' => '00cc00', #green 'susp_pkg' => 'ff9900', #yellow #'unsusp' => '', #light green? 'cancel_pkg' => 'cc0000', #red ? 'ff0000' ); -my %link = ( +my %base_links = ( 'setup_pkg' => { 'link' => "${p}search/cust_pkg.cgi?agentnum=$agentnum;", 'fromparam' => 'setup_begin', 'toparam' => 'setup_end', @@ -60,4 +61,101 @@ my %link = ( }, ); +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/report_cust_pkg.html b/httemplate/graph/report_cust_pkg.html index 22ccd5def..1425ff089 100644 --- a/httemplate/graph/report_cust_pkg.html +++ b/httemplate/graph/report_cust_pkg.html @@ -2,16 +2,57 @@
- +
-<% include('/elements/tr-select-from_to.html' ) %> +<& /elements/tr-select-from_to.html &> -<% include('/elements/tr-select-agent.html', - 'curr_value' => scalar($cgi->param('agentnum')), - 'label' => 'For agent: ', - 'disable_empty' => 0, - ) -%> +<& /elements/tr-select-agent.html, + 'curr_value' => scalar($cgi->param('agentnum')), + 'label' => 'For agent: ', + 'disable_empty' => 0, +&> + +<& /elements/tr-select-pkg_class.html, + 'multiple' => 1, + 'pre_options' => [ '0' => '(empty class)' ], + 'disable_empty' => 1, +&> + +<& /elements/tr-select-part_referral.html, + 'multiple' => 1, + 'disable_empty' => 1, +&> + +<& /elements/tr-select-table.html, + 'label' => 'Tower', + 'table' => 'tower', + 'field' => 'towernum', + 'name_col' => 'towername', + 'multiple' => 1, + 'pre_options' => [ 0 => '(none)' ], + 'size' => 8, + 'hashref' => { disabled => '' }, +&> + +<& /elements/tr-input-text.html, + 'field' => 'zip', + 'label' => 'Zip', +&> + +<& /elements/tablebreak-tr-title.html, + 'value' => mt('Display options') +&> + +<& /elements/tr-select.html, + 'field' => 'breakdown_by', + 'label' => 'Breakdown by: ', + 'options' => [ '', 'classnum', 'refnum', 'towernum' ], + 'labels' => { '' => '(none)', + 'classnum' => 'Package class', + 'refnum' => 'Advertising source', + 'towernum' => 'Tower', + }, +&>
diff --git a/httemplate/search/cust_pkg.cgi b/httemplate/search/cust_pkg.cgi index 54bfa00bf..c38848721 100755 --- a/httemplate/search/cust_pkg.cgi +++ b/httemplate/search/cust_pkg.cgi @@ -157,14 +157,14 @@ $search_hash{'query'} = $cgi->keywords; #scalars for (qw( agentnum cust_status cust_main_salesnum salesnum custnum magic status - custom cust_fields pkgbatch + custom cust_fields pkgbatch zip )) { $search_hash{$_} = $cgi->param($_) if length($cgi->param($_)); } #arrays -for my $param (qw( pkgpart classnum )) { +for my $param (qw( pkgpart classnum refnum towernum )) { $search_hash{$param} = [ $cgi->param($param) ] if grep { $_ eq $param } $cgi->param; } -- 2.11.0