[freeside-commits] freeside/FS/FS/cust_main Billing.pm, 1.3, 1.4 Billing_Realtime.pm, 1.3, 1.4 _Marketgear.pm, NONE, 1.1 Packages.pm, NONE, 1.1
Ivan,,,
ivan at wavetail.420.am
Mon Sep 20 13:29:33 PDT 2010
Update of /home/cvs/cvsroot/freeside/FS/FS/cust_main
In directory wavetail.420.am:/tmp/cvs-serv28236/FS/FS/cust_main
Modified Files:
Billing.pm Billing_Realtime.pm
Added Files:
_Marketgear.pm Packages.pm
Log Message:
last of the refatoring giant cust_main.pm for now, RT#9967
--- NEW FILE: Packages.pm ---
package FS::cust_main::Packages;
use strict;
use vars qw( $DEBUG $me );
use List::Util qw( min );
use FS::UID qw( dbh );
use FS::Record qw( qsearch );
use FS::cust_pkg;
use FS::cust_svc;
$DEBUG = 0;
$me = '[FS::cust_main::Packages]';
=head1 NAME
FS::cust_main::Packages - Packages mixin for cust_main
=head1 SYNOPSIS
=head1 DESRIPTION
These methods are available on FS::cust_main objects;
=head1 METHODS
=over 4
=item order_pkg HASHREF | OPTION => VALUE ...
Orders a single package.
Options may be passed as a list of key/value pairs or as a hash reference.
Options are:
=over 4
=item cust_pkg
FS::cust_pkg object
=item cust_location
Optional FS::cust_location object
=item svcs
Optional arryaref of FS::svc_* service objects.
=item depend_jobnum
If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
jobs will have a dependancy on the supplied job (they will not run until the
specific job completes). This can be used to defer provisioning until some
action completes (such as running the customer's credit card successfully).
=item ticket_subject
Optional subject for a ticket created and attached to this customer
=item ticket_subject
Optional queue name for ticket additions
=back
=cut
sub order_pkg {
my $self = shift;
my $opt = ref($_[0]) ? shift : { @_ };
warn "$me order_pkg called with options ".
join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
if $DEBUG;
my $cust_pkg = $opt->{'cust_pkg'};
my $svcs = $opt->{'svcs'} || [];
my %svc_options = ();
$svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
qw( ticket_subject ticket_queue );
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 ( $opt->{'cust_location'} &&
( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
my $error = $opt->{'cust_location'}->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "inserting cust_location (transaction rolled back): $error";
}
$cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
}
$cust_pkg->custnum( $self->custnum );
my $error = $cust_pkg->insert( %insert_params );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "inserting cust_pkg (transaction rolled back): $error";
}
foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
if ( $svc_something->svcnum ) {
my $old_cust_svc = $svc_something->cust_svc;
my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
$new_cust_svc->pkgnum( $cust_pkg->pkgnum);
$error = $new_cust_svc->replace($old_cust_svc);
} else {
$svc_something->pkgnum( $cust_pkg->pkgnum );
if ( $svc_something->isa('FS::svc_acct') ) {
foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
qw( seconds upbytes downbytes totalbytes ) ) {
$svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
${ $opt->{$_.'_ref'} } = 0;
}
}
$error = $svc_something->insert(%svc_options);
}
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "inserting svc_ (transaction rolled back): $error";
}
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no error
}
#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
=item order_pkgs HASHREF [ , OPTION => VALUE ... ]
Like the insert method on an existing record, this method orders multiple
packages and included services atomicaly. Pass a Tie::RefHash data structure
to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
There should be a better explanation of this, but until then, here's an
example:
use Tie::RefHash;
tie %hash, 'Tie::RefHash'; #this part is important
%hash = (
$cust_pkg => [ $svc_acct ],
...
);
$cust_main->order_pkgs( \%hash, 'noexport'=>1 );
Services can be new, in which case they are inserted, or existing unaudited
services, in which case they are linked to the newly-created package.
Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
on the supplied jobnum (they will not run until the specific job completes).
This can be used to defer provisioning until some action completes (such
as running the customer's credit card successfully).
The I<noexport> option is deprecated. If I<noexport> is set true, no
provisioning jobs (exports) are scheduled. (You can schedule them later with
the B<reexport> method for each cust_pkg object. Using the B<reexport> method
on the cust_main object is not recommended, as existing services will also be
reexported.)
If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
provided, the scalars (provided by references) will be incremented by the
values of the prepaid card.`
=cut
sub order_pkgs {
my $self = shift;
my $cust_pkgs = shift;
my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
my %options = @_;
$seconds_ref ||= $options{'seconds_ref'};
warn "$me order_pkgs called with options ".
join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
if $DEBUG;
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;
local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
foreach my $cust_pkg ( keys %$cust_pkgs ) {
my $error = $self->order_pkg(
'cust_pkg' => $cust_pkg,
'svcs' => $cust_pkgs->{$cust_pkg},
'seconds_ref' => $seconds_ref,
map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
depend_jobnum
)
);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no error
}
=item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all packages (see L<FS::cust_pkg>) for this customer.
=cut
sub all_pkgs {
my $self = shift;
my $extra_qsearch = ref($_[0]) ? shift : { @_ };
return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
my @cust_pkg = ();
if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
@cust_pkg = values %{ $self->{'_pkgnum'}->cache };
} else {
@cust_pkg = $self->_cust_pkg($extra_qsearch);
}
map { $_ } sort sort_packages @cust_pkg;
}
=item cust_pkg
Synonym for B<all_pkgs>.
=cut
sub cust_pkg {
shift->all_pkgs(@_);
}
=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
=cut
sub ncancelled_pkgs {
my $self = shift;
my $extra_qsearch = ref($_[0]) ? shift : {};
return $self->num_ncancelled_pkgs unless wantarray;
my @cust_pkg = ();
if ( $self->{'_pkgnum'} ) {
warn "$me ncancelled_pkgs: returning cached objects"
if $DEBUG > 1;
@cust_pkg = grep { ! $_->getfield('cancel') }
values %{ $self->{'_pkgnum'}->cache };
} else {
warn "$me ncancelled_pkgs: searching for packages with custnum ".
$self->custnum. "\n"
if $DEBUG > 1;
$extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
@cust_pkg = $self->_cust_pkg($extra_qsearch);
}
sort sort_packages @cust_pkg;
}
sub _cust_pkg {
my $self = shift;
my $extra_qsearch = ref($_[0]) ? shift : {};
$extra_qsearch->{'select'} ||= '*';
$extra_qsearch->{'select'} .=
',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
AS _num_cust_svc';
map {
$_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
$_;
}
qsearch({
%$extra_qsearch,
'table' => 'cust_pkg',
'hashref' => { 'custnum' => $self->custnum },
});
}
# This should be generalized to use config options to determine order.
sub sort_packages {
my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
return $locationsort if $locationsort;
if ( $a->get('cancel') xor $b->get('cancel') ) {
return -1 if $b->get('cancel');
return 1 if $a->get('cancel');
#shouldn't get here...
return 0;
} else {
my $a_num_cust_svc = $a->num_cust_svc;
my $b_num_cust_svc = $b->num_cust_svc;
return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
return -1 if $a_num_cust_svc && !$b_num_cust_svc;
return 1 if !$a_num_cust_svc && $b_num_cust_svc;
my @a_cust_svc = $a->cust_svc;
my @b_cust_svc = $b->cust_svc;
return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
$a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
}
}
=item suspended_pkgs
Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
=cut
sub suspended_pkgs {
my $self = shift;
grep { $_->susp } $self->ncancelled_pkgs;
}
=item unflagged_suspended_pkgs
Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
customer (thouse packages without the `manual_flag' set).
=cut
sub unflagged_suspended_pkgs {
my $self = shift;
return $self->suspended_pkgs
unless dbdef->table('cust_pkg')->column('manual_flag');
grep { ! $_->manual_flag } $self->suspended_pkgs;
}
=item unsuspended_pkgs
Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
this customer.
=cut
sub unsuspended_pkgs {
my $self = shift;
grep { ! $_->susp } $self->ncancelled_pkgs;
}
=item next_bill_date
Returns the next date this customer will be billed, as a UNIX timestamp, or
undef if no active package has a next bill date.
=cut
sub next_bill_date {
my $self = shift;
min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
}
=item num_cancelled_pkgs
Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
customer.
=cut
sub num_cancelled_pkgs {
shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
}
sub num_ncancelled_pkgs {
shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
}
sub num_pkgs {
my( $self ) = shift;
my $sql = scalar(@_) ? shift : '';
$sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
my $sth = dbh->prepare(
"SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
) or die dbh->errstr;
$sth->execute($self->custnum) or die $sth->errstr;
$sth->fetchrow_arrayref->[0];
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::cust_main>, L<FS::cust_pkg>
=cut
1;
Index: Billing.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main/Billing.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -d -r1.3 -r1.4
--- Billing.pm 20 Sep 2010 19:55:18 -0000 1.3
+++ Billing.pm 20 Sep 2010 20:29:31 -0000 1.4
@@ -37,7 +37,7 @@
=head1 SYNOPSIS
-=head1 DESCRIPTIONS
+=head1 DESCRIPTION
These methods are available on FS::cust_main objects.
@@ -2022,4 +2022,12 @@
return $total_unapplied_payments;
}
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
+
+=cut
+
1;
Index: Billing_Realtime.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main/Billing_Realtime.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -d -r1.3 -r1.4
--- Billing_Realtime.pm 19 Sep 2010 00:13:05 -0000 1.3
+++ Billing_Realtime.pm 20 Sep 2010 20:29:31 -0000 1.4
@@ -3,6 +3,7 @@
use strict;
use vars qw( $conf $DEBUG $me );
use vars qw( $realtime_bop_decline_quiet ); #ugh
+use Digest::MD5 qw(md5_base64);
use FS::UID qw( dbh );
use FS::Record qw( qsearch qsearchs );
use FS::Misc qw( send_email );
@@ -30,7 +31,7 @@
=head1 SYNOPSIS
-=head1 DESCRIPTIONS
+=head1 DESCRIPTION
These methods are available on FS::cust_main objects.
--- NEW FILE: _Marketgear.pm ---
package FS::cust_main::_Marketgear;
use strict;
use vars qw( $DEBUG $me $conf );
$DEBUG = 0;
$me = '[FS::cust_main::_Marketgear]';
install_callback FS::UID sub {
$conf = new FS::Conf;
};
sub start_copy_skel {
my $self = shift;
return '' unless $conf->config('cust_main-skeleton_tables')
&& $conf->config('cust_main-skeleton_custnum');
warn " inserting skeleton records\n"
if $DEBUG > 1 || $cust_main::DEBUG > 1;
#'mg_user_preference' => {},
#'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
#'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
#'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
#'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
die $@ if $@;
_copy_skel( 'cust_main', #tablename
$conf->config('cust_main-skeleton_custnum'), #sourceid
$self->custnum, #destid
@tables, #child tables
);
}
#recursive subroutine, not a method
sub _copy_skel {
my( $table, $sourceid, $destid, %child_tables ) = @_;
my $primary_key;
if ( $table =~ /^(\w+)\.(\w+)$/ ) {
( $table, $primary_key ) = ( $1, $2 );
} else {
my $dbdef_table = dbdef->table($table);
$primary_key = $dbdef_table->primary_key
or return "$table has no primary key".
" (or do you need to run dbdef-create?)";
}
warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
join (', ', keys %child_tables). "\n"
if $DEBUG > 2;
foreach my $child_table_def ( keys %child_tables ) {
my $child_table;
my $child_pkey = '';
if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
( $child_table, $child_pkey ) = ( $1, $2 );
} else {
$child_table = $child_table_def;
$child_pkey = dbdef->table($child_table)->primary_key;
# or return "$table has no primary key".
# " (or do you need to run dbdef-create?)\n";
}
my $sequence = '';
if ( keys %{ $child_tables{$child_table_def} } ) {
return "$child_table has no primary key".
" (run dbdef-create or try specifying it?)\n"
unless $child_pkey;
#false laziness w/Record::insert and only works on Pg
#refactor the proper last-inserted-id stuff out of Record::insert if this
# ever gets use for anything besides a quick kludge for one customer
my $default = dbdef->table($child_table)->column($child_pkey)->default;
$default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
or return "can't parse $child_table.$child_pkey default value ".
" for sequence name: $default";
$sequence = $1;
}
my @sel_columns = grep { $_ ne $primary_key }
dbdef->table($child_table)->columns;
my $sel_columns = join(', ', @sel_columns );
my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
my $sel_st = "SELECT $sel_columns FROM $child_table".
" WHERE $primary_key = $sourceid";
warn " $sel_st\n"
if $DEBUG > 2;
my $sel_sth = dbh->prepare( $sel_st )
or return dbh->errstr;
$sel_sth->execute or return $sel_sth->errstr;
while ( my $row = $sel_sth->fetchrow_hashref ) {
warn " selected row: ".
join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
if $DEBUG > 2;
my $statement =
"INSERT INTO $child_table $ins_columns VALUES $placeholders";
my $ins_sth =dbh->prepare($statement)
or return dbh->errstr;
my @param = ( $destid, map $row->{$_}, @ins_columns );
warn " $statement: [ ". join(', ', @param). " ]\n"
if $DEBUG > 2;
$ins_sth->execute( @param )
or return $ins_sth->errstr;
#next unless keys %{ $child_tables{$child_table} };
next unless $sequence;
#another section of that laziness
my $seq_sql = "SELECT currval('$sequence')";
my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
$seq_sth->execute or return $seq_sth->errstr;
my $insertid = $seq_sth->fetchrow_arrayref->[0];
# don't drink soap! recurse! recurse! okay!
my $error =
_copy_skel( $child_table_def,
$row->{$child_pkey}, #sourceid
$insertid, #destid
%{ $child_tables{$child_table_def} },
);
return $error if $error;
}
}
return '';
}
1;
More information about the freeside-commits
mailing list