From 7c12696f0598ca04c56699e8e6ff4c307000affa Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 21 Mar 2010 23:13:26 +0000 Subject: connection fee for initial N seconds support, RT#7018 --- FS/FS/Schema.pm | 19 ++++++++++--------- FS/FS/part_pkg/voip_cdr.pm | 10 ++++++++-- FS/FS/rate_detail.pm | 31 +++++++++++++++++++++++++++++-- 3 files changed, 47 insertions(+), 13 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 46ad18a2f..91786fc5c 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1969,16 +1969,17 @@ sub tables_hashref { 'rate_detail' => { 'columns' => [ - 'ratedetailnum', 'serial', '', '', '', '', - 'ratenum', 'int', '', '', '', '', - 'orig_regionnum', 'int', 'NULL', '', '', '', - 'dest_regionnum', 'int', '', '', '', '', - 'min_included', 'int', '', '', '', '', - #'min_charge', @money_type, '', '', - 'min_charge', 'decimal', '', '10,5', '', '', - 'sec_granularity', 'int', '', '', '', '', + 'ratedetailnum', 'serial', '', '', '', '', + 'ratenum', 'int', '', '', '', '', + 'orig_regionnum', 'int', 'NULL', '', '', '', + 'dest_regionnum', 'int', '', '', '', '', + 'min_included', 'int', '', '', '', '', + 'conn_charge', @money_type, '0', '', #'decimal','','10,5','0','', + 'conn_sec', 'int', '', '', '0', '', + 'min_charge', 'decimal', '', '10,5', '', '', #@money_type, '', '', + 'sec_granularity', 'int', '', '', '', '', #time period (link to table of periods)? - 'classnum', 'int', 'NULL', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'ratedetailnum', 'unique' => [ [ 'ratenum', 'orig_regionnum', 'dest_regionnum' ] ], diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index 0c87581ed..38e5941a9 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -535,6 +535,9 @@ sub calc_usage { # length($cdr->billsec) ? $cdr->billsec : $cdr->duration; $seconds = $use_duration ? $cdr->duration : $cdr->billsec; + $seconds -= $rate_detail->conn_sec; + $seconds = 0 if $seconds < 0; + $seconds += $granularity - ( $seconds % $granularity ) if $seconds # don't granular-ize 0 billsec calls (bills them) && $granularity; # 0 is per call @@ -546,12 +549,15 @@ sub calc_usage { $included_min{$regionnum} -= $minutes; + $charge = sprintf('%.2f', $rate_detail->conn_charge); + if ( $included_min{$regionnum} < 0 ) { my $charge_min = 0 - $included_min{$regionnum}; #XXX should preserve #(display?) this $included_min{$regionnum} = 0; - $charge = sprintf('%.2f', ( $rate_detail->min_charge * $charge_min ) - + 0.00000001 ); #so 1.005 rounds to 1.01 + $charge += sprintf('%.2f', ($rate_detail->min_charge * $charge_min) + + 0.00000001 ); #so 1.005 rounds to 1.01 + $charge = sprintf('%.2f', $charge); $charges += $charge; } diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm index b7b23babe..f6cdedf6e 100644 --- a/FS/FS/rate_detail.pm +++ b/FS/FS/rate_detail.pm @@ -232,6 +232,31 @@ sub granularities { %granularities; } +=item conn_secs + + Returns an (ordered) hash of conn_sec => name pairs + +=cut + +tie my %conn_secs, 'Tie::IxHash', + '0' => 'connection', + '1' => 'first second', + '6' => 'first 6 seconds', + '30' => 'first 30 seconds', # '1/2 minute', + '60' => 'first minute', + '120' => 'first 2 minutes', + '180' => 'first 3 minutes', + '300' => 'first 5 minutes', +; + +sub conn_secs { + %conn_secs; +} + +=item process_edit_import + +=cut + use Storable qw(thaw); use Data::Dumper; use MIME::Base64; @@ -311,6 +336,10 @@ sub process_edit_import { } +=item edit_import + +=cut + #false laziness w/ #FS::Record::batch_import, grep "edit_import" for differences #could be turned into callbacks or something use Text::CSV_XS; @@ -569,8 +598,6 @@ sub edit_import { } - - =back =head1 BUGS -- cgit v1.2.1 From 4a4a31ca7dcb01990a7e1d0e40a2f89adf34a25a Mon Sep 17 00:00:00 2001 From: jeff Date: Mon, 22 Mar 2010 14:08:57 +0000 Subject: fix restore of setup and recur taxproducts on tax data replacement --- FS/FS/tax_rate.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 45f3f5814..10e19487f 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -1263,7 +1263,7 @@ sub _remember_tax_products { if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format; foreach my $option ( $part_pkg->part_pkg_option ) { - next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/; + next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/; my $class = $1; $part_pkg_taxproduct = $part_pkg->taxproduct($class); -- cgit v1.2.1 From f46056f1423db7b7daf4a43f11610e1d961823af Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 23 Mar 2010 03:48:02 +0000 Subject: adding svc_mailinglist for communigate "groups" (mailing lists), RT#7514 --- FS/FS/Schema.pm | 39 ++++++ FS/FS/mailinglist.pm | 163 ++++++++++++++++++++++ FS/FS/mailinglistmember.pm | 150 +++++++++++++++++++++ FS/FS/svc_mailinglist.pm | 330 +++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 6 + FS/t/mailinglist.t | 5 + FS/t/mailinglistmember.t | 5 + FS/t/svc_mailinglist.t | 5 + 8 files changed, 703 insertions(+) create mode 100644 FS/FS/mailinglist.pm create mode 100644 FS/FS/mailinglistmember.pm create mode 100644 FS/FS/svc_mailinglist.pm create mode 100644 FS/t/mailinglist.t create mode 100644 FS/t/mailinglistmember.t create mode 100644 FS/t/svc_mailinglist.t (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 91786fc5c..8cadaa76c 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2554,6 +2554,45 @@ sub tables_hashref { 'index' => [ [ 'id' ] ], }, + 'svc_mailinglist' => { #svc_group? + 'columns' => [ + 'svcnum', 'int', '', '', '', '', + 'username', 'varchar', '', $username_len, '', '', + 'domsvc', 'int', '', '', '', '', + 'listnum', 'int', '', '', '', '', + 'reply_to', 'char', 'NULL', 1, '', '',#SetReplyTo + 'remove_from', 'char', 'NULL', 1, '', '',#RemoveAuthor + 'reject_auto', 'char', 'NULL', 1, '', '',#RejectAuto + 'remove_to_and_cc', 'char', 'NULL', 1, '', '',#RemoveToAndCc + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ ['username'], ['domsvc'], ['listnum'] ], + }, + + 'mailinglist' => { + 'columns' => [ + 'listnum', 'serial', '', '', '', '', + 'listname', 'varchar', '', $char_d, '', '', + ], + 'primary_key' => 'listnum', + 'unique' => [], + 'index' => [], + }, + + 'mailinglistmember' => { + 'columns' => [ + 'membernum', 'serial', '', '', '', '', + 'listnum', 'int', '', '', '', '', + 'svcnum', 'int', 'NULL', '', '', '', + 'contactemailnum', 'int', 'NULL', '', '', '', + 'email', 'varchar', 'NULL', 255, '', '', + ], + 'primary_key' => 'membernum', + 'unique' => [], + 'index' => [['listnum'],['svcnum'],['contactemailnum'],['email']], + }, + # name type nullability length default local diff --git a/FS/FS/mailinglist.pm b/FS/FS/mailinglist.pm new file mode 100644 index 000000000..db1502c53 --- /dev/null +++ b/FS/FS/mailinglist.pm @@ -0,0 +1,163 @@ +package FS::mailinglist; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch dbh ); # qsearchs ); +use FS::mailinglistmember; + +=head1 NAME + +FS::mailinglist - Object methods for mailinglist records + +=head1 SYNOPSIS + + use FS::mailinglist; + + $record = new FS::mailinglist \%hash; + $record = new FS::mailinglist { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::mailinglist object represents a mailing list FS::mailinglist inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item listnum + +primary key + +=item listname + +Mailing list name + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new mailing list. To add the mailing list to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'mailinglist'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $member ( $self->mailinglistmember ) { + my $error = $member->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=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. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid mailing list. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('listnum') + || $self->ut_text('listname') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item mailinglistmember + +=cut + +sub mailinglistmember { + my $self = shift; + qsearch('mailinglistmember', { 'listnum' => $self->listnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/mailinglistmember.pm b/FS/FS/mailinglistmember.pm new file mode 100644 index 000000000..ca73b888b --- /dev/null +++ b/FS/FS/mailinglistmember.pm @@ -0,0 +1,150 @@ +package FS::mailinglistmember; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearchs ); # qsearch ); +use FS::mailinglist; +use FS::svc_acct; +use FS::contact_email; + +=head1 NAME + +FS::mailinglistmember - Object methods for mailinglistmember records + +=head1 SYNOPSIS + + use FS::mailinglistmember; + + $record = new FS::mailinglistmember \%hash; + $record = new FS::mailinglistmember { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::mailinglistmember object represents a mailing list member. +FS::mailinglistmember inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item membernum + +primary key + +=item listnum + +listnum + +=item svcnum + +svcnum + +=item contactemailnum + +contactemailnum + +=item email + +email + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new mailing list member. To add the member to the database, see + L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'mailinglistmember'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=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. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid member. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('membernum') + || $self->ut_foreign_key('listnum', 'mailinglist', 'listnum') + || $self->ut_foreign_keyn('svcnum', 'svc_acct', 'svcnum') + || $self->ut_foreign_keyn('contactemailnum', 'contact_email', 'contactemailnum') + || $self->ut_textn('email') #XXX ut_email! from svc_forward, cust_main_invoice + ; + return $error if $error; + + $self->SUPER::check; +} + +=item mailinglist + +=cut + +sub mailinglist { + my $self = shift; + qsearchs('mailinglist', { 'listnum' => $self->listnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_mailinglist.pm b/FS/FS/svc_mailinglist.pm new file mode 100644 index 000000000..9c1a09ddb --- /dev/null +++ b/FS/FS/svc_mailinglist.pm @@ -0,0 +1,330 @@ +package FS::svc_mailinglist; + +use strict; +use base qw( FS::svc_Domain_Mixin FS::svc_Common ); +use FS::Record qw( qsearchs dbh ); # qsearch ); +use FS::svc_domain; +use FS::mailinglist; + +=head1 NAME + +FS::svc_mailinglist - Object methods for svc_mailinglist records + +=head1 SYNOPSIS + + use FS::svc_mailinglist; + + $record = new FS::svc_mailinglist \%hash; + $record = new FS::svc_mailinglist { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_mailinglist object represents a mailing list customer service. +FS::svc_mailinglist inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item svcnum + +primary key + +=item username + +username + +=item domsvc + +domsvc + +=item listnum + +listnum + +=item reply_to_group + +reply_to_group + +=item remove_author + +remove_author + +=item reject_auto + +reject_auto + +=item remove_to_and_cc + +remove_to_and_cc + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'svc_mailinglist'; } + +sub table_info { + { + 'name' => 'Mailing list', + 'display_weight' => 80, + 'cancel_weight' => 55, + 'fields' => { + 'username' => { 'label' => 'List address', + 'disable_default' => 1, + 'disable_fixed' => 1, + 'disable_inventory' => 1, + }, + 'domsvc' => { 'label' => 'List address domain', + 'disable_inventory' => 1, + }, + 'domain' => 'List address domain', + 'listnum' => { 'label' => 'List name', + 'disable_inventory' => 1, + }, + 'listname' => 'List name', #actually mailinglist.listname + 'reply_to' => { 'label' => 'Reply-To list', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'remove_from' => { 'label' => 'Remove From: from messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'reject_auto' => { 'label' => 'Reject automatic messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'remove_to_and_cc' => { 'label' => 'Remove To: and Cc: from messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + }, + }; +} + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error; + + #attach to existing lists? sound scary + #unless ( $self->listnum ) { + my $mailinglist = new FS::mailinglist { + 'listname' => $self->get('listname'), + }; + $error = $mailinglist->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + warn $mailinglist->listnum; + $self->listnum($mailinglist->listnum); + #} + + $error = $self->SUPER::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->mailinglist->delete || $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=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. + +=cut + +sub replace { + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + return "can't change listnum" if $old->listnum != $new->listnum; #? + + my %options = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + if ( $new->get('listname') && $new->get('listname') ne $old->listname ) { + my $mailinglist = $old->mailinglist; + $mailinglist->listname($new->get('listname')); + my $error = $mailinglist->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + } + + my $error = $new->SUPER::replace($old, %options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + + +} + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('svcnum') + || $self->ut_text('username') + || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum') + #|| $self->ut_foreign_key('listnum', 'mailinglist', 'listnum') + || $self->ut_foreign_keyn('listnum', 'mailinglist', 'listnum') + || $self->ut_enum('reply_to_group', [ '', 'Y' ] ) + || $self->ut_enum('remove_author', [ '', 'Y' ] ) + || $self->ut_enum('reject_auto', [ '', 'Y' ] ) + || $self->ut_enum('remove_to_and_cc', [ '', 'Y' ] ) + ; + return $error if $error; + + return "Can't remove listnum" if $self->svcnum && ! $self->listnum; + + $self->SUPER::check; +} + +=item mailinglist + +=cut + +sub mailinglist { + my $self = shift; + qsearchs('mailinglist', { 'listnum' => $self->listnum } ); +} + +=item listname + +=cut + +sub listname { + my $self = shift; + my $mailinglist = $self->mailinglist; + $mailinglist ? $mailinglist->listname : ''; +} + +=item label + +=cut + +sub label { + my $self = shift; + $self->listname. ' <'. $self->username. '@'. $self->domain. '>'; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 365e31854..175eea08c 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -465,3 +465,9 @@ FS/h_svc_www.pm t/h_svc_www.t FS/location_Mixin.pm t/location_Mixin.t +FS/svc_mailinglist.pm +t/svc_mailinglist.t +FS/mailinglist.pm +t/mailinglist.t +FS/mailinglistmember.pm +t/mailinglistmember.t diff --git a/FS/t/mailinglist.t b/FS/t/mailinglist.t new file mode 100644 index 000000000..45b7dd583 --- /dev/null +++ b/FS/t/mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::mailinglist; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/mailinglistmember.t b/FS/t/mailinglistmember.t new file mode 100644 index 000000000..1ceb2f567 --- /dev/null +++ b/FS/t/mailinglistmember.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::mailinglistmember; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_mailinglist.t b/FS/t/svc_mailinglist.t new file mode 100644 index 000000000..73896da3c --- /dev/null +++ b/FS/t/svc_mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_mailinglist; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 740a284c94d57bd755baa58dae36eae5bc581e44 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 23 Mar 2010 03:54:01 +0000 Subject: adding svc_mailinglist for communigate "groups" (mailing lists), RT#7514 --- FS/FS.pm | 8 ++++++++ FS/FS/Mason.pm | 1 + FS/FS/h_svc_mailinglist.pm | 33 +++++++++++++++++++++++++++++++++ FS/t/h_svc_mailinglist.t | 5 +++++ 4 files changed, 47 insertions(+) create mode 100644 FS/FS/h_svc_mailinglist.pm create mode 100644 FS/t/h_svc_mailinglist.t (limited to 'FS') diff --git a/FS/FS.pm b/FS/FS.pm index 7b9d6fea2..7024d603f 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -126,6 +126,12 @@ L - Domain registrar class L - Mail forwarding class +L - (Customer) Mailing list class + +L - Mailing list class + +L - Mailing list member class + L - Web virtual host class. L - DSL, wireless and other broadband class. @@ -346,6 +352,8 @@ L - Historical externally tracked service objects L - Historical mail forwarding alias objects +L - Historical mailing list objects + L - Historical phone number objects L - Historical PBX objects diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 9a8272b26..cc2bdcc7c 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -222,6 +222,7 @@ if ( -e $addl_handler_use_file ) { use FS::h_svc_www; use FS::cust_statement; use FS::svc_pbx; + use FS::svc_mailinglist; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/h_svc_mailinglist.pm b/FS/FS/h_svc_mailinglist.pm new file mode 100644 index 000000000..3d1fd272a --- /dev/null +++ b/FS/FS/h_svc_mailinglist.pm @@ -0,0 +1,33 @@ +package FS::h_svc_mailinglist; + +use strict; +use vars qw( @ISA ); +use FS::h_Common; +use FS::svc_mailinglist; + +@ISA = qw( FS::h_Common FS::svc_mailinglist ); + +sub table { 'h_svc_mailinglist' }; + +=head1 NAME + +FS::h_svc_mailinglist - Historical mailing list objects + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +An FS::h_svc_mailinglist object represents a historical mailing list. +FS::h_svc_mailinglist inherits from FS::h_Common and FS::svc_mailinglist. + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/t/h_svc_mailinglist.t b/FS/t/h_svc_mailinglist.t new file mode 100644 index 000000000..d75575a81 --- /dev/null +++ b/FS/t/h_svc_mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_mailinglist; +$loaded=1; +print "ok 1\n"; -- cgit v1.2.1 From 5a1e3e106a2a8ed738c1b39bb6e6445e9993088e Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 23 Mar 2010 09:13:33 +0000 Subject: export svc_mailinglist to CGP groups, RT#7514 --- FS/FS/mailinglist.pm | 12 +++- FS/FS/mailinglistmember.pm | 103 +++++++++++++++++++++++++++++++-- FS/FS/part_export/communigate_pro.pm | 109 ++++++++++++++++++++++++++++++++++- FS/FS/svc_mailinglist.pm | 2 +- 4 files changed, 217 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/mailinglist.pm b/FS/FS/mailinglist.pm index db1502c53..129461092 100644 --- a/FS/FS/mailinglist.pm +++ b/FS/FS/mailinglist.pm @@ -2,8 +2,9 @@ package FS::mailinglist; use strict; use base qw( FS::Record ); -use FS::Record qw( qsearch dbh ); # qsearchs ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::mailinglistmember; +use FS::svc_mailinglist; =head1 NAME @@ -148,6 +149,15 @@ sub mailinglistmember { qsearch('mailinglistmember', { 'listnum' => $self->listnum } ); } +=item svc_mailinglist + +=cut + +sub svc_mailinglist { + my $self = shift; + qsearchs('svc_mailinglist', { 'listnum' => $self->listnum } ); +} + =back =head1 BUGS diff --git a/FS/FS/mailinglistmember.pm b/FS/FS/mailinglistmember.pm index ca73b888b..49688d812 100644 --- a/FS/FS/mailinglistmember.pm +++ b/FS/FS/mailinglistmember.pm @@ -2,7 +2,8 @@ package FS::mailinglistmember; use strict; use base qw( FS::Record ); -use FS::Record qw( qsearchs ); # qsearch ); +use Scalar::Util qw( blessed ); +use FS::Record qw( dbh qsearchs ); # qsearch ); use FS::mailinglist; use FS::svc_acct; use FS::contact_email; @@ -82,7 +83,30 @@ otherwise returns false. =cut -# the insert method can be inherited from FS::Record +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert + || $self->export('mailinglistmember_insert'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} =item delete @@ -90,7 +114,30 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete + || $self->export('mailinglistmember_delete'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} =item replace OLD_RECORD @@ -99,7 +146,34 @@ returns the error, otherwise returns false. =cut -# the replace method can be inherited from FS::Record +sub replace { + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $new->SUPER::replace($old) + || $new->export('mailinglistmember_replace', $old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} =item check @@ -136,6 +210,27 @@ sub mailinglist { qsearchs('mailinglist', { 'listnum' => $self->listnum } ); } +=item email_address + +=cut + +sub email_address { + my $self = shift; + #XXX svcnum, contactemailnum + $self->email; +} + +=item export + +=cut + +sub export { + my( $self, $method ) = ( shift, shift ); + my $svc_mailinglist = $self->mailinglist->svc_mailinglist + or return ''; + $svc_mailinglist->export($method, $self, @_); +} + =back =head1 BUGS diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index 2084f152b..7f5cece59 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -33,11 +33,11 @@ tie %options, 'Tie::IxHash', ; %info = ( - 'svc' => [qw( svc_acct svc_domain svc_forward )], - 'desc' => 'Real-time export of accounts and domains to a CommuniGate Pro mail server', + 'svc' => [qw( svc_acct svc_domain svc_forward svc_mailinglist )], + 'desc' => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server', 'options' => \%options, 'notes' => <<'END' -Real time export of accounts and domains to a +Real time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server. The CommuniGate Pro Perl Interface @@ -200,6 +200,31 @@ sub _export_insert_svc_forward { ''; } +sub _export_insert_svc_mailinglist { + my( $self, $svc_mlist ) = (shift, shift); + + my @members = map $_->email_address, + $svc_mlist->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'CreateGroup', + $svc_mlist->username.'@'.$svc_mlist->domain, + { 'RealName' => $svc_mlist->listname, + 'SetReplyTo' => ( $svc_mlist->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $svc_mlist->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $svc_mlist->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $svc_mlist->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; + + ''; + +} + sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); @@ -385,6 +410,39 @@ sub _export_replace_svc_forward { ''; } +sub _export_replace_svc_mailinglist { + my( $self, $new, $old ) = (shift, shift, shift); + + my $oldGroupName = $old->username.'@'.$old->domain; + my $newGroupName = $new->username.'@'.$new->domain; + + if ( $oldGroupName ne $newGroupName ) { + eval { $self->communigate_pro_runcommand( + 'RenameGroup', $oldGroupName, $newGroupName ); }; + return $@ if $@; + } + + my @members = map $_->email_address, + $new->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'SetGroup', $newGroupName, + { 'RealName' => $new->listname, + 'SetReplyTo' => ( $new->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $new->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $new->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $new->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; + + ''; + +} + sub _export_delete { my( $self, $svc_x ) = (shift, shift); @@ -418,6 +476,21 @@ sub _export_delete_svc_forward { ); } +sub _export_delete_svc_mailinglist { + my( $self, $svc_mailinglist ) = (shift, shift); + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'DeleteGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ); + }; + return $@ if $@; + + ''; + +} + sub _export_suspend { my( $self, $svc_x ) = (shift, shift); @@ -479,6 +552,20 @@ sub _export_unsuspend_svc_domain { } +sub export_mailinglistmember_insert { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} + +sub export_mailinglistmember_replace { + my( $self, $svc_mailinglist, $new, $old ) = (shift, shift, shift, shift); + die "no way to do this from the UI right now"; +} + +sub export_mailinglistmember_delete { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} sub export_getsettings { my($self, $svc_x) = (shift, shift); @@ -647,6 +734,22 @@ sub export_getsettings_svc_acct { } +sub export_getsettings_svc_mailinglist { + my($self, $svc_mailinglist, $settingsref, $defaultref ) = @_; + + my $settings = eval { $self->communigate_pro_runcommand( + 'GetGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ) }; + return $@ if $@; + + $settings->{'Members'} = join(', ', @{ $settings->{'Members'} } ); + + %{$settingsref} = %$settings; + + ''; +} + sub communigate_pro_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); my $jobnum = ''; #don't actually care diff --git a/FS/FS/svc_mailinglist.pm b/FS/FS/svc_mailinglist.pm index 9c1a09ddb..ba297eedc 100644 --- a/FS/FS/svc_mailinglist.pm +++ b/FS/FS/svc_mailinglist.pm @@ -2,6 +2,7 @@ package FS::svc_mailinglist; use strict; use base qw( FS::svc_Domain_Mixin FS::svc_Common ); +use Scalar::Util qw( blessed ); use FS::Record qw( qsearchs dbh ); # qsearch ); use FS::svc_domain; use FS::mailinglist; @@ -160,7 +161,6 @@ sub insert { $dbh->rollback if $oldAutoCommit; return $error; } - warn $mailinglist->listnum; $self->listnum($mailinglist->listnum); #} -- cgit v1.2.1 From 4d2208098eebb3bc9a4ea882d1d0403b4e04359d Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 24 Mar 2010 08:38:01 +0000 Subject: better prepaid income reporting, with line item detail, RT#7776 --- FS/FS/Conf.pm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'FS') diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 095d93dd2..45d11c45c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3546,6 +3546,13 @@ worry that config_items is freeside-specific and icky. 'type' => 'checkbox', }, + { + 'key' => 'enable_legacy_prepaid_income', + 'section' => '', + 'description' => "Enable legacy prepaid income reporting. Only useful when you have imported pre-Freeside packages with longer-than-monthly duration, and need to do prepaid income reporting on them before they've been invoiced the first time.", + 'type' => 'checkbox', + }, + { key => "apacheroot", section => "deprecated", description => "DEPRECATED", type => "text" }, { key => "apachemachine", section => "deprecated", description => "DEPRECATED", type => "text" }, { key => "apachemachines", section => "deprecated", description => "DEPRECATED", type => "text" }, -- cgit v1.2.1 From 612b84df6c0e6e0468477a6c57a59449285e2140 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 26 Mar 2010 02:28:06 +0000 Subject: fix mailinglistmember.pm dependency on contact_email.pm from 2.1 branch, RT#7897 --- FS/FS/Schema.pm | 3 +-- FS/FS/mailinglistmember.pm | 8 +------- 2 files changed, 2 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 8cadaa76c..dde4053e6 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2585,12 +2585,11 @@ sub tables_hashref { 'membernum', 'serial', '', '', '', '', 'listnum', 'int', '', '', '', '', 'svcnum', 'int', 'NULL', '', '', '', - 'contactemailnum', 'int', 'NULL', '', '', '', 'email', 'varchar', 'NULL', 255, '', '', ], 'primary_key' => 'membernum', 'unique' => [], - 'index' => [['listnum'],['svcnum'],['contactemailnum'],['email']], + 'index' => [['listnum'],['svcnum'],['email']], }, diff --git a/FS/FS/mailinglistmember.pm b/FS/FS/mailinglistmember.pm index 49688d812..8655d61b2 100644 --- a/FS/FS/mailinglistmember.pm +++ b/FS/FS/mailinglistmember.pm @@ -6,7 +6,6 @@ use Scalar::Util qw( blessed ); use FS::Record qw( dbh qsearchs ); # qsearch ); use FS::mailinglist; use FS::svc_acct; -use FS::contact_email; =head1 NAME @@ -47,10 +46,6 @@ listnum svcnum -=item contactemailnum - -contactemailnum - =item email email @@ -193,7 +188,6 @@ sub check { $self->ut_numbern('membernum') || $self->ut_foreign_key('listnum', 'mailinglist', 'listnum') || $self->ut_foreign_keyn('svcnum', 'svc_acct', 'svcnum') - || $self->ut_foreign_keyn('contactemailnum', 'contact_email', 'contactemailnum') || $self->ut_textn('email') #XXX ut_email! from svc_forward, cust_main_invoice ; return $error if $error; @@ -216,7 +210,7 @@ sub mailinglist { sub email_address { my $self = shift; - #XXX svcnum, contactemailnum + #XXX svcnum $self->email; } -- cgit v1.2.1 From e710ab414936e7fea49b220e05fc1910dcd26f54 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 26 Mar 2010 04:50:40 +0000 Subject: don't warn about the configuration table during setup --- FS/FS/UID.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index e3a4604b4..e042c05b1 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -128,7 +128,7 @@ sub forksuidsetup { } } else { - warn "NO CONFIGURATION TABLE FOUND"; + warn "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack; } unless ( $callback_hack ) { -- cgit v1.2.1 From 4b24e130ac6954ee7dec79f7c40147794d0553a9 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 26 Mar 2010 05:02:52 +0000 Subject: kludge a fix for the MySQL statustext index problem, fix s/serial/int/ for non-primary keys in part_pkg_taxoverride, and s/TEXT/LONGTEXT/ ourselves until DBIx::DBSchema 0.39 --- FS/FS/Schema.pm | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index dde4053e6..e705874af 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -102,6 +102,10 @@ sub dbdef_dist { my %hash = map { $_ => shift @coldef } qw( name type null length default local ); + #can be removed once we depend on DBIx::DBSchema 0.39; + $hash{'type'} = 'LONGTEXT' + if $hash{'type'} =~ /^TEXT$/i && $datasrc =~ /^dbi:mysql/i; + unless ( defined $hash{'default'} ) { warn "$tablename:\n". join('', map "$_ => $hash{$_}\n", keys %hash) ;# $stop = ; @@ -113,7 +117,17 @@ sub dbdef_dist { #false laziness w/sub indices in DBIx::DBSchema::DBD (well, sorta) #and sub sql_create_table in DBIx::DBSchema::Table (slighty more?) my $unique = $tables_hashref->{$tablename}{'unique'}; - my $index = $tables_hashref->{$tablename}{'index'}; + my @index = @{ $tables_hashref->{$tablename}{'index'} }; + + # kludge to avoid avoid "BLOB/TEXT column 'statustext' used in key + # specification without a key length". + # better solution: teach DBIx::DBSchema to specify a default length for + # MySQL indices on text columns, or just to support an index length at all + # so we can pass something in. + # best solution: eliminate need for this index in cust_main::retry_realtime + @index = grep { @{$_}[0] ne 'statustext' } @index + if $datasrc =~ /^dbi:mysql/i; + my @indices = (); push @indices, map { DBIx::DBSchema::Index->new({ @@ -130,7 +144,7 @@ sub dbdef_dist { 'columns' => $_, }); } - @$index; + @index; DBIx::DBSchema::Table->new({ 'name' => $tablename, @@ -1353,8 +1367,8 @@ sub tables_hashref { 'part_pkg_taxoverride' => { 'columns' => [ 'taxoverridenum', 'serial', '', '', '', '', - 'pkgpart', 'serial', '', '', '', '', - 'taxclassnum', 'serial', '', '', '', '', + 'pkgpart', 'int', '', '', '', '', + 'taxclassnum', 'int', '', '', '', '', 'usage_class', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'taxoverridenum', -- cgit v1.2.1 From 7d3bca8381bc7e160d8f483b3e8c977368dc71b1 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 26 Mar 2010 21:43:47 +0000 Subject: no DISTINCT ON in MySQL makes kittens cry --- FS/FS/cust_pkg.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index d8b7575b6..89eadd599 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1703,7 +1703,9 @@ sub extra_part_svc { #seems to benchmark slightly faster... qsearch( { - 'select' => 'DISTINCT ON (svcpart) part_svc.*', + #'select' => 'DISTINCT ON (svcpart) part_svc.*', + #MySQL doesn't grok DISINCT ON + 'select' => 'DISTINCT part_svc.*', 'table' => 'part_svc', 'addl_from' => 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart -- cgit v1.2.1 From 9bb7341f570bcffa83ce244d1ef6e6fdbadc035b Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 27 Mar 2010 03:44:00 +0000 Subject: these are now supported in supported in DBIx-DBSchema and friends --- FS/FS/reason.pm | 54 --------------------------- FS/FS/tax_rate.pm | 107 +----------------------------------------------------- 2 files changed, 2 insertions(+), 159 deletions(-) (limited to 'FS') diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 5311ec5aa..377da4985 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -114,60 +114,6 @@ sub reasontype { qsearchs( 'reason_type', { 'typenum' => shift->reason_type } ); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# - -sub _upgrade_data { # class method - my ($self, %opts) = @_; - my $dbh = dbh; - - warn "$me upgrading $self\n" if $DEBUG; - - my $column = dbdef->table($self->table)->column('reason'); - unless ($column->type eq 'text') { # assume history matches main table - - # ideally this would be supported in DBIx-DBSchema and friends - warn "$me Shifting reason column to type 'text'\n" if $DEBUG; - foreach my $table ( $self->table, 'h_'. $self->table ) { - my @sql = (); - - $column = dbdef->table($self->table)->column('reason'); - my $columndef = $column->line($dbh); - $columndef =~ s/varchar\(\d+\)/text/i; - - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { - - my $notnull = $columndef =~ s/not null//i; - push @sql,"ALTER TABLE $table RENAME reason TO freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ADD $columndef"; - push @sql,"UPDATE $table SET reason = freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ALTER reason SET NOT NULL" - if $notnull; - push @sql,"ALTER TABLE $table DROP freeside_upgrade_reason"; - - } elsif ( $dbh->{Driver}->{Name} =~ /^mysql/i ){ - - #crap, this isn't working - #push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh); - warn "WARNING: reason table upgrade not yet supported for mysql, sorry"; - - } else { - die "watchu talkin' 'bout, Willis? (unsupported database type)"; - } - - foreach (@sql) { - my $sth = $dbh->prepare($_) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } - } - } - - ''; - -} =back =head1 BUGS diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 10e19487f..75e72c542 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -502,7 +502,9 @@ given customer (see L) =cut + #hot sub tax_on_tax { + #akshun my $self = shift; my $cust_main = shift; @@ -1755,111 +1757,6 @@ sub browse_queries { return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql"); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# - -sub _upgrade_data { # class method - my ($self, %opts) = @_; - my $dbh = dbh; - - warn "$me upgrading $self\n" if $DEBUG; - - my @column = qw ( tax excessrate usetax useexcessrate fee excessfee - feebase feemax ); - - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { - - eval "use DBI::Const::GetInfoType;"; - die $@ if $@; - - my $major_version = 0; - $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/ - && ( $major_version = sprintf("%d", $1) ); - - if ( $major_version > 7 ) { - - # ideally this would be supported in DBIx-DBSchema and friends - - foreach my $column ( @column ) { - my $columndef = dbdef->table($self->table)->column($column); - unless ($columndef->type eq 'numeric') { - - warn "updating tax_rate column $column to numeric\n" if $DEBUG; - my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - warn "updating h_tax_rate column $column to numeric\n" if $DEBUG; - $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - } - } - - } elsif ( $dbh->{pg_server_version} =~ /^704/ ) { - - # ideally this would be supported in DBIx-DBSchema and friends - - foreach my $column ( @column ) { - my $columndef = dbdef->table($self->table)->column($column); - unless ($columndef->type eq 'numeric') { - - warn "updating tax_rate column $column to numeric\n" if $DEBUG; - - foreach my $table ( qw( tax_rate h_tax_rate ) ) { - - my $sql = "ALTER TABLE $table RENAME $column TO old_$column"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - my $def = dbdef->table($table)->column($column); - $def->type('numeric'); - $def->length('14,8'); - my $null = $def->null; - $def->null('NULL'); - - $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh); - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - unless ( $null eq 'NULL' ) { - $sql = "ALTER TABLE $table ALTER $column SET NOT NULL"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } - - $sql = "ALTER TABLE $table DROP old_$column"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - } - } - } - - } else { - - warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n"; - - } - - } else { - - warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n"; - - } - - ''; - -} - =back =head1 BUGS -- cgit v1.2.1 From e5c58aba4a1a52840ada3a6e1d0da0ef8a17f08f Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 27 Mar 2010 04:37:27 +0000 Subject: these are now supported in supported in DBIx-DBSchema and friends --- FS/FS/Upgrade.pm | 4 ---- 1 file changed, 4 deletions(-) (limited to 'FS') diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index c39680ef7..ff577f2f2 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -99,7 +99,6 @@ sub upgrade_data { #reason type and reasons 'reason_type' => [], - 'reason' => [], 'cust_pkg_reason' => [], #need part_pkg before cust_credit... @@ -129,9 +128,6 @@ sub upgrade_data { #fixup access rights 'access_right' => [], - #change tax_rate column types - 'tax_rate' => [], - #change recur_flat and enable_prorate 'part_pkg_option' => [], -- cgit v1.2.1 From eea5914ee823c7c0326c3abc6869fdf4162c7155 Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 27 Mar 2010 06:21:57 +0000 Subject: fix cust_bill_pkg_detail throwing a fatal error w/MySQL --- FS/FS/cust_bill_pkg_detail.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm index f2e60d2f4..4d9ee8191 100644 --- a/FS/FS/cust_bill_pkg_detail.pm +++ b/FS/FS/cust_bill_pkg_detail.pm @@ -241,8 +241,8 @@ sub _upgrade_data { # class method warn "$me upgrading $class\n" if $DEBUG; - my $columndef = dbdef->table($class->table)->column('classnum'); - unless ($columndef->type eq 'int4') { + my $type = dbdef->table($class->table)->column('classnum')->type; + unless ( $type =~ /^int/i || $type =~ /int$/i ) { my $dbh = dbh; if ( $dbh->{Driver}->{Name} eq 'Pg' ) { -- cgit v1.2.1 From 28d2122f9aabfc0affb70102c1ec671824b72da3 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 29 Mar 2010 00:24:49 +0000 Subject: add user_custnum to 1.9 for employee commissioning, RT#6991 --- FS/FS/Schema.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index e705874af..6756c9c32 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2380,11 +2380,12 @@ sub tables_hashref { '_password', 'varchar', '', $char_d, '', '', 'last', 'varchar', '', $char_d, '', '', 'first', 'varchar', '', $char_d, '', '', + 'user_custnum', 'int', 'NULL', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'usernum', 'unique' => [ [ 'username' ] ], - 'index' => [], + 'index' => [ [ 'user_custnum' ] ], }, 'access_user_pref' => { -- cgit v1.2.1 From 3c64b5db7af79557f231f0f41bd821b58c63bc95 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 29 Mar 2010 00:50:28 +0000 Subject: add user_custnum to 1.9 for employee commissioning, RT#6991 --- FS/FS/access_user.pm | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'FS') diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 8cc8b64fc..1bf6e9387 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -10,6 +10,7 @@ use FS::option_Common; use FS::access_user_pref; use FS::access_usergroup; use FS::agent; +use FS::cust_main; @ISA = qw( FS::m2m_Common FS::option_Common FS::Record ); #@ISA = qw( FS::m2m_Common FS::option_Common ); @@ -220,6 +221,9 @@ sub replace { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; return $error; } + } elsif ( $old->disabled && !$new->disabled + && $new->_password =~ /changeme/i ) { + return "Must change password when enabling this account"; } my $error = $new->SUPER::replace($old, @_); @@ -254,6 +258,7 @@ sub check { || $self->ut_text('_password') || $self->ut_text('last') || $self->ut_text('first') + || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum') || $self->ut_enum('disabled', [ '', 'Y' ] ) ; return $error if $error; @@ -272,6 +277,18 @@ sub name { $self->get('last'). ', '. $self->first; } +=item user_cust_main + +Returns the FS::cust_main object (see L), if any, for this +user. + +=cut + +sub user_cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } ); +} + =item access_usergroup Returns links to the the groups this user is a part of, as FS::access_usergroup -- cgit v1.2.1 From 470179da98f2d8f1db6c0a834202c080233a61de Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Mar 2010 02:52:52 +0000 Subject: employee commissions, RT#6991 --- FS/FS/part_event/Action/pkg_employee_credit.pm | 43 ++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 FS/FS/part_event/Action/pkg_employee_credit.pm (limited to 'FS') diff --git a/FS/FS/part_event/Action/pkg_employee_credit.pm b/FS/FS/part_event/Action/pkg_employee_credit.pm new file mode 100644 index 000000000..94fc5f3b1 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_employee_credit.pm @@ -0,0 +1,43 @@ +package FS::part_event::Action::pkg_employee_credit; + +use strict; +use base qw( FS::part_event::Action::pkg_referral_credit ); +use FS::Record qw(qsearchs); +use FS::access_user; + +sub description { 'Credit the ordering employee a specific amount'; } + +#a little false laziness w/pkg_referral_credit +sub do_action { + my( $self, $cust_pkg ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + #yuck. this is why text $otaker is gone in 2.1 + my $otaker = $cust_pkg->otaker; + my $employee = qsearchs('access_user', { 'username' => $otaker } ) + or return "No employee for username $otaker"; + return "No customer record for employee ". $employee->username + unless $employee->user_custnum; + + my $employee_cust_main = $employee->user_cust_main; + #? or return "No customer record for employee ". $employee->username; + + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + + my $reasonnum = $self->option('reasonnum'); + + my $error = $employee_cust_main->credit( + $amount, + \$reasonnum, + 'addlinfo' => + 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + ); + die "Error crediting customer ". $employee_cust_main->custnum. + " for employee commission: $error" + if $error; + +} + +1; -- cgit v1.2.1 From 2512fe5818a8d66d404169cbf9b687d3339f750b Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Mar 2010 02:53:12 +0000 Subject: employee (otaker / access_user) commissioning, RT#6991 --- FS/FS/part_event/Action/Mixin/credit_pkg.pm | 63 ++++++++++++++++++++++ FS/FS/part_event/Action/pkg_agent_credit.pm | 38 +++++++++++++ FS/FS/part_event/Action/pkg_agent_credit_pkg.pm | 9 ++++ FS/FS/part_event/Action/pkg_employee_credit_pkg.pm | 9 ++++ FS/FS/part_event/Action/pkg_referral_credit.pm | 7 +-- FS/FS/part_event/Action/pkg_referral_credit_pkg.pm | 53 +----------------- FS/FS/part_pkg.pm | 12 +++++ 7 files changed, 137 insertions(+), 54 deletions(-) create mode 100644 FS/FS/part_event/Action/Mixin/credit_pkg.pm create mode 100644 FS/FS/part_event/Action/pkg_agent_credit.pm create mode 100644 FS/FS/part_event/Action/pkg_agent_credit_pkg.pm create mode 100644 FS/FS/part_event/Action/pkg_employee_credit_pkg.pm (limited to 'FS') diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm new file mode 100644 index 000000000..aeda92f91 --- /dev/null +++ b/FS/FS/part_event/Action/Mixin/credit_pkg.pm @@ -0,0 +1,63 @@ +package FS::part_event::Action::Mixin::credit_pkg; + +use strict; + +sub eventtable_hashref { + { 'cust_pkg' => 1 }; +} + +sub option_fields { + ( + 'reasonnum' => { 'label' => 'Credit reason', + 'type' => 'select-reason', + 'reason_class' => 'R', + }, + 'percent' => { 'label' => 'Percent', + 'type' => 'input-percentage', + 'default' => '100', + }, + 'what' => { 'label' => 'Of', + 'type' => 'select', + #add additional ways to specify in the package def + 'options' => [ qw( base_recur_permonth unit_setup recur_cost_permonth setup_cost ) ], + 'labels' => { 'base_recur_permonth' => 'Base monthly fee', + 'unit_setup' => 'Setup fee', + 'recur_cost_permonth' => 'Monthly cost', + 'setup_cost' => 'Setup cost', + }, + }, + ); + +} + +#my %no_cust_pkg = ( 'setup_cost' => 1 ); + +sub _calc_credit { + my( $self, $cust_pkg ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + my $part_pkg = $cust_pkg->part_pkg; + + my $what = $self->option('what'); + + #false laziness w/Condition/cust_payments_pkg.pm + if ( $what =~ /_permonth$/ ) { #huh. yuck. + if ( $part_pkg->freq !~ /^\d+$/ ) { + die 'WARNING: Not crediting for package '. $cust_pkg->pkgnum. + ' ( customer '. $cust_pkg->custnum. ')'. + ' - credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } + } + + my $percent = $self->option('percent'); + + #my @arg = $no_cust_pkg{$what} ? () : ($cust_pkg); + my @arg = ($what eq 'setup_cost') ? () : ($cust_pkg); + + sprintf('%.2f', $part_pkg->$what(@arg) * $percent / 100 ); + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm new file mode 100644 index 000000000..250273846 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit.pm @@ -0,0 +1,38 @@ +package FS::part_event::Action::pkg_agent_credit; + +use strict; +use base qw( FS::part_event::Action::pkg_referral_credit ); + +sub description { 'Credit the agent a specific amount'; } + +#a little false laziness w/pkg_referral_credit +sub do_action { + my( $self, $cust_pkg ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + my $agent = $cust_main->agent; + return "No customer record for agent ". $agent->agent + unless $agent->agent_custnum; + + my $agent_cust_main = $agent->agent_cust_main; + #? or return "No customer record for agent ". $agent->agent; + + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + + my $reasonnum = $self->option('reasonnum'); + + my $error = $agent_cust_main->credit( + $amount, + \$reasonnum, + 'addlinfo' => + 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + ); + die "Error crediting customer ". $agent_cust_main->custnum. + " for agent commission: $error" + if $error; + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm b/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm new file mode 100644 index 000000000..b3e11817d --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_agent_credit_pkg; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_agent_credit ); + +sub description { 'Credit the agent an amount based on the referred package'; } + +1; diff --git a/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm b/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm new file mode 100644 index 000000000..e3b867fb2 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_employee_credit_pkg; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_employee_credit ); + +sub description { 'Credit the ordering employee an amount based on the referred package'; } + +1; diff --git a/FS/FS/part_event/Action/pkg_referral_credit.pm b/FS/FS/part_event/Action/pkg_referral_credit.pm index 98d982066..da872e7ff 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit.pm @@ -22,7 +22,6 @@ sub option_fields { } -#a little false laziness w/pkg_referral_credit_pkg sub do_action { my( $self, $cust_pkg ) = @_; @@ -36,7 +35,9 @@ sub do_action { return 'Referring customer is cancelled' if $referring_cust_main->status eq 'cancelled'; - my $amount = $self->_calc_referral_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + my $reasonnum = $self->option('reasonnum'); my $error = $referring_cust_main->credit( @@ -51,7 +52,7 @@ sub do_action { } -sub _calc_referral_credit { +sub _calc_credit { my( $self, $cust_pkg ) = @_; $self->option('amount'); diff --git a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm index eb9b5107c..667c4ce19 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm @@ -1,58 +1,9 @@ package FS::part_event::Action::pkg_referral_credit_pkg; use strict; -use base qw( FS::part_event::Action::pkg_referral_credit ); +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_referral_credit ); sub description { 'Credit the referring customer an amount based on the referred package'; } -#sub eventtable_hashref { -# { 'cust_pkg' => 1 }; -#} - -sub option_fields { - ( - 'reasonnum' => { 'label' => 'Credit reason', - 'type' => 'select-reason', - 'reason_class' => 'R', - }, - 'percent' => { 'label' => 'Percent', - 'type' => 'input-percentage', - 'default' => '100', - }, - 'what' => { 'label' => 'Of', - 'type' => 'select', - #also add some way to specify in the package def, no? - 'options' => [ qw( base_recur_permonth ) ], - 'labels' => { 'base_recur_permonth' => 'Base monthly fee', }, - }, - ); - -} - -sub _calc_referral_credit { - my( $self, $cust_pkg ) = @_; - - my $cust_main = $self->cust_main($cust_pkg); - - my $part_pkg = $cust_pkg->part_pkg; - - my $what = $self->option('what'); - - #false laziness w/Condition/cust_payments_pkg.pm - if ( $what eq 'base_recur_permonth' ) { #huh. yuck. - if ( $part_pkg->freq !~ /^\d+$/ ) { - die 'WARNING: Not crediting customer '. $cust_main->referral_custnum. - ' for package '. $cust_pkg->pkgnum. - ' ( customer '. $cust_pkg->custnum. ')'. - ' - Referral credits not (yet) available for '. - ' packages with '. $part_pkg->freq_pretty. ' frequency'; - } - } - - my $percent = $self->option('percent'); - - sprintf('%.2f', $part_pkg->$what($cust_pkg) * $percent / 100 ); - -} - 1; diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 46f4e7241..276889d62 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1179,6 +1179,18 @@ sub calc_units { 0; } #fallback for everything except bulk.pm sub hide_svc_detail { 0; } +=item recur_cost_permonth CUST_PKG + +recur_cost divided by freq (only supported for monthly and longer frequencies) + +=cut + +sub recur_cost_permonth { + my($self, $cust_pkg) = @_; + return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0; + sprintf('%.2f', $self->recur_cost / $self->freq ); +} + =item format OPTION DATA Returns data formatted according to the function 'format' described -- cgit v1.2.1 From fd27587f9cf4c0f1334aaa3ff9eb41e8d10fe4cb Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Mar 2010 03:10:52 +0000 Subject: employee (otaker / access_user) commissioning, RT#6991 --- FS/MANIFEST | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'FS') diff --git a/FS/MANIFEST b/FS/MANIFEST index 175eea08c..4755f1f64 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -471,3 +471,8 @@ FS/mailinglist.pm t/mailinglist.t FS/mailinglistmember.pm t/mailinglistmember.t +FS/part_event/Action/Mixin/credit_pkg.pm +FS/part_event/Action/pkg_agent_credit.pm +FS/part_event/Action/pkg_agent_credit_pkg.pm +FS/part_event/Action/pkg_employee_credit.pm +FS/part_event/Action/pkg_employee_credit_pkg.pm -- cgit v1.2.1 From dd2249efe0daa3fc3257029de84d212aa89a4ee9 Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 30 Mar 2010 12:16:00 +0000 Subject: employee commission reporting, RT#6991 --- FS/FS/Schema.pm | 3 ++- FS/FS/cust_credit.pm | 2 ++ FS/FS/cust_event.pm | 6 ++---- FS/FS/cust_main.pm | 8 +++++--- FS/FS/part_event/Action/pkg_agent_credit.pm | 7 ++++--- FS/FS/part_event/Action/pkg_employee_credit.pm | 7 ++++--- FS/FS/part_event/Action/pkg_referral_credit.pm | 7 ++++--- 7 files changed, 23 insertions(+), 17 deletions(-) (limited to 'FS') diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 6756c9c32..660a072b8 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -655,10 +655,11 @@ sub tables_hashref { 'addlinfo', 'text', 'NULL', '', '', '', 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + 'eventnum', 'int', 'NULL', '', '', '', #triggering event for commission ], 'primary_key' => 'crednum', 'unique' => [], - 'index' => [ ['custnum'], ['_date'] ], + 'index' => [ ['custnum'], ['_date'], ['eventnum'] ], }, 'cust_credit_bill' => { diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 6c3effa13..d0aa3a4b4 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -14,6 +14,7 @@ use FS::cust_credit_bill; use FS::part_pkg; use FS::reason_type; use FS::reason; +use FS::cust_event; @ISA = qw( FS::cust_main_Mixin FS::Record ); $me = '[ FS::cust_credit ]'; @@ -301,6 +302,7 @@ sub check { || $self->ut_textn('addlinfo') || $self->ut_enum('closed', [ '', 'Y' ]) || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum') ; return $error if $error; diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index d2fcfc1e2..52b5911dc 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -1,18 +1,16 @@ package FS::cust_event; use strict; +use base qw( FS::cust_main_Mixin FS::Record ); use vars qw( @ISA $DEBUG $me ); use Carp qw( croak confess ); use FS::Record qw( qsearch qsearchs dbdef ); -use FS::cust_main_Mixin; use FS::part_event; #for cust_X use FS::cust_main; use FS::cust_pkg; use FS::cust_bill; -@ISA = qw(FS::cust_main_Mixin FS::Record); - $DEBUG = 0; $me = '[FS::cust_event]'; @@ -230,7 +228,7 @@ sub do_event { my $error; { local $SIG{__DIE__}; # don't want Mason __DIE__ handler active - $error = eval { $part_event->do_action($object); }; + $error = eval { $part_event->do_action($object, $self); }; } my $status = ''; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 5116049f3..88aceb935 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -7320,7 +7320,7 @@ sub referral_cust_main_ncancelled { Like referral_cust_main, except returns a flat list of all unsuspended (and uncancelled) packages for each customer. The number of items in this list may -be useful for comission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). +be useful for commission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). =cut @@ -7382,8 +7382,10 @@ sub credit { $cust_credit->set('reason', $reason) } - $cust_credit->addlinfo( delete $options{'addlinfo'} ) - if exists($options{'addlinfo'}); + for (qw( addlinfo eventnum )) { + $cust_credit->$_( delete $options{$_} ) + if exists($options{$_}); + } $cust_credit->insert(%options); diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm index 250273846..4bcee983b 100644 --- a/FS/FS/part_event/Action/pkg_agent_credit.pm +++ b/FS/FS/part_event/Action/pkg_agent_credit.pm @@ -7,7 +7,7 @@ sub description { 'Credit the agent a specific amount'; } #a little false laziness w/pkg_referral_credit sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -26,8 +26,9 @@ sub do_action { my $error = $agent_cust_main->credit( $amount, \$reasonnum, - 'addlinfo' => - 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, ); die "Error crediting customer ". $agent_cust_main->custnum. " for agent commission: $error" diff --git a/FS/FS/part_event/Action/pkg_employee_credit.pm b/FS/FS/part_event/Action/pkg_employee_credit.pm index 94fc5f3b1..e4913a21f 100644 --- a/FS/FS/part_event/Action/pkg_employee_credit.pm +++ b/FS/FS/part_event/Action/pkg_employee_credit.pm @@ -9,7 +9,7 @@ sub description { 'Credit the ordering employee a specific amount'; } #a little false laziness w/pkg_referral_credit sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -31,8 +31,9 @@ sub do_action { my $error = $employee_cust_main->credit( $amount, \$reasonnum, - 'addlinfo' => - 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, ); die "Error crediting customer ". $employee_cust_main->custnum. " for employee commission: $error" diff --git a/FS/FS/part_event/Action/pkg_referral_credit.pm b/FS/FS/part_event/Action/pkg_referral_credit.pm index da872e7ff..e7c92d650 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit.pm @@ -23,7 +23,7 @@ sub option_fields { } sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -43,8 +43,9 @@ sub do_action { my $error = $referring_cust_main->credit( $amount, \$reasonnum, - 'addlinfo' => - 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, ); die "Error crediting customer ". $cust_main->referral_custnum. " for referral: $error" -- cgit v1.2.1 From eb93d5bfe70f6ec709f98da93d69d04acccba607 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 31 Mar 2010 06:30:36 +0000 Subject: eliminate harmless "Use of uninitialized value $enc in string eq" warnings --- FS/FS/Misc.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'FS') diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 69954a862..71670f758 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -343,14 +343,14 @@ sub send_email { $smtp_opt{'port'} = $port; my $transport; - if ( $enc eq 'starttls' ) { + if ( defined($enc) && $enc eq 'starttls' ) { $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); } else { if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); } - $smtp_opt{'ssl'} = 1 if $enc eq 'tls'; + $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); } -- cgit v1.2.1 From 5320e62fea03b68d2d106fba8842d7494e1385ef Mon Sep 17 00:00:00 2001 From: jeff Date: Wed, 31 Mar 2010 15:49:08 +0000 Subject: add dash carrier services e911 support RT7103 --- FS/FS/part_export/dashcs_e911.pm | 153 +++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 1 + 2 files changed, 154 insertions(+) create mode 100644 FS/FS/part_export/dashcs_e911.pm (limited to 'FS') diff --git a/FS/FS/part_export/dashcs_e911.pm b/FS/FS/part_export/dashcs_e911.pm new file mode 100644 index 000000000..a0c3a6d6a --- /dev/null +++ b/FS/FS/part_export/dashcs_e911.pm @@ -0,0 +1,153 @@ +package FS::part_export::dashcs_e911; + +use strict; +use vars qw(@ISA %info $me $DEBUG); +use Tie::IxHash; +use FS::part_export; + +$DEBUG = 0; +$me = '['.__PACKAGE__.']'; + +@ISA = qw(FS::part_export); + +tie my %options, 'Tie::IxHash', + 'username' => { label=>'Dash username', }, + '_password' => { label=>'Dash password', }, + 'staging' => { label=>'Staging (test mode)', type=>'checkbox', }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision e911 services via Dash Carrier Services', + 'notes' => 'Provision e911 services via Dash Carrier Services', + 'options' => \%options, +); + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_phone) = (shift, shift); + return 'invalid phonenum' unless $svc_phone->phonenum; + + my $opts = { map{ $_ => $self->option($_) } keys %options }; + $opts->{wantreturn} = 1; + + my %location_hash = $svc_phone->location_hash; + my $location = { + 'address1' => $location_hash{address1}, + 'address2' => $location_hash{address2}, + 'community' => $location_hash{city}, + 'state' => $location_hash{state}, + 'postalcode' => $location_hash{zip}, + }; + + my $error_or_ref = + dash_command($opts, 'validateLocation', { 'location' => $location } ); + return $error_or_ref unless ref($error_or_ref); + + my $status = $error_or_ref->get_Location->get_status; # hate + return $status->get_description unless $status->get_code eq 'GEOCODED'; + + my $cust_pkg = $svc_phone->cust_svc->cust_pkg; + my $cust_main = $cust_pkg->cust_main if $cust_pkg; + my $caller_name = $cust_main ? $cust_main->name_short : 'unknown'; + + my $arg = { + 'uri' => { + 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum, + 'callername' => $caller_name, + }, + 'location' => $location, + }; + + my $error_or_ref = dash_command($opts, 'addLocation', $arg ); + return $error_or_ref unless ref($error_or_ref); + + my $id = $error_or_ref->get_Location->get_locationid; + $self->_export_command('provisionLocation', { 'locationid' => $id }); +} + +sub _export_delete { + my($self, $svc_phone) = (shift, shift); + return '' unless $svc_phone->phonenum; + + my $arg = { 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum }; + $self->_export_queue('removeURI', $arg); +} + +sub _export_suspend { + my($self) = shift; + ''; +} + +sub _export_unsuspend { + my($self) = shift; + ''; +} + +sub _export_command { + my $self = shift; + + my $opts = { map{ $_ => $self->option($_) } keys %options }; + + dash_command($opts, @_); + +} + +sub _export_replace { + my($self, $new, $old ) = (shift, shift, shift); + + # this could succeed in unprovision but fail to provision + my $arg = { 'uri' => 'tel:'. $old->countrycode. $old->phonenum }; + $self->_export_command('removeURI', $arg) || $self->_export_insert($new); +} + +#a good idea to queue anything that could fail or take any time +sub _export_queue { + my $self = shift; + + my $opts = { map{ $_ => $self->option($_) } keys %options }; + + my $queue = new FS::queue { + 'job' => "FS::part_export::dashcs_e911::dash_command", + }; + $queue->insert( $opts, @_ ); +} + +sub dash_command { + my ( $opt, $method, $arg ) = (shift, shift, shift); + + warn "$me: dash_command called with method $method\n" if $DEBUG; + + my @module = qw( + Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort + SOAP::Lite + ); + + foreach my $module ( @module ) { + eval "use $module;"; + die $@ if $@; + } + + local *SOAP::Transport::HTTP::Client::get_basic_credentials = sub { + return ($opt->{'username'}, $opt->{'_password'}); + }; + + my $service = new Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort( + { deserializer_args => { strict => 0 } } + ); + + $service->set_proxy('https://staging-service.dashcs.com/dash-api/soap/emergencyprovisioning/v1') + if $opt->{'staging'}; + + my $result = $service->$method($arg); + + if (not $result) { + warn "returning fault: ". $result->get_faultstring if $DEBUG; + return ''.$result->get_faultstring; + } + + warn "returning ok: $result\n" if $DEBUG; + return $result if $opt->{wantreturn}; + ''; +} diff --git a/FS/MANIFEST b/FS/MANIFEST index 4755f1f64..e895f0bbe 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -99,6 +99,7 @@ FS/part_export/communigate_pro.pm FS/part_export/communigate_pro_singledomain.pm FS/part_export/cp.pm FS/part_export/cyrus.pm +FS/part_export/dashcs_e911.pm FS/part_export/domain_shellcommands.pm FS/part_export/forward_shellcommands.pm FS/part_export/http.pm -- cgit v1.2.1 From 7c02bdc86a3b0ca0804f4b0a696ff7d2cdb1f141 Mon Sep 17 00:00:00 2001 From: mark Date: Thu, 1 Apr 2010 04:44:20 +0000 Subject: RT#866: links to process payments from aging report --- FS/FS/UI/Web.pm | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 5e987429c..c9264a044 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -362,6 +362,7 @@ setting is supplied, the cust-fields configuration value. =cut + sub cust_fields { my $record = shift; warn "FS::UI::Web::cust_fields called for $record ". @@ -370,8 +371,9 @@ sub cust_fields { #cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields # #override incase we were passed as a sub - + my $seen_unlinked = 0; + map { if ( $record->custnum ) { warn " $record -> $_" if $DEBUG > 1; @@ -383,6 +385,38 @@ sub cust_fields { } @cust_fields; } +=item cust_fields_subs + +Returns an array of subroutine references for returning customer field values. +This is similar to cust_fields, but returns each field's sub as a distinct +element. + +=cut + +sub cust_fields_subs { + my $unlinked_warn = 0; + return map { + my $f = $_; + if( $unlinked_warn++ ) { + sub { + my $record = shift; + if( $record->custnum ) { + $record->$f(@_); + } + else { + '(unlinked)' + }; + } + } + else { + sub { + my $record = shift; + $record->$f(@_) if $record->custnum; + } + } + } @cust_fields; +} + =item cust_colors Returns an array of subroutine references (or empty strings) for returning -- cgit v1.2.1 From f8ac1709ad51c6264aca5441e0c122e8275343d4 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Apr 2010 05:20:03 +0000 Subject: initial indosoft export, RT#4068 --- FS/FS/part_export/indosoft.pm | 219 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 219 insertions(+) create mode 100644 FS/FS/part_export/indosoft.pm (limited to 'FS') diff --git a/FS/FS/part_export/indosoft.pm b/FS/FS/part_export/indosoft.pm new file mode 100644 index 000000000..b5734019b --- /dev/null +++ b/FS/FS/part_export/indosoft.pm @@ -0,0 +1,219 @@ +package FS::part_export::indosoft; + +use vars qw(@ISA %info $insert_hack); +use Tie::IxHash; +use Date::Format; +use FS::part_export; + +@ISA = qw(FS::part_export); + +tie my %options, 'Tie::IxHash', + 'url' => { label => 'Voicebridge API URL' }, + 'account_id' => { label => 'Voicebridge Account ID' }, +; + +%info = ( + 'svc' => 'svc_phone', #svc_bridge? svc_confbridge? + 'desc' => + 'Export conferences to the Indosoft Conference Bridge', + 'options' => \%options, + 'notes' => <<'END' +Export conferences to the Indosoft conference bridge. +Net::Indosoft::Voicebridge is required. +END +); + +$insert_hack = 0; + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_phone) = (shift, shift); + + my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main; + + my $address = $cust_main->address1; + $address .= ' '.$cust_main->address2 if $cust_main->address2; + + my $phone = $cust_main->daytime || $cust_main->night; + + my @email = $cust_main->invoicing_list_emailonly; + + #svc_phone->location_hash stuff? well that was for e911.. this shouldn't + # even be svc_phone + + #add client + my $client_return = eval { + indosoft_runcommand( 'addClient', + 'account_id' => $self->option('account_id'), + + 'client_contact_name' => $cust_main->name, #or just first last? + 'client_contact_password' => $svc_phone->sip_password, # ? + + 'client_contact_addr' => $address, + 'client_contact_city' => $cust_main->city, + 'client_contact_state' => $cust_main->state, + 'client_contact_country' => $cust_main->country, + 'client_contact_zip' => $cust_main->zip, + + 'client_contact_phone' => $phone, + 'client_contact_fax' => $cust_main->fax, + 'client_contact_email' => $email[0], + ); + }; + return $@ if $@; + + my $client_id = $client_return->{client_id}; + + #add conference + my $conf_return = eval { + indosoft_runcommand( 'addConference', + 'client_id' => $client_id, + 'conference_name' => $cust_main->name, + 'conference_desc' => $svc_phone->svcnum. ' for '. $cust_main->name, + 'start_time' => time2str('%Y-%d-$m %T', time), #now, right?? '2010-20-04 16:20:00', + #'moderated_flag' => 0, + #'entry_ann_flag' => 0 + #'record_flag' => 0 + #'moh_flag' => 0 + #'talk_detect_flag' => 0 + #'play_user_cnt_flag' => 0 + #'wait_for_admin' => 0 + #'stop_on_admin_exit' => 0 + #'second_pin' => 0 + #'secondary_pin' => 0, + #'allow_sub-conf' => 0, + #'duration' => 0, + #'conference_type' => 'reservation', #'reservationless', + ); + }; + return $@ if $@; + + my $conference_id = $conf_return->{conference_id}; + + #put conference_id in svc_phone.phonenum (and client_id in... phone_name???) + local($insert_hack) = 1; + $svc_phone->phonenum($conference_id); + $svc_phone->phone_name($client_id); + #my $error = $svc_phone->replace; + #return $error if $error; + $svc_phone->replace; + +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change phone number as conference_id with indosoft" + if $old->phonenum ne $new->phonenum && ! $insert_hack; + return ''; + + #change anything? +} + +sub _export_delete { + my( $self, $svc_phone ) = (shift, shift); + + #delete conference + my $conf_return = eval { + indosoft_runcommand( 'deleteConference', + 'conference_id' => $svc_phone->phonenum, + ); + }; + return $@ if $@; + + #delete client + my $client_return = eval { + indosoft_runcommand( 'deleteClient', + 'client_id' => $svc_phone->phone_name, + ) + }; + return $@ if $@; + + ''; + +} + +# #these three are optional +# # fallback for svc_acct will change and restore password +# sub _export_suspend { +# my( $self, $svc_phone ) = (shift, shift); +# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, +# 'suspend', $svc_phone->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +# } +# +# sub _export_unsuspend { +# my( $self, $svc_phone ) = (shift, shift); +# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, +# 'unsuspend', $svc_phone->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +# } +# +# sub export_links { +# my($self, $svc_phone, $arrayref) = (shift, shift, shift); +# #push @$arrayref, qq!!. $svc_phone->username. qq!!; +# ''; +# } + +### + +sub indosoft_runcommand { + my( $self, $method ) = (shift, shift); + + indosoft_command( + $self->option('url'), + $method, + @_, + ); + +} + +sub indosoft_command { + my( $url, $method, @args ) = @_; + + eval 'use Net::Indosoft::Voicebridge;'; + die $@ if $@; + + my $vb = new Net::Indosoft::Voicebridge( 'url' => $url ); + + my $return = $vb->$method( @args ); + + die "Indosoft error: ". $return->{'error'} if $return->{'error'}; + + $return; + +} + + +# #a good idea to queue anything that could fail or take any time +# sub indosoft_queue { +# my( $self, $svcnum, $method ) = (shift, shift, shift); +# my $queue = new FS::queue { +# 'svcnum' => $svcnum, +# 'job' => "FS::part_export::indosoft::indosoft_$method", +# }; +# $queue->insert( @_ ) or $queue; +# } +# +# sub indosoft_insert { #subroutine, not method +# my( $username, $password ) = @_; +# #do things with $username and $password +# } +# +# sub indosoft_replace { #subroutine, not method +# } +# +# sub indosoft_delete { #subroutine, not method +# my( $username ) = @_; +# #do things with $username +# } +# +# sub indosoft_suspend { #subroutine, not method +# } +# +# sub indosoft_unsuspend { #subroutine, not method +# } + + +1; -- cgit v1.2.1 From a4bd9a3338b67d27d70953af0f441bb12b39ce05 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Apr 2010 06:50:34 +0000 Subject: thirdlane deletion fix --- FS/FS/part_export/thirdlane.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_export/thirdlane.pm b/FS/FS/part_export/thirdlane.pm index bb18dd4fd..60c099748 100644 --- a/FS/FS/part_export/thirdlane.pm +++ b/FS/FS/part_export/thirdlane.pm @@ -157,7 +157,7 @@ sub _export_replace { if ( $old->pbxsvc ) { my $result = $self->_thirdlane_command( 'asterisk::rpc_did_unassign', - $self->_thirdlane_did($svc_x), + $self->_thirdlane_did($old), ); $result eq '0' or return 'Thirdlane API failure (rpc_did_unassign)'; } @@ -165,7 +165,7 @@ sub _export_replace { if ( $new->pbxsvc ) { my $result = $self->_thirdlane_command( 'asterisk::rpc_did_assign', - $self->_thirdlane_did($svc_x), + $self->_thirdlane_did($new), $new->pbx_title, ); $result eq '0' or return 'Thirdlane API failure (rpc_did_assign)'; @@ -190,7 +190,7 @@ sub _export_replace { ''; #we don't care then } else { - die "guru meditation #11: $svc_x is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; + die "guru meditation #11: $new is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; } } @@ -278,11 +278,11 @@ sub _thirdlane_command { } sub _thirdlane_did { - my($self, $svc_x) = @_; + my($self, $svc_phone) = @_; if ( $self->option('omit_countrycode') ) { - $svc_x->phonenum; + $svc_phone->phonenum; } else { - $svc_x->countrycode. $svc_x->phonenum; + $svc_phone->countrycode. $svc_phone->phonenum; } } -- cgit v1.2.1 From df646f944b388e4da5f9d162eb80a03e815dfa1d Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Apr 2010 06:55:44 +0000 Subject: mysql billing fixes, 1.9 --- FS/FS/part_event/Condition/balance.pm | 2 +- FS/FS/part_event/Condition/balance_age.pm | 2 +- FS/FS/part_event/Condition/balance_under.pm | 2 +- FS/FS/part_event/Condition/cust_bill_has_service.pm | 6 ++++-- FS/FS/part_event/Condition/cust_bill_owed.pm | 2 +- FS/FS/part_event/Condition/cust_bill_owed_under.pm | 2 +- FS/FS/part_event_condition.pm | 6 ++++-- 7 files changed, 13 insertions(+), 9 deletions(-) (limited to 'FS') diff --git a/FS/FS/part_event/Condition/balance.pm b/FS/FS/part_event/Condition/balance.pm index 65670c030..3b8854ab8 100644 --- a/FS/FS/part_event/Condition/balance.pm +++ b/FS/FS/part_event/Condition/balance.pm @@ -40,7 +40,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql > CAST( $over AS numeric )"; + "$balance_sql > CAST( $over AS DECIMAL(10,2) )"; } diff --git a/FS/FS/part_event/Condition/balance_age.pm b/FS/FS/part_event/Condition/balance_age.pm index f1a970796..fc3461210 100644 --- a/FS/FS/part_event/Condition/balance_age.pm +++ b/FS/FS/part_event/Condition/balance_age.pm @@ -38,7 +38,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_date_sql( $age ); - "$balance_sql > CAST( $over AS numeric )"; + "$balance_sql > CAST( $over AS DECIMAL(10,2) )"; } sub order_sql { diff --git a/FS/FS/part_event/Condition/balance_under.pm b/FS/FS/part_event/Condition/balance_under.pm index 9c7159011..2002c7018 100644 --- a/FS/FS/part_event/Condition/balance_under.pm +++ b/FS/FS/part_event/Condition/balance_under.pm @@ -34,7 +34,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql <= CAST( $under AS numeric )"; + "$balance_sql <= CAST( $under AS DECIMAL(10,2) )"; } diff --git a/FS/FS/part_event/Condition/cust_bill_has_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm index 91d75ddac..d85af261e 100644 --- a/FS/FS/part_event/Condition/cust_bill_has_service.pm +++ b/FS/FS/part_event/Condition/cust_bill_has_service.pm @@ -38,14 +38,16 @@ sub condition { } sub condition_sql { - my( $class, $table ) = @_; + my( $class, $table, %opt ) = @_; + + my $integer = $opt{'driver_name'} =~ /^mysql/ ? 'UNSIGNED INTEGER' : 'INTEGER'; my $servicenum = $class->condition_sql_option('has_service'); my $sql = qq| 0 < ( SELECT COUNT(cs.svcpart) FROM cust_bill_pkg cbp, cust_svc cs WHERE cbp.invnum = cust_bill.invnum AND cs.pkgnum = cbp.pkgnum - AND cs.svcpart = CAST( $servicenum AS integer ) + AND cs.svcpart = CAST( $servicenum AS $integer ) ) |; return $sql; diff --git a/FS/FS/part_event/Condition/cust_bill_owed.pm b/FS/FS/part_event/Condition/cust_bill_owed.pm index 0fd992282..d8c77c777 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed.pm @@ -48,7 +48,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql > CAST( $over AS numeric )"; + "$owed_sql > CAST( $over AS DECIMAL(10,2) )"; } 1; diff --git a/FS/FS/part_event/Condition/cust_bill_owed_under.pm b/FS/FS/part_event/Condition/cust_bill_owed_under.pm index a0bf92f27..4eb6439b6 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed_under.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed_under.pm @@ -43,7 +43,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql <= CAST( $under AS numeric )"; + "$owed_sql <= CAST( $under AS DECIMAL(10,2) )"; } 1; diff --git a/FS/FS/part_event_condition.pm b/FS/FS/part_event_condition.pm index d13e84927..32f19a3ae 100644 --- a/FS/FS/part_event_condition.pm +++ b/FS/FS/part_event_condition.pm @@ -2,7 +2,7 @@ package FS::part_event_condition; use strict; use vars qw( @ISA $DEBUG @SKIP_CONDITION_SQL ); -use FS::UID qw(dbh); +use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearch qsearchs ); use FS::option_Common; use FS::part_event; #for order_conditions_sql... @@ -285,7 +285,9 @@ sub where_conditions_sql { map { my $conditionname = $_; my $coderef = $conditions{$conditionname}->{condition_sql}; - my $sql = &$coderef( $eventtable, 'time'=>$time ); + my $sql = &$coderef( $eventtable, 'time' => $time, + 'driver_name' => driver_name(), + ); die "$coderef is not a CODEREF" unless ref($coderef) eq 'CODE'; "( cond_$conditionname.conditionname IS NULL OR $sql )"; } -- cgit v1.2.1 From adb31d819cff848d599bdb777c23144d1801b8a7 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 5 Apr 2010 06:57:25 +0000 Subject: require DBIx::DBSchema 0.39 for mysql --- FS/bin/freeside-upgrade | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'FS') diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index 97c704c91..f4ff1c28e 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -4,7 +4,7 @@ use strict; use vars qw($opt_d $opt_s $opt_q $opt_v $opt_r); use vars qw($DEBUG $DRY_RUN); use Getopt::Std; -use DBIx::DBSchema 0.31; +use DBIx::DBSchema 0.31; #0.39 use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name); #getsecrets); use FS::CurrentUser; use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); @@ -30,6 +30,11 @@ $FS::UID::callback_hack = 1; my $dbh = adminsuidsetup($user); $FS::UID::callback_hack = 0; +if ( driver_name =~ /^mysql/i ) { #until 0.39 is required above + eval "use DBIx::DBSchema 0.39;"; + die $@ if $@; +} + #needs to match FS::Schema... my $dbdef_file = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; -- cgit v1.2.1