diff options
author | ivan <ivan> | 2009-10-29 01:08:33 +0000 |
---|---|---|
committer | ivan <ivan> | 2009-10-29 01:08:33 +0000 |
commit | 9d77a21db3642ca66d9a0e545b804b7e6b4090ee (patch) | |
tree | 8323e01c8e25420222c97b4e0ea87f89b73203fd /FS | |
parent | f274814c7cde3681578ca594a2b00475370e4c92 (diff) |
customer classification, RT#6376
Diffstat (limited to 'FS')
-rw-r--r-- | FS/FS.pm | 8 | ||||
-rw-r--r-- | FS/FS/Schema.pm | 28 | ||||
-rw-r--r-- | FS/FS/category_Common.pm | 87 | ||||
-rw-r--r-- | FS/FS/class_Common.pm | 143 | ||||
-rw-r--r-- | FS/FS/cust_category.pm | 97 | ||||
-rw-r--r-- | FS/FS/cust_class.pm | 120 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 2 | ||||
-rw-r--r-- | FS/FS/pkg_category.pm | 56 | ||||
-rw-r--r-- | FS/FS/pkg_class.pm | 62 | ||||
-rw-r--r-- | FS/MANIFEST | 4 | ||||
-rw-r--r-- | FS/t/cust_category.t | 5 | ||||
-rw-r--r-- | FS/t/cust_class.t | 5 |
12 files changed, 540 insertions, 77 deletions
@@ -73,6 +73,10 @@ L<FS::m2name_Common> - Base class for tables with a related table listing names L<FS::option_Common> - Base class for option sub-classes +L<FS::class_Common> - Base class for classification classes + +L<FS::category_Common> - Base class for category (grooups of classifications) classes + L<FS::conf> - Configuration value class L<FS::payinfo_Mixin> - Mixin class for records in tables that contain payinfo. @@ -234,6 +238,10 @@ L<FS::cust_main_Mixin> - Mixin class for records that contain fields from cust_m L<FS::cust_main_invoice> - Invoice destination class +L<FS::cust_class> - Customer classification class + +L<FS::cust_category> - Customer category class + L<FS::cust_main_exemption> - Customer tax exemption class L<FS::cust_main_note> - Customer note class diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 2b0ea90a5..faafcc6ef 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -685,6 +685,7 @@ sub tables_hashref { 'custnum', 'serial', '', '', '', '', 'agentnum', 'int', '', '', '', '', 'agent_custid', 'varchar', 'NULL', $char_d, '', '', + 'classnum', 'int', 'NULL', '', '', '', 'custbatch', 'varchar', 'NULL', $char_d, '', '', # 'titlenum', 'int', 'NULL', '', '', '', 'last', 'varchar', '', $char_d, '', '', @@ -752,7 +753,8 @@ sub tables_hashref { 'unique' => [ [ 'agentnum', 'agent_custid' ] ], #'index' => [ ['last'], ['company'] ], 'index' => [ - [ 'agentnum' ], [ 'refnum' ], [ 'custbatch' ], + [ 'agentnum' ], [ 'refnum' ], [ 'classnum' ], + [ 'custbatch' ], [ 'referral_custnum' ], [ 'payby' ], [ 'paydate' ], [ 'archived' ], @@ -841,6 +843,30 @@ sub tables_hashref { 'index' => [ [ 'custnum' ], [ '_date' ], ], }, + 'cust_category' => { + 'columns' => [ + 'categorynum', 'serial', '', '', '', '', + 'categoryname', 'varchar', '', $char_d, '', '', + 'weight', 'int', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'categorynum', + 'unique' => [], + 'index' => [ ['disabled'] ], + }, + + 'cust_class' => { + 'columns' => [ + 'classnum', 'serial', '', '', '', '', + 'classname', 'varchar', '', $char_d, '', '', + 'categorynum', 'int', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', + ], + 'primary_key' => 'classnum', + 'unique' => [], + 'index' => [ ['disabled'] ], + }, + 'cust_main_exemption' => { 'columns' => [ 'exemptionnum', 'serial', '', '', '', '', diff --git a/FS/FS/category_Common.pm b/FS/FS/category_Common.pm new file mode 100644 index 000000000..c239a7893 --- /dev/null +++ b/FS/FS/category_Common.pm @@ -0,0 +1,87 @@ +package FS::category_Common; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch ); + +=head1 NAME + +FS::category_Common - Base class for category (group of classifications) classes + +=head1 SYNOPSIS + +use base qw( FS::category_Common ); +use FS::class_table; #should use this + +#optional for non-standard names +sub _class_table { 'table_name'; } #default is to replace s/category/class/ + +=head1 DESCRIPTION + +FS::category_Common is a base class for classes which provide a categorization +(group of classifications) for other classes, such as pkg_category or +cust_category. + +=item delete + +Deletes this category from the database. Only categories with no associated +classifications can be deleted. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub delete { + my $self = shift; + + return "Can't delete a ". $self->table. + " with ". $self->_class_table. " records!" + if qsearch( $self->_class_table, { 'categorynum' => $self->categorynum } ); + + $self->SUPER::delete; +} + +=item check + +Checks all fields to make sure this is a valid package category. If there is an +error, returns the error, otherwise returns false. Called by the insert and +replace methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('categorynum') + or $self->ut_text('categoryname') + or $self->ut_snumbern('weight') + or $self->ut_enum('disabled', [ '', 'Y' ]) + or $self->SUPER::check; + +} + +=back + +=cut + +#defaults + +use vars qw( $_class_table ); +sub _class_table { + return $_class_table if $_class_table; + my $self = shift; + $_class_table = $self->table; + $_class_table =~ s/category/cclass/ # s/_category$/_class/ + or die "can't determine an automatic class table for $_class_table"; + $_class_table; +} + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/class_Common.pm b/FS/FS/class_Common.pm new file mode 100644 index 000000000..5ee8208f4 --- /dev/null +++ b/FS/FS/class_Common.pm @@ -0,0 +1,143 @@ +package FS::class_Common; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); + +=head1 NAME + +FS::class_Common - Base class for classification classes + +=head1 SYNOPSIS + +use base qw( FS::class_Common ); +use FS::category_table; #should use this + +#required +sub _target_table { 'table_name'; } + +#optional for non-standard names +sub _target_column { 'classnum'; } #default is classnum +sub _category_table { 'table_name'; } #default is to replace s/class/category/ + +=head1 DESCRIPTION + +FS::class_Common is a base class for classes which provide a classification for +other classes, such as pkg_class or cust_class. + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new classification. To add the classfication to the database, see +L<"insert">. + +=cut + +=item insert + +Adds this classification to the database. If there is an error, returns the +error, otherwise returns false. + +=item delete + +Deletes this classification from the database. Only classifications with no +associated target objects can be deleted. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub delete { + my $self = shift; + + return "Can't delete a ". $self->table. + " with ". $self->_target_table. " records!" + if qsearch( $self->_target_table, + { $self->_target_column => $self->classnum } + ); + + $self->SUPER::delete; +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid package classification. If +there is an error, returns the error, otherwise returns false. Called by the +insert and replace methods. + +=cut + +sub check { + my $self = shift; + + $self->ut_numbern('classnum') + or $self->ut_text('classname') + or $self->ut_foreign_keyn( 'categorynum', + $self->_category_table, + 'categorynum', + ) + or $self->ut_enum('disabled', [ '', 'Y' ] ) + or $self->SUPER::check; + +} + +=item category + +Returns the category record associated with this class, or false if there is +none. + +=cut + +sub category { + my $self = shift; + qsearchs($self->_category_table, { 'categorynum' => $self->categorynum } ); +} + +=item categoryname + +Returns the category name associated with this class, or false if there +is none. + +=cut + +sub categoryname { + my $category = shift->category; + $category ? $category->categoryname : ''; +} + +#required +sub _target_table { + my $self = shift; + die "_target_table unspecified for $self"; +} + +#defaults + +sub _target_column { 'classnum'; } + +use vars qw( $_category_table ); +sub _category_table { + return $_category_table if $_category_table; + my $self = shift; + $_category_table = $self->table; + $_category_table =~ s/class/category/ # s/_class$/_category/ + or die "can't determine an automatic category table for $_category_table"; + $_category_table; +} + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::category_Common>, L<FS::pkg_class>, L<FS::cust_class> + +=cut + +1; diff --git a/FS/FS/cust_category.pm b/FS/FS/cust_category.pm new file mode 100644 index 000000000..636b1d3de --- /dev/null +++ b/FS/FS/cust_category.pm @@ -0,0 +1,97 @@ +package FS::cust_category; + +use strict; +use base qw( FS::category_Common ); +use FS::cust_class; + +=head1 NAME + +FS::cust_category - Object methods for cust_category records + +=head1 SYNOPSIS + + use FS::cust_category; + + $record = new FS::cust_category \%hash; + $record = new FS::cust_category { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_category object represents a customer category. Every customer +class (see L<FS::cust_class>) has, optionally, a customer category. +FS::cust_category inherits from FS::Record. The following fields are currently +supported: + +=over 4 + +=item categorynum + +primary key + +=item categoryname + +Text name of this package category + +=item weight + +Weight + +=item disabled + +Disabled flag, empty or 'Y' + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new customer category. To add the customer category to the database, +see L<"insert">. + +=cut + +sub table { 'cust_category'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_class>, L<FS::Record> + +=cut + +1; + diff --git a/FS/FS/cust_class.pm b/FS/FS/cust_class.pm new file mode 100644 index 000000000..a811be7a7 --- /dev/null +++ b/FS/FS/cust_class.pm @@ -0,0 +1,120 @@ +package FS::cust_class; + +use strict; +use base qw( FS::class_Common ); +use FS::cust_main; +use FS::cust_category; + +=head1 NAME + +FS::cust_class - Object methods for cust_class records + +=head1 SYNOPSIS + + use FS::cust_class; + + $record = new FS::cust_class \%hash; + $record = new FS::cust_class { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::pkg_class object represents an customer class. Every customer (see +L<FS::cust_main>) has, optionally, a customer class. FS::cust_class inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item classnum + +primary key + +=item classname + +Text name of this customer class + +=item categorynum + +Number of associated cust_category (see L<FS::cust_category>) + +=item disabled + +Disabled flag, empty or 'Y' + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new customer class. To add the customer class to the database, see +L<"insert">. + +=cut + +sub table { 'cust_class'; } +sub _target_table { 'cust_main'; } + +=item insert + +Adds this customer class to the database. If there is an error, returns the +error, otherwise returns false. + +=item delete + +Delete this customer class from the database. Only customer classes with no +associated customers can be deleted. If there is an error, returns +the error, otherwise returns false. + +=item replace [ OLD_RECORD ] + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid customer class. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=item cust_category + +=item category + +Returns the cust_category record associated with this class, or false if there +is none. + +=cut + +sub cust_category { + my $self = shift; + $self->category; +} + +=item categoryname + +Returns the category name associated with this class, or false if there +is none. + +=cut + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_main>, L<FS::Record> + +=cut + +1; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 700e15a79..2c2984fa1 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -45,6 +45,7 @@ use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::cust_location; +use FS::cust_class; use FS::cust_main_exemption; use FS::cust_tax_adjustment; use FS::tax_rate; @@ -1537,6 +1538,7 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') diff --git a/FS/FS/pkg_category.pm b/FS/FS/pkg_category.pm index 0beaf1c11..15029719f 100644 --- a/FS/FS/pkg_category.pm +++ b/FS/FS/pkg_category.pm @@ -1,11 +1,12 @@ package FS::pkg_category; use strict; +use base qw( FS::category_Common ); use vars qw( @ISA $me $DEBUG ); use FS::Record qw( qsearch dbh ); +use FS::pkg_class; use FS::part_pkg; -@ISA = qw( FS::Record ); $DEBUG = 0; $me = '[FS::pkg_category]'; @@ -36,11 +37,21 @@ inherits from FS::Record. The following fields are currently supported: =over 4 -=item categorynum - primary key (assigned automatically for new package categoryes) +=item categorynum -=item categoryname - Text name of this package category +primary key (assigned automatically for new package categoryes) -=item disabled - Disabled flag, empty or 'Y' +=item categoryname + +Text name of this package category + +=item weight + +Weight + +=item disabled + +Disabled flag, empty or 'Y' =back @@ -50,8 +61,8 @@ inherits from FS::Record. The following fields are currently supported: =item new HASHREF -Creates a new package category. To add the package category to the database, see -L<"insert">. +Creates a new package category. To add the package category to the database, +see L<"insert">. =cut @@ -64,22 +75,11 @@ error, otherwise returns false. =item delete -Deletes this package category from the database. Only package categoryes with no -associated package definitions can be deleted. If there is an error, returns -the error, otherwise returns false. - -=cut - -sub delete { - my $self = shift; - - return "Can't delete an pkg_category with pkg_class records!" - if qsearch( 'pkg_class', { 'categorynum' => $self->categorynum } ); - - $self->SUPER::delete; -} +Deletes this package category from the database. Only package categoryes with +no associated package definitions can be deleted. If there is an error, +returns the error, otherwise returns false. -=item replace OLD_RECORD +=item replace [ OLD_RECORD ] Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -90,18 +90,6 @@ Checks all fields to make sure this is a valid package category. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('categorynum') - or $self->ut_text('categoryname') - or $self->ut_snumber('weight') - or $self->SUPER::check; - -} - # _ upgrade_data # # Used by FS::Upgrade to migrate to a new database. @@ -136,7 +124,7 @@ sub _upgrade_data { =head1 SEE ALSO -L<FS::Record>, L<FS::part_pkg>, schema.html from the base documentation. +L<FS::category_Common>, L<FS::Record> =cut diff --git a/FS/FS/pkg_class.pm b/FS/FS/pkg_class.pm index 254282fbf..51d0455a5 100644 --- a/FS/FS/pkg_class.pm +++ b/FS/FS/pkg_class.pm @@ -1,13 +1,11 @@ package FS::pkg_class; use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch ); +use FS::class_Common; +use base qw( FS::class_Common ); use FS::part_pkg; use FS::pkg_category; -@ISA = qw( FS::Record ); - =head1 NAME FS::pkg_class - Object methods for pkg_class records @@ -35,13 +33,21 @@ from FS::Record. The following fields are currently supported: =over 4 -=item classnum - primary key (assigned automatically for new package classes) +=item classnum + +primary key (assigned automatically for new package classes) + +=item classname + +Text name of this package class -=item classname - Text name of this package class +=item categorynum -=item categorynum - Number of associated pkg_category (see L<FS::pkg_category>) +Number of associated pkg_category (see L<FS::pkg_category>) -=item disabled - Disabled flag, empty or 'Y' +=item disabled + +Disabled flag, empty or 'Y' =back @@ -57,6 +63,7 @@ L<"insert">. =cut sub table { 'pkg_class'; } +sub _target_table { 'part_pkg'; } =item insert @@ -69,18 +76,7 @@ Deletes this package class from the database. Only package classes with no associated package definitions can be deleted. If there is an error, returns the error, otherwise returns false. -=cut - -sub delete { - my $self = shift; - - return "Can't delete an pkg_class with part_pkg records!" - if qsearch( 'part_pkg', { 'classnum' => $self->classnum } ); - - $self->SUPER::delete; -} - -=item replace OLD_RECORD +=item replace [ OLD_RECORD ] Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -91,20 +87,10 @@ Checks all fields to make sure this is a valid package class. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('classnum') - or $self->ut_text('classname') - or $self->ut_foreign_keyn('categorynum', 'pkg_category', 'categorynum') - or $self->SUPER::check; - -} - =item pkg_category +=item category + Returns the pkg_category record associated with this class, or false if there is none. @@ -112,7 +98,7 @@ is none. sub pkg_category { my $self = shift; - qsearchs('pkg_category', { 'categorynum' => $self->categorynum } ); + $self->category; } =item categoryname @@ -120,22 +106,14 @@ sub pkg_category { Returns the category name associated with this class, or false if there is none. -=cut - -sub categoryname { - my $pkg_category = shift->pkg_category; - $pkg_category->categoryname if $pkg_category; -} - =back =head1 BUGS =head1 SEE ALSO -L<FS::Record>, L<FS::part_pkg>, schema.html from the base documentation. +L<FS::part_pkg>, L<FS::Record> =cut 1; - diff --git a/FS/MANIFEST b/FS/MANIFEST index f5511f04d..d4e80e694 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -453,3 +453,7 @@ FS/cust_attachment.pm t/cust_attachment.t FS/cust_statement.pm t/cust_statement.t +FS/cust_class.pm +t/cust_class.t +FS/cust_category.pm +t/cust_category.t diff --git a/FS/t/cust_category.t b/FS/t/cust_category.t new file mode 100644 index 000000000..8cb0cd0a2 --- /dev/null +++ b/FS/t/cust_category.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_category; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/cust_class.t b/FS/t/cust_class.t new file mode 100644 index 000000000..ef7e82f98 --- /dev/null +++ b/FS/t/cust_class.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_class; +$loaded=1; +print "ok 1\n"; |