X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=536cd8940beed2ffaea3db63d0f13647713fc9c8;hb=083d1fef19686b9b72f1b92e72a4fa56a3f392a9;hp=d4570f7fc3ceffeafab9e0abbfc131f3d8b09b02;hpb=6a24254d490f3d023728044daba0765f20f6971e;p=freeside.git diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index d4570f7fc..536cd8940 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -17,7 +17,7 @@ use FS::pkg_class; use FS::agent; use FS::part_pkg_taxoverride; use FS::part_pkg_taxproduct; -#XXX#use FS::part_pkg_link; +use FS::part_pkg_link; @ISA = qw( FS::m2m_Common FS::option_Common ); $DEBUG = 0; @@ -254,14 +254,17 @@ sub delete { Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -Currently available options are: I and I +Currently available options are: I, I and I If I is set to a hashref with svcparts as keys and quantities as -values, the appropriate FS::pkg_svc records will be replace. +values, the appropriate FS::pkg_svc records will be replaced. If I is set to the svcpart of the primary service, the appropriate FS::pkg_svc record will be updated. +If I is set to a hashref, the appropriate FS::part_pkg_option records +will be replaced. + =cut sub replace { @@ -276,6 +279,8 @@ sub replace { ? shift : { @_ }; + $options->{options} = {} unless defined($options->{options}); + warn "FS::part_pkg::replace called on $new to replace $old with options". join(', ', map "$_ => ". $options->{$_}, keys %$options) if $DEBUG; @@ -337,7 +342,13 @@ sub replace { my $pkg_svc = $options->{'pkg_svc'} || {}; foreach my $part_svc ( qsearch('part_svc', {} ) ) { my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; - my $primary_svc = $options->{'primary_svc'} == $part_svc->svcpart ? 'Y' : ''; + my $primary_svc = + ( defined($options->{'primary_svc'}) + && $options->{'primary_svc'} == $part_svc->svcpart + ) + ? 'Y' + : ''; + my $old_pkg_svc = qsearchs('pkg_svc', { 'pkgpart' => $old->pkgpart, @@ -411,6 +422,11 @@ sub check { || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->ut_floatn('pay_weight') || $self->ut_floatn('credit_weight') + || $self->ut_numbern('taxproductnum') + || $self->ut_foreign_keyn('taxproductnum', + 'part_pkg_taxproduct', + 'taxproductnum' + ) || $self->ut_agentnum_acl('agentnum', 'Edit global package definitions') || $self->SUPER::check ; @@ -465,6 +481,21 @@ sub pkg_class { } } +=item categoryname + +Returns the package category name, or the empty string if there is no package +category. + +=cut + +sub categoryname { + my $self = shift; + my $pkg_class = $self->pkg_class; + $pkg_class + ? $pkg_class->categoryname + : ''; +} + =item classname Returns the package class name, or the empty string if there is no package @@ -491,18 +522,46 @@ sub agent { qsearchs('agent', { 'agentnum' => $self->agentnum } ); } -=item pkg_svc +=item pkg_svc [ HASHREF | OPTION => VALUE ] Returns all FS::pkg_svc objects (see L) for this package definition (with non-zero quantity). +One option is available, I. If set true it will return the +services for this package definition alone, omitting services from any add-on +packages. + =cut sub pkg_svc { my $self = shift; - #sort { $b->primary cmp $a->primary } - grep { $_->quantity } - qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); + +# #sort { $b->primary cmp $a->primary } +# grep { $_->quantity } +# qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); + + my $opt = ref($_[0]) ? $_[0] : { @_ }; + my %pkg_svc = map { $_->svcpart => $_ } + grep { $_->quantity } + qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } ); + + unless ( $opt->{disable_linked} ) { + foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) { + my @pkg_svc = grep { $_->quantity } + qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } ); + foreach my $pkg_svc ( @pkg_svc ) { + if ( $pkg_svc{$pkg_svc->svcpart} ) { + my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity; + $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity); + } else { + $pkg_svc{$pkg_svc->svcpart} = $pkg_svc; + } + } + } + } + + values(%pkg_svc); + } =item svcpart [ SVCDB ] @@ -701,15 +760,43 @@ sub option { ''; } -=item dst_pkgpart +=item bill_part_pkg_link + +Returns the associated part_pkg_link records (see L_part_pkg_link('bill', @_); +} + +=item svc_part_pkg_link =cut -sub part_pkg_link { - (); - #XXX - #my $self = shift; - #qsearch('part_pkg_link', { 'src_pkgpart' => $self->pkgpart } ); +sub svc_part_pkg_link { + shift->_part_pkg_link('svc', @_); +} + +sub _part_pkg_link { + my( $self, $type ) = @_; + qsearch('part_pkg_link', { 'src_pkgpart' => $self->pkgpart, + 'link_type' => $type, + } + ); +} + +sub self_and_bill_linked { + shift->_self_and_linked('bill', @_); +} + +sub _self_and_linked { + my( $self, $type ) = @_; + + ( $self, + map { $_->dst_pkg->_self_and_linked($type) } + $self->_part_pkg_link($type) + ); } =item part_pkg_taxoverride @@ -747,25 +834,57 @@ specified by GEOCODE (see L and ). =cut +sub _expand_cch_taxproductnum { + my $self = shift; + my $part_pkg_taxproduct = + qsearchs( 'part_pkg_taxproduct', + { 'taxproductnum' => $self->taxproductnum } + ); + my ($a,$b,$c,$d) = ( $part_pkg_taxproduct + ? ( split ':', $part_pkg_taxproduct->taxproduct ) + : () + ); + my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d' + OR taxproduct = '$a:$b:$c:' + OR taxproduct = '$a:$b:".":$d' + OR taxproduct = '$a:$b:".":' )"; + map { $_->taxproductnum } qsearch( { 'table' => 'part_pkg_taxproduct', + 'hashref' => { 'data_vendor'=>'cch' }, + 'extra_sql' => $extra_sql, + } ); + +} + sub part_pkg_taxrate { my $self = shift; my ($data_vendor, $geocode) = @_; my $dbh = dbh; + my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '. + dbh->quote($data_vendor); + # CCH oddness in m2m - my $extra_sql = 'AND ('. + $extra_sql .= ' AND ('. join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) } qw(10 5 2) ). ')'; - my $order_by = 'ORDER BY taxclassnum, length(geocode) desc'; - my $select = 'DISTINCT ON(taxclassnum) *'; + # much more CCH oddness in m2m -- this is kludgy + $extra_sql .= ' AND ('. + join(' OR ', map{ "taxproductnum = $_" } $self->_expand_cch_taxproductnum). + ')'; + + my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )'; + my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc'; + my $select = 'DISTINCT ON(taxclassnum) *, taxproduct'; + # should qsearch preface columns with the table to facilitate joins? qsearch( { 'table' => 'part_pkg_taxrate', - 'select' => 'distinct on(taxclassnum) *', - 'hashref' => { 'data_vendor' => $data_vendor, - 'taxproductnum' => $self->taxproductnum, + 'select' => $select, + 'hashref' => { # 'data_vendor' => $data_vendor, + # 'taxproductnum' => $self->taxproductnum, }, + 'addl_from' => $addl_from, 'extra_sql' => $extra_sql, 'order_by' => $order_by, } ); @@ -830,6 +949,7 @@ sub _calc_eval { sub calc_remain { 0; } sub calc_cancel { 0; } +sub calc_units { 0; } =back @@ -909,6 +1029,7 @@ sub _upgrade_data { # class method =cut +#false laziness w/part_export & cdr my %info; foreach my $INC ( @INC ) { warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG; @@ -926,8 +1047,7 @@ foreach my $INC ( @INC ) { next; } unless ( keys %$info ) { - warn "no %info hash found in FS::part_pkg::$mod, skipping\n" - unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck + warn "no %info hash found in FS::part_pkg::$mod, skipping\n"; next; } warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG; @@ -940,7 +1060,7 @@ foreach my $INC ( @INC ) { } tie %plans, 'Tie::IxHash', - map { $_ => $info{$_} } + map { $_ => $info{$_} } sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} } keys %info; @@ -998,6 +1118,8 @@ FS::cust_bill. hmm.). now they're deprecated and need to go. plandata should go +part_pkg_taxrate is Pg specific + =head1 SEE ALSO L, L, L, L, L.