package FS::cust_pkg;
use strict;
-use vars qw(@ISA);
+use vars qw(@ISA $disable_agentcheck $DEBUG);
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearch qsearchs );
use FS::cust_svc;
# setup }
# because they load configuraion by setting FS::UID::callback (see TODO)
use FS::svc_acct;
+use FS::svc_acct_sm;
use FS::svc_domain;
use FS::svc_www;
use FS::svc_forward;
+# need all this for sending cancel emails in sub cancel
+
+use FS::Conf;
+use Date::Format;
+use Mail::Internet 1.44;
+use Mail::Header;
+
@ISA = qw( FS::Record );
+$DEBUG = 0;
+
+$disable_agentcheck = 0;
+
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
return $error if $error;
my $cust_main = $self->cust_main;
- return "Unknown customer ". $self->custnum unless $cust_main;
-
- my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
- my $pkgpart_href = $agent->pkgpart_hashref;
- return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart
- unless $pkgpart_href->{ $self->pkgpart };
+ return "Unknown custnum: ". $self->custnum unless $cust_main;
+
+ unless ( $disable_agentcheck ) {
+ my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
+ my $pkgpart_href = $agent->pkgpart_hashref;
+ return "agent ". $agent->agentnum.
+ " can't purchase pkgpart ". $self->pkgpart
+ unless $pkgpart_href->{ $self->pkgpart };
+ }
$self->SUPER::insert;
$self->otaker($1);
if ( $self->dbdef_table->column('manual_flag') ) {
- $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
+ $self->manual_flag('') if $self->manual_flag eq ' ';
+ $self->manual_flag =~ /^([01]?)$/
+ or return "Illegal manual_flag ". $self->manual_flag;
$self->manual_flag($1);
}
''; #no error
}
-=item cancel
+=item cancel [ OPTION => VALUE ... ]
Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
in this package, then cancels the package itself (sets the cancel field to
now).
+Available options are: I<quiet>
+
+I<quiet> can be set true to supress email cancellation notices.
+
If there is an error, returns the error, otherwise returns false.
=cut
sub cancel {
- my $self = shift;
+ my( $self, %options ) = @_;
my $error;
local $SIG{HUP} = 'IGNORE';
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ my $conf = new FS::Conf;
+
+ if ( !$options{'quiet'} && $conf->exists('emailcancel')
+ && grep { $_ ne 'POST' } $self->cust_main->invoicing_list) {
+
+ my @invoicing_list = $self->cust_main->invoicing_list;
+
+ my $invoice_from = $conf->config('invoice_from');
+ my @print_text = map "$_\n", $conf->config('cancelmessage');
+ my $subject = $conf->config('cancelsubject');
+ my $smtpmachine = $conf->config('smtpmachine');
+
+ if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
+ #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card
+ #$ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $invoice_from;
+ my $header = new Mail::Header ( [
+ "From: $invoice_from",
+ "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ "Sender: $invoice_from",
+ "Reply-To: $invoice_from",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: $subject",
+ ] );
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ @print_text ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 );
+ #should this return an error?
+ }
+ }
+
''; #no errors
+
}
=item suspend
sub last_bill {
my $self = shift;
+ if ( $self->dbdef_table->column('manual_flag') ) {
+ return $self->setfield('last_bill', $_[1]) if @_;
+ return $self->getfield('last_bill') if $self->getfield('last_bill');
+ }
my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
'edate' => $self->bill, } );
$cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
in this package for sessions ending between TIMESTAMP_START (inclusive) and
-TIMESTAMP_END
-(exclusive).
+TIMESTAMP_END (exclusive).
TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
}
+=item reexport
+
+=cut
+
+sub reexport {
+ 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 $cust_svc ( $self->cust_svc ) {
+ #false laziness w/svc_Common::insert
+ my $svc_x = $cust_svc->svc_x;
+ foreach my $part_export ( $cust_svc->part_svc->part_export ) {
+ my $error = $part_export->export_insert($svc_x);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=back
=head1 SUBROUTINES
push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
}
}
+ if ( $DEBUG ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ warn "initial svcpart $svcpart: existing svcnums ".
+ join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+ }
+ }
my @cust_svc;
#generate @cust_svc
}
push @cust_svc, [
map {
- ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
- } map { $_->svcpart }
+ my $svcnum = $svcnum{$_->{svcpart}};
+ if ( $svcnum && @$svcnum ) {
+ my $num = ( $_->{quantity} < scalar(@$svcnum) )
+ ? $_->{quantity}
+ : scalar(@$svcnum);
+ splice @$svcnum, 0, $num;
+ } else {
+ ();
+ }
+ } map { { 'svcpart' => $_->svcpart,
+ 'quantity' => $_->quantity } }
qsearch('pkg_svc', { pkgpart => $pkgpart,
quantity => { op=>'>', value=>'0', } } )
];
}
+ if ( $DEBUG ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ warn "after regular move svcpart $svcpart: existing svcnums ".
+ join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+ }
+ }
+
#special-case until this can be handled better
# move services to new svcparts - even if the svcparts don't match (svcdb
# needs to...)
}
}
-
+
+ if ( $DEBUG ) {
+ foreach my $svcpart ( keys %svcnum ) {
+ warn "after special-case move svcpart $svcpart: existing svcnums ".
+ join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n";
+ }
+ }
+
+
#check for leftover services
foreach (keys %svcnum) {
next unless @{ $svcnum{$_} };
Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
method to pass dates to the recur_prog expression, it should do so.
-FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
-loaded via 'use' at compile time, rather than via 'require' in sub { setup,
-suspend, unsuspend, cancel } because they use %FS::UID::callback to load
-configuration values. Probably need a subroutine which decides what to do
-based on whether or not we've fetched the user yet, rather than a hash. See
-FS::UID and the TODO.
+FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
+compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
+cancel } because they use %FS::UID::callback to load configuration values.
+Probably need a subroutine which decides what to do based on whether or not
+we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
Now that things are transactional should the check in the insert method be
moved to check ?