[freeside-commits] freeside/FS/FS AccessRight.pm, 1.21, 1.22 Conf.pm, 1.202, 1.203 Record.pm, 1.141, 1.142 Schema.pm, 1.60, 1.61 Setup.pm, 1.9, 1.10 access_group.pm, 1.2, 1.3 access_user.pm, 1.15, 1.16 access_user_pref.pm, 1.1, 1.2 agent.pm, 1.15, 1.16 cust_bill.pm, 1.174, 1.175 cust_credit.pm, 1.25, 1.26 cust_event.pm, NONE, 1.1 cust_main.pm, 1.293, 1.294 cust_pay.pm, 1.53, 1.54 cust_pay_batch.pm, 1.23, 1.24 cust_pkg.pm, 1.79, 1.80 cust_refund.pm, 1.29, 1.30 m2name_Common.pm, 1.1, 1.2 option_Common.pm, 1.7, 1.8 part_bill_event.pm, 1.27, 1.28 part_event.pm, NONE, 1.1 part_event_condition.pm, NONE, 1.1 part_event_condition_option.pm, NONE, 1.1 part_event_condition_option_option.pm, NONE, 1.1 part_event_option.pm, NONE, 1.1 pay_batch.pm, 1.11, 1.12 payby.pm, 1.11, 1.12 pkg_referral.pm, NONE, 1.1 svc_Common.pm, 1.41, 1.42 svc_acct.pm, 1.233, 1.234 svc_domain.pm, 1.48, 1.49 svc_forward.pm, 1.20, 1.21 svc_www.pm, 1.15, 1.16
Ivan,,,
ivan at wavetail.420.am
Wed Aug 1 15:24:39 PDT 2007
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail:/tmp/cvs-serv23435/FS/FS
Modified Files:
AccessRight.pm Conf.pm Record.pm Schema.pm Setup.pm
access_group.pm access_user.pm access_user_pref.pm agent.pm
cust_bill.pm cust_credit.pm cust_main.pm cust_pay.pm
cust_pay_batch.pm cust_pkg.pm cust_refund.pm m2name_Common.pm
option_Common.pm part_bill_event.pm pay_batch.pm payby.pm
svc_Common.pm svc_acct.pm svc_domain.pm svc_forward.pm
svc_www.pm
Added Files:
cust_event.pm part_event.pm part_event_condition.pm
part_event_condition_option.pm
part_event_condition_option_option.pm part_event_option.pm
pkg_referral.pm
Log Message:
event refactor, landing on HEAD!
Index: payby.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/payby.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- payby.pm 23 Jan 2007 06:45:02 -0000 1.11
+++ payby.pm 1 Aug 2007 22:24:37 -0000 1.12
@@ -112,16 +112,6 @@
longname => 'Chargeback',
cust_main => '', # not a customer type
},
- 'DCLN' => { # This is only an event.
- tinyname => 'declined',
- shortname => 'Batch declined payment',
- longname => 'Batch declined payment',
-
- #its neither of these..
- cust_main => '',
- cust_pay => '',
-
- },
;
sub payby {
Index: part_bill_event.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_bill_event.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- part_bill_event.pm 21 Jan 2007 21:45:28 -0000 1.27
+++ part_bill_event.pm 1 Aug 2007 22:24:36 -0000 1.28
@@ -2,6 +2,7 @@
use strict;
use vars qw( @ISA $DEBUG @EXPORT_OK );
+use Carp qw(cluck confess);
use FS::Record qw( dbh qsearch qsearchs );
use FS::Conf;
@@ -37,10 +38,10 @@
=head1 DESCRIPTION
-An FS::part_bill_event object represents an invoice event definition -
-a callback which is triggered when an invoice is a certain amount of time
-overdue. FS::part_bill_event inherits from
-FS::Record. The following fields are currently supported:
+An FS::part_bill_event object represents a deprecated, old-style invoice event
+definition - a callback which is triggered when an invoice is a certain amount
+of time overdue. FS::part_bill_event inherits from FS::Record. The following
+fields are currently supported:
=over 4
@@ -66,6 +67,11 @@
=back
+=head1 NOTE
+
+Old-style invoice events are only useful for legacy migrations - if you are
+looking for current events see L<FS::part_event>.
+
=head1 METHODS
=over 4
@@ -226,6 +232,10 @@
sub due_events {
my ($record, $payby, $event_time, $extra_sql) = @_;
+
+ #cluck "DEPRECATED: FS::part_bill_event::due_events called on $record";
+ confess "DEPRECATED: FS::part_bill_event::due_events called on $record";
+
my $interval = 0;
if ($record->_date){
$event_time = time unless $event_time;
@@ -261,6 +271,10 @@
sub do_event {
my ($self, $object, %options) = @_;
+
+ #cluck "DEPRECATED: FS::part_bill_event::do_event called on $self";
+ confess "DEPRECATED: FS::part_bill_event::do_event called on $self";
+
warn " calling event (". $self->eventcode. ") for " . $object->table . " " ,
$object->get($object->dbdef_table->primary_key) . "\n" if $DEBUG > 1;
my $oldAutoCommit = $FS::UID::AutoCommit;
Index: access_user_pref.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/access_user_pref.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- access_user_pref.pm 14 May 2006 16:47:31 -0000 1.1
+++ access_user_pref.pm 1 Aug 2007 22:24:36 -0000 1.2
@@ -27,19 +27,22 @@
=head1 DESCRIPTION
-An FS::access_user_pref object represents an example. FS::access_user_pref inherits from
-FS::Record. The following fields are currently supported:
+An FS::access_user_pref object represents an per-user preference. Preferenaces
+are also used to store transient state information (server-side "cookies").
+FS::access_user_pref inherits from FS::Record. The following fields are
+currently supported:
=over 4
=item prefnum - primary key
-=item usernum -
+=item usernum - Internal access user (see L<FS::access_user>)
=item prefname -
=item prefvalue -
+=item expiration -
=back
@@ -49,7 +52,7 @@
=item new HASHREF
-Creates a new example. To add the example to the database, see L<"insert">.
+Creates a new preference. To add the example 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<hash> method.
@@ -88,7 +91,7 @@
=item check
-Checks all fields to make sure this is a valid example. If there is
+Checks all fields to make sure this is a valid preference. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
@@ -104,7 +107,8 @@
$self->ut_numbern('prefnum')
|| $self->ut_number('usernum')
|| $self->ut_text('prefname')
- || $self->ut_textn('prefvalue')
+ #|| $self->ut_textn('prefvalue')
+ || $self->ut_anything('prefvalue')
;
return $error if $error;
@@ -115,11 +119,9 @@
=head1 BUGS
-The author forgot to customize this manpage.
-
=head1 SEE ALSO
-L<FS::Record>, schema.html from the base documentation.
+L<FS::access_user>, L<FS::Record>, schema.html from the base documentation.
=cut
Index: svc_acct.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_acct.pm,v
retrieving revision 1.233
retrieving revision 1.234
diff -u -d -r1.233 -r1.234
--- svc_acct.pm 12 Jul 2007 13:36:26 -0000 1.233
+++ svc_acct.pm 1 Aug 2007 22:24:37 -0000 1.234
@@ -779,7 +779,7 @@
}
}
- $error = $new->SUPER::replace($old);
+ $error = $new->SUPER::replace($old, @_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error if $error;
@@ -845,7 +845,7 @@
sub suspend {
my $self = shift;
return "can't suspend system account" if $self->_check_system;
- $self->SUPER::suspend;
+ $self->SUPER::suspend(@_);
}
=item unsuspend
@@ -867,7 +867,7 @@
return $error if $error;
}
- $self->SUPER::unsuspend;
+ $self->SUPER::unsuspend(@_);
}
=item cancel
@@ -898,7 +898,7 @@
}
}
- $self->SUPER::cancel;
+ $self->SUPER::cancel(@_);
}
--- NEW FILE: part_event_option.pm ---
package FS::part_event_option;
use strict;
use vars qw( @ISA );
use FS::UID qw( dbh );
use FS::Record qw( qsearch qsearchs );
use FS::part_event;
use FS::reason;
@ISA = qw(FS::Record);
=head1 NAME
FS::part_event_option - Object methods for part_event_option records
=head1 SYNOPSIS
use FS::part_event_option;
$record = new FS::part_event_option \%hash;
$record = new FS::part_event_option { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::part_event_option object represents an event definition option (action
option). FS::part_event_option inherits from FS::Record. The following fields
are currently supported:
=over 4
=item optionnum - primary key
=item eventpart - Event definition (see L<FS::part_event>)
=item optionname - Option name
=item optionvalue - Option value
=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<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'part_event_option'; }
=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;
if ( $self->optionname eq 'reasonnum' && $self->optionvalue eq 'HASH' ) {
my $error = $self->insert_reason(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
my $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
# 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
sub replace {
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 $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
? shift
: $self->replace_old;
if ( $self->optionname eq 'reasonnum' ) {
warn "reasonnum: ". $self->optionvalue;
}
if ( $self->optionname eq 'reasonnum' && $self->optionvalue eq 'HASH' ) {
my $error = $self->insert_reason(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
my $error = $self->SUPER::replace($old);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
=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('optionnum')
|| $self->ut_foreign_key('eventpart', 'part_event', 'eventpart' )
|| $self->ut_text('optionname')
|| $self->ut_textn('optionvalue')
;
return $error if $error;
$self->SUPER::check;
}
sub insert_reason {
my( $self, $reason ) = @_;
my $reason_obj = new FS::reason({
'reason_type' => $reason->{'typenum'},
'reason' => $reason->{'reason'},
});
$reason_obj->insert or $self->optionvalue( $reason_obj->reasonnum ) and '';
}
=back
=head1 SEE ALSO
L<FS::part_event>, L<FS::Record>, schema.html from the base documentation.
=cut
1;
Index: Setup.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Setup.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- Setup.pm 2 Apr 2007 15:49:36 -0000 1.9
+++ Setup.pm 1 Aug 2007 22:24:36 -0000 1.10
@@ -161,51 +161,52 @@
{ 'groupname' => 'Superuser' },
],
- #billing events
- 'part_bill_event' => [
- { 'payby' => 'CARD',
- 'event' => 'Batch card',
- 'seconds' => 0,
- 'eventcode' => '$cust_bill->batch_card(%options);',
- 'weight' => 40,
- 'plan' => 'batch-card',
- },
- { 'payby' => 'BILL',
- 'event' => 'Send invoice',
- 'seconds' => 0,
- 'eventcode' => '$cust_bill->send();',
- 'weight' => 50,
- 'plan' => 'send',
- },
- { 'payby' => 'DCRD',
- 'event' => 'Send invoice',
- 'seconds' => 0,
- 'eventcode' => '$cust_bill->send();',
- 'weight' => 50,
- 'plan' => 'send',
- },
- { 'payby' => 'DCHK',
- 'event' => 'Send invoice',
- 'seconds' => 0,
- 'eventcode' => '$cust_bill->send();',
- 'weight' => 50,
- 'plan' => 'send',
- },
- { 'payby' => 'DCLN',
- 'event' => 'Suspend',
- 'seconds' => 0,
- 'eventcode' => '$cust_bill->suspend();',
- 'weight' => 40,
- 'plan' => 'suspend',
- },
- #{ 'payby' => 'DCLN',
- # 'event' => 'Retriable',
- # 'seconds' => 0,
- # 'eventcode' => '$cust_bill_event->retriable();',
- # 'weight' => 60,
- # 'plan' => 'retriable',
- #},
- ],
+#XXX need default new-style billing events
+# #billing events
+# 'part_bill_event' => [
+# { 'payby' => 'CARD',
+# 'event' => 'Batch card',
+# 'seconds' => 0,
+# 'eventcode' => '$cust_bill->batch_card(%options);',
+# 'weight' => 40,
+# 'plan' => 'batch-card',
+# },
+# { 'payby' => 'BILL',
+# 'event' => 'Send invoice',
+# 'seconds' => 0,
+# 'eventcode' => '$cust_bill->send();',
+# 'weight' => 50,
+# 'plan' => 'send',
+# },
+# { 'payby' => 'DCRD',
+# 'event' => 'Send invoice',
+# 'seconds' => 0,
+# 'eventcode' => '$cust_bill->send();',
+# 'weight' => 50,
+# 'plan' => 'send',
+# },
+# { 'payby' => 'DCHK',
+# 'event' => 'Send invoice',
+# 'seconds' => 0,
+# 'eventcode' => '$cust_bill->send();',
+# 'weight' => 50,
+# 'plan' => 'send',
+# },
+# { 'payby' => 'DCLN',
+# 'event' => 'Suspend',
+# 'seconds' => 0,
+# 'eventcode' => '$cust_bill->suspend();',
+# 'weight' => 40,
+# 'plan' => 'suspend',
+# },
+# #{ 'payby' => 'DCLN',
+# # 'event' => 'Retriable',
+# # 'seconds' => 0,
+# # 'eventcode' => '$cust_bill_event->retriable();',
+# # 'weight' => 60,
+# # 'plan' => 'retriable',
+# #},
+# ],
#you must create a service definition. An example of a service definition
#would be a dial-up account or a domain. First, it is necessary to create a
--- NEW FILE: part_event.pm ---
package FS::part_event;
use strict;
use vars qw( @ISA $DEBUG );
use Carp qw(confess);
use FS::Record qw( dbh qsearch qsearchs );
use FS::option_Common;
use FS::m2name_Common;
use FS::Conf;
use FS::part_event_option;
use FS::part_event_condition;
use FS::cust_event;
use FS::agent;
@ISA = qw( FS::m2name_Common FS::option_Common ); # FS::Record );
$DEBUG = 0;
=head1 NAME
FS::part_event - Object methods for part_event records
=head1 SYNOPSIS
use FS::part_event;
$record = new FS::part_event \%hash;
$record = new FS::part_event { 'column' => 'value' };
$error = $record->insert( { 'option' => 'value' } );
$error = $record->insert( \%options );
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
$error = $record->do_event( $direct_object );
=head1 DESCRIPTION
An FS::part_event object represents an event definition - a billing, collection
or other callback which is triggered when certain customer, invoice, package or
other conditions are met. FS::part_event inherits from FS::Record. The
following fields are currently supported:
=over 4
=item eventpart - primary key
=item agentnum - Optional agentnum (see L<FS::agent>)
=item event - event name
=item eventtable - table name against which this event is triggered; currently "cust_bill" (the traditional invoice events), "cust_main" (customer events) or "cust_pkg (package events)
=item check_freq - how often events of this type are checked; currently "1d" (daily) and "1m" (monthly) are recognized. Note that the apprioriate freeside-daily and/or freeside-monthly cron job needs to be in place.
=item weight - ordering for events
=item action - event action (like part_bill_event.plan - eventcode plan)
=item disabled - Disabled flag, empty or `Y'
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new invoice event definition. To add the invoice event definition 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<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'part_event'; }
=item insert [ HASHREF ]
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
If a list or hash reference of options is supplied, part_export_option records
are created (see L<FS::part_event_option>).
=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 [ HASHREF | OPTION => VALUE ... ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
If a list or hash reference of options is supplied, part_event_option
records are created or modified (see L<FS::part_event_option>).
=cut
# the replace method can be inherited from FS::Record
=item check
Checks all fields to make sure this is a valid invoice event definition. 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;
$self->weight(0) unless $self->weight;
my $error =
$self->ut_numbern('eventpart')
|| $self->ut_text('event')
|| $self->ut_enum('eventtable', [ 'cust_bill', 'cust_main', 'cust_pkg' ] )
|| $self->ut_enum('check_freq', [ '1d', '1m' ])
|| $self->ut_number('weight')
|| $self->ut_alpha('action')
|| $self->ut_enum('disabled', [ '', 'Y' ] )
;
return $error if $error;
#XXX check action to make sure a module exists?
# well it'll die in _rebless...
$self->SUPER::check;
}
=item _rebless
Reblesses the object into the FS::part_event::Action::ACTION class, where
ACTION is the object's I<action> field.
=cut
sub _rebless {
my $self = shift;
my $action = $self->action or return $self;
#my $class = ref($self). "::$action";
my $class = "FS::part_event::Action::$action";
eval "use $class";
die $@ if $@;
bless($self, $class); # unless $@;
$self;
}
=item part_event_condition
Returns the conditions associated with this event, as FS::part_event_condition
objects (see L<FS::part_event_condition>)
=cut
sub part_event_condition {
my $self = shift;
qsearch( 'part_event_condition', { 'eventpart' => $self->eventpart } );
}
=item new_cust_event OBJECT
Creates a new customer event (see L<FS::cust_event>) for the provided object.
=cut
sub new_cust_event {
my( $self, $object ) = @_;
confess "**** $object is not a ". $self->eventtable
if ref($object) ne "FS::". $self->eventtable;
my $pkey = $object->primary_key;
new FS::cust_event {
'eventpart' => $self->eventpart,
'tablenum' => $object->$pkey(),
'_date' => time, #i think we always want the real "now" here.
'status' => 'new',
};
}
#surely this doesn't work
sub reasontext { confess "part_event->reasontext deprecated"; }
#=item reasontext
#
#Returns the text of any reason associated with this event.
#
#=cut
#
#sub reasontext {
# my $self = shift;
# my $r = qsearchs('reason', { 'reasonnum' => $self->reason });
# if ($r){
# $r->reason;
# }else{
# '';
# }
#}
=item agent
Returns the associated agent for this event, if any, as an FS::agent object.
=cut
sub agent {
my $self = shift;
qsearchs('agent', { 'agentnum' => $self->agentnum } );
}
=item templatename
Returns the alternate invoice template name, if any, or false if there is
no alternate template for this event.
=cut
sub templatename {
my $self = shift;
if ( $self->action =~ /^cust_bill_send_(alternate|agent)$/
&& ( $self->option('agent_templatename')
|| $self->option('templatename') )
)
{
$self->option('agent_templatename')
|| $self->option('templatename');
} else {
'';
}
}
=back
=head1 CLASS METHODS
=over 4
=item eventtable_labels
Returns a hash reference of labels for eventtable values,
i.e. 'cust_main'=>'Customer'
=cut
sub eventtable_labels {
#my $class = shift;
tie my %hash, 'Tie::IxHash',
'cust_pkg' => 'Package',
'cust_bill' => 'Invoice',
'cust_main' => 'Customer',
'cust_pay_batch' => 'Batch payment',
;
\%hash
}
=item eventtable_pkey_sql
Returns a hash reference of full SQL primary key names for eventtable values,
i.e. 'cust_main'=>'cust_main.custnum'
=cut
sub eventtable_pkey_sql {
#my $class = shift;
my %hash = (
'cust_main' => 'cust_main.custnum',
'cust_bill' => 'cust_bill.invnum',
'cust_pkg' => 'cust_pkg.pkgnum',
'cust_pay_batch' => 'cust_pay_batch.paybatchnum',
);
\%hash;
}
=item eventtables
Returns a list of eventtable values (default ordering; suited for display).
=cut
sub eventtables {
my $class = shift;
my $eventtables = $class->eventtable_labels;
keys %$eventtables;
}
=item eventtables_runorder
Returns a list of eventtable values (run order).
=cut
sub eventtables_runorder {
shift->eventtables; #same for now
}
=item check_freq_labels
Returns a hash reference of labels for check_freq values,
i.e. '1d'=>'daily'
=cut
sub check_freq_labels {
#my $class = shift;
#Tie::IxHash??
{
'1d' => 'daily',
'1m' => 'monthly',
};
}
=item actions [ EVENTTABLE ]
Return information about the available actions. If an eventtable is specified,
only return information about actions available for that eventtable.
Information is returned as key-value pairs. Keys are event names. Values are
hashrefs with the following keys:
=over 4
=item description
=item eventtable_hashref
=item option_fields
=item default_weight
=item deprecated
=back
See L<FS::part_event::Action> for more information.
=cut
#false laziness w/part_event_condition.pm
#some false laziness w/part_export & part_pkg
my %actions;
foreach my $INC ( @INC ) {
foreach my $file ( glob("$INC/FS/part_event/Action/*.pm") ) {
warn "attempting to load Action from $file\n" if $DEBUG;
$file =~ /\/(\w+)\.pm$/ or do {
warn "unrecognized file in $INC/FS/part_event/Action/: $file\n";
next;
};
my $mod = $1;
eval "use FS::part_event::Action::$mod;";
if ( $@ ) {
die "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
#warn "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
#next;
}
$actions{$mod} = {
( map { $_ => "FS::part_event::Action::$mod"->$_() }
qw( description eventtable_hashref default_weight deprecated )
#option_fields_hashref
),
'option_fields' => [ "FS::part_event::Action::$mod"->option_fields() ],
};
}
}
sub actions {
my( $class, $eventtable ) = @_;
(
map { $_ => $actions{$_} }
sort { $actions{$a}->{'default_weight'}<=>$actions{$b}->{'default_weight'} }
$class->all_actions( $eventtable )
);
}
=item all_actions [ EVENTTABLE ]
Returns a list of just the action names
=cut
sub all_actions {
my ( $class, $eventtable ) = @_;
grep { !$eventtable || $actions{$_}->{'eventtable_hashref'}{$eventtable} }
keys %actions
}
=back
=head1 SEE ALSO
L<FS::part_event_option>, L<FS::part_event_condition>, L<FS::cust_main>,
L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_bill_event>, L<FS::Record>,
schema.html from the base documentation.
=cut
1;
Index: cust_pay.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pay.pm,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- cust_pay.pm 11 Jul 2007 08:08:28 -0000 1.53
+++ cust_pay.pm 1 Aug 2007 22:24:36 -0000 1.54
@@ -550,6 +550,36 @@
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item unapplied_sql
+
+Returns an SQL fragment to retreive the unapplied amount.
+
+=cut
+
+sub unapplied_sql {
+ #my $class = shift;
+
+ "paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ";
+
+}
+
+=back
+
=head1 BUGS
Delete and replace methods.
Index: m2name_Common.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/m2name_Common.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- m2name_Common.pm 18 Jun 2006 12:54:48 -0000 1.1
+++ m2name_Common.pm 1 Aug 2007 22:24:36 -0000 1.2
@@ -1,34 +1,51 @@
package FS::m2name_Common;
use strict;
-use vars qw( @ISA $DEBUG );
+use vars qw( $DEBUG $me );
+use Carp;
use FS::Schema qw( dbdef );
-use FS::Record qw( qsearch qsearchs ); #dbh );
-
- at ISA = qw( FS::Record );
+use FS::Record qw( qsearchs ); #qsearch dbh );
$DEBUG = 0;
+$me = '[FS::m2name_Common]';
+
=head1 NAME
-FS::m2name_Common - Base class for tables with a related table listing names
+FS::m2name_Common - Mixin class for tables with a related table listing names
=head1 SYNOPSIS
use FS::m2name_Common;
- at ISA = qw( FS::m2name_Common );
+ at ISA = qw( FS::m2name_Common FS::Record );
=head1 DESCRIPTION
-FS::m2name_Common is intended as a base class for classes which have a
+FS::m2name_Common is intended as a mixin class for classes which have a
related table that lists names.
=head1 METHODS
=over 4
-=item process_m2name
+=item process_m2name OPTION => VALUE, ...
+
+Available options:
+
+link_table (required) - Table into which the records are inserted.
+
+num_col (optional) - Column in link_table which links to the primary key of the base table. If not specified, it is assumed this has the same name.
+
+name_col (required) - Name of the column in link_table that stores the string names.
+
+names_list (required) - List reference of the possible string name values.
+
+params (required) - Hashref of keys and values, often passed as C<scalar($cgi->Vars)> from a form. Processing is controlled by the B<param_style param> option.
+
+param_style (required) - Controls processing of B<params>. I<'link_table.value checkboxes'> specifies that parameters keys are in the form C<link_table.name>, and the values are booleans controlling whether or not to insert that name into link_table. I<'name_colN values'> specifies that parameter keys are in the form C<name_col0>, C<name_col1>, and so on, and values are the names inserted into link_table.
+
+args_callback (optional) - Coderef. Optional callback that may modify arguments for insert and replace operations. The callback is run with four arguments: the first argument is object being inserted or replaced (i.e. FS::I<link_table> object), the second argument is a prefix to use when retreiving CGI arguements from the params hashref, the third argument is the params hashref (see above), and the final argument is a listref of arguments that the callback should modify.
=cut
@@ -42,21 +59,61 @@
my $link_static = $opt{'link_static'} || {};
+ warn "$me processing m2name from ". $self->table. ".$link_sourcekey".
+ " to $link_table\n"
+ if $DEBUG;
+
foreach my $name ( @{ $opt{'names_list'} } ) {
+ warn "$me checking $name\n" if $DEBUG;
+
+ my $name_col = $opt{'name_col'};
+
my $obj = qsearchs( $link_table, {
$link_sourcekey => $self->$self_pkey(),
- $opt{'name_col'} => $name,
+ $name_col => $name,
%$link_static,
});
- if ( $obj && ! $opt{'params'}->{"$link_table.$name"} ) {
+ my $param = '';
+ my $prefix = '';
+ if ( $opt{'param_style'} =~ /link_table.value\s+checkboxes/i ) {
+ #access_group.html style
+ my $paramname = "$link_table.$name";
+ $param = $opt{'params'}->{$paramname};
+ } elsif ( $opt{'param_style'} =~ /name_colN values/i ) {
+ #part_event.html style
+
+ my @fields = grep { /^$name_col\d+$/ }
+ keys %{$opt{'params'}};
+
+ $param = grep { $name eq $opt{'params'}->{$_} } @fields;
+
+ if ( $param ) {
+ #this depends on their being one condition per name...
+ #which needs to be enforced on the edit page...
+ #(it is on part_event and access_group edit)
+ foreach my $field (@fields) {
+ $prefix = "$field." if $name eq $opt{'params'}->{$field};
+ }
+ warn "$me prefix $prefix\n" if $DEBUG;
+ }
+ } else { #??
+ croak "unknown param_style: ". $opt{'param_style'};
+ $param = $opt{'params'}->{$name};
+ }
+
+ if ( $obj && ! $param ) {
+
+ warn "$me deleting $name\n" if $DEBUG;
my $d_obj = $obj; #need to save $obj for below.
my $error = $d_obj->delete;
die "error deleting $d_obj for $link_table.$name: $error" if $error;
- } elsif ( $opt{'params'}->{"$link_table.$name"} && ! $obj ) {
+ } elsif ( $param && ! $obj ) {
+
+ warn "$me inserting $name\n" if $DEBUG;
#ok to clobber it now (but bad form nonetheless?)
#$obj = new "FS::$link_table" ( {
@@ -65,8 +122,33 @@
$opt{'name_col'} => $name,
%$link_static,
});
- my $error = $obj->insert;
+
+ my @args = ();
+ if ( $opt{'args_callback'} ) { #edit/process/part_event.html
+ &{ $opt{'args_callback'} }( $obj,
+ $prefix,
+ $opt{'params'},
+ \@args
+ );
+ }
+
+ my $error = $obj->insert( @args );
die "error inserting $obj for $link_table.$name: $error" if $error;
+
+ } elsif ( $param && $obj && $opt{'args_callback'} ) {
+
+ my @args = ();
+ if ( $opt{'args_callback'} ) { #edit/process/part_event.html
+ &{ $opt{'args_callback'} }( $obj,
+ $prefix,
+ $opt{'params'},
+ \@args
+ );
+ }
+
+ my $error = $obj->replace( $obj, @args );
+ die "error replacing $obj for $link_table.$name: $error" if $error;
+
}
}
Index: svc_domain.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_domain.pm,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -d -r1.48 -r1.49
--- svc_domain.pm 28 Jan 2007 02:21:11 -0000 1.48
+++ svc_domain.pm 1 Aug 2007 22:24:37 -0000 1.49
@@ -271,7 +271,7 @@
}
}
- my $error = $self->SUPER::delete;
+ my $error = $self->SUPER::delete(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
@@ -298,7 +298,7 @@
# Better to do it here than to force the caller to remember that svc_domain is weird.
$new->setfield(action => 'M');
- my $error = $new->SUPER::replace($old);
+ my $error = $new->SUPER::replace($old, @_);
return $error if $error;
}
--- NEW FILE: part_event_condition_option.pm ---
package FS::part_event_condition_option;
use strict;
use vars qw( @ISA );
use FS::Record qw( qsearch qsearchs );
use FS::option_Common;
use FS::part_event_condition;
@ISA = qw( FS::option_Common ); # FS::Record);
=head1 NAME
FS::part_event_condition_option - Object methods for part_event_condition_option records
=head1 SYNOPSIS
use FS::part_event_condition_option;
$record = new FS::part_event_condition_option \%hash;
$record = new FS::part_event_condition_option { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::part_event_condition_option object represents an event condition option.
FS::part_event_condition_option inherits from FS::Record. The following fields
are currently supported:
=over 4
=item optionnum - primary key
=item eventconditionnum - Event condition (see L<FS::part_event_condition>)
=item optionname - Option name
=item optionvalue - Option value
=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<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'part_event_condition_option'; }
=item insert [ HASHREF | OPTION => VALUE ... ]
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
If a list or hash reference of options is supplied,
part_event_condition_option_option records are created (see
L<FS::part_event_condition_option_option>).
=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 [ HASHREF | OPTION => VALUE ... ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
If a list or hash reference of options is supplied,
part_event_condition_option_option records are created or modified (see
L<FS::part_event_condition_option_option>).
=cut
# the replace method can be inherited from FS::Record
=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('optionnum')
|| $self->ut_foreign_key('eventconditionnum',
'part_event_condition', 'eventconditionnum')
|| $self->ut_text('optionname')
|| $self->ut_textn('optionvalue')
;
return $error if $error;
$self->SUPER::check;
}
#this makes the nested options magically show up as perl refs
#move it to a mixin class if we need nested options again
sub optionvalue {
my $self = shift;
if ( scalar(@_) ) { #setting, no magic (here, insert takes care of it)
$self->set('optionvalue', @_);
} else { #getting, magic
my $optionvalue = $self->get('optionvalue');
if ( $optionvalue eq 'HASH' ) {
return { $self->options };
} else {
$optionvalue;
}
}
}
=back
=head1 SEE ALSO
L<FS::part_event_condition>, L<FS::part_event_condition_option_option>,
L<FS::Record>, schema.html from the base documentation.
=cut
1;
Index: agent.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/agent.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- agent.pm 25 Jul 2006 08:33:46 -0000 1.15
+++ agent.pm 1 Aug 2007 22:24:36 -0000 1.16
@@ -117,6 +117,7 @@
|| $self->ut_number('typenum')
|| $self->ut_numbern('freq')
|| $self->ut_textn('prog')
+ || $self->ut_textn('invoice_template')
;
return $error if $error;
Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -d -r1.79 -r1.80
--- cust_pkg.pm 2 Jul 2007 00:15:35 -0000 1.79
+++ cust_pkg.pm 1 Aug 2007 22:24:36 -0000 1.80
@@ -7,6 +7,7 @@
use FS::UID qw( getotaker dbh );
use FS::Misc qw( send_email );
use FS::Record qw( qsearch qsearchs );
+use FS::m2m_Common;
use FS::cust_main_Mixin;
use FS::cust_svc;
use FS::part_pkg;
@@ -14,6 +15,7 @@
use FS::type_pkgs;
use FS::pkg_svc;
use FS::cust_bill_pkg;
+use FS::cust_event;
use FS::h_cust_svc;
use FS::reg_code;
use FS::part_svc;
@@ -31,7 +33,7 @@
# for sending cancel emails in sub cancel
use FS::Conf;
- at ISA = qw( FS::cust_main_Mixin FS::option_Common FS::Record );
+ at ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
$DEBUG = 0;
@@ -157,6 +159,12 @@
will be used to look up the package definition and agent restrictions will be
ignored.
+If the additional field I<refnum> is defined, an FS::pkg_referral record will
+be created and inserted. Multiple FS::pkg_referral records can be created by
+setting I<refnum> to an array reference of refnums or a hash reference with
+refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
+record will be created corresponding to cust_main.refnum.
+
The following options are available: I<change>
I<change>, if set true, supresses any referral credit to a referring customer.
@@ -183,6 +191,13 @@
return $error;
}
+ $self->refnum($self->cust_main->refnum) unless $self->refnum;
+ $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
+ $self->process_m2m( 'link_table' => 'pkg_referral',
+ 'target_table' => 'part_referral',
+ 'params' => $self->refnum,
+ );
+
#if ( $self->reg_code ) {
# my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
# $error = $reg_code->delete;
@@ -315,7 +330,7 @@
foreach my $method ( qw(adjourn expire) ) { # How many reasons?
if ($options{'reason'} && $new->$method && $old->$method ne $new->$method) {
my $error = $new->insert_reason( 'reason' => $options{'reason'},
- 'date' => $new->$method,
+ 'date' => $new->$method,
);
if ( $error ) {
dbh->rollback if $oldAutoCommit;
@@ -441,9 +456,17 @@
in this package, then cancels the package itself (sets the cancel field to
now).
-Available options are: I<quiet>
+Available options are:
-I<quiet> can be set true to supress email cancellation notices.
+=over 4
+
+=item quiet - can be set true to supress email cancellation notices.
+
+=item time - can be set to cancel the package based on a specific future or historical date. Using time ensures that the remaining amount is calculated correctly. Note however that this is an immediate cancel and just changes the date. You are PROBABLY looking to expire the account instead of using this.
+
+=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+
+=back
If there is an error, returns the error, otherwise returns false.
@@ -451,7 +474,10 @@
sub cancel {
my( $self, %options ) = @_;
- my $error;
+
+ warn "cust_pkg::cancel called with options".
+ join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
@@ -463,8 +489,12 @@
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+
+ my $cancel_time = $options{'time'} || time;
- if ($options{'reason'}) {
+ my $error;
+
+ if ( $options{'reason'} ) {
$error = $self->insert_reason( 'reason' => $options{'reason'} );
if ( $error ) {
dbh->rollback if $oldAutoCommit;
@@ -489,23 +519,22 @@
}
}
- # Add a credit for remaining service
- my $remaining_value = $self->calc_remain();
- if ( $remaining_value > 0 ) {
- my $error = $self->cust_main->credit(
- $remaining_value,
- 'Credit for unused time on '. $self->part_pkg->pkg,
- );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return "Error crediting customer \$$remaining_value for unused time on".
- $self->part_pkg->pkg. ": $error";
- }
- }
-
unless ( $self->getfield('cancel') ) {
+ # Add a credit for remaining service
+ my $remaining_value = $self->calc_remain(time=>$cancel_time);
+ if ( $remaining_value > 0 && !$options{'no_credit'} ) {
+ my $error = $self->cust_main->credit(
+ $remaining_value,
+ 'Credit for unused time on '. $self->part_pkg->pkg,
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error crediting customer \$$remaining_value for unused time on".
+ $self->part_pkg->pkg. ": $error";
+ }
+ }
my %hash = $self->hash;
- $hash{'cancel'} = time;
+ $hash{'cancel'} = $cancel_time;
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
@@ -533,18 +562,43 @@
}
-=item suspend
+=item cancel_if_expired [ NOW_TIMESTAMP ]
+
+Cancels this package if its expire date has been reached.
+
+=cut
+
+sub cancel_if_expired {
+ my $self = shift;
+ my $time = shift || time;
+ return '' unless $self->expire && $self->expire <= $time;
+ my $error = $self->cancel;
+ if ( $error ) {
+ return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
+ $self->custnum. ": $error";
+ }
+ '';
+}
+
+=item suspend [ OPTION => VALUE ... ]
Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
package, then suspends the package itself (sets the susp field to now).
+Available options are:
+
+=over 4
+
+=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+
+=back
+
If there is an error, returns the error, otherwise returns false.
=cut
sub suspend {
my( $self, %options ) = @_;
- my $error ;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
@@ -557,7 +611,9 @@
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- if ($options{'reason'}) {
+ my $error;
+
+ if ( $options{'reason'} ) {
$error = $self->insert_reason( 'reason' => $options{'reason'} );
if ( $error ) {
dbh->rollback if $oldAutoCommit;
@@ -796,6 +852,40 @@
qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
}
+=item cust_event
+
+Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub cust_event {
+ my $self = shift;
+ qsearch({
+ 'table' => 'cust_event',
+ 'addl_from' => 'JOIN part_event USING ( eventpart )',
+ 'hashref' => { 'tablenum' => $self->pkgnum },
+ 'extra_sql' => " AND eventtable = 'cust_pkg' ",
+ });
+}
+
+=item num_cust_event
+
+Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub num_cust_event {
+ my $self = shift;
+ my $sql =
+ "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
+ " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+ my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
+ $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
+ $sth->fetchrow_arrayref->[0];
+}
+
=item cust_svc [ SVCPART ]
Returns the services for this package, as FS::cust_svc objects (see
@@ -1023,7 +1113,7 @@
=item statuses
-Class method that returns the list of possible status strings for pacakges
+Class method that returns the list of possible status strings for packages
(see L<the status method|/status>). For example:
@statuses = FS::cust_pkg->statuses();
@@ -1449,7 +1539,7 @@
=over 4
-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
+=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
CUSTNUM is a customer (see L<FS::cust_main>)
@@ -1466,10 +1556,16 @@
RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
newly-created cust_pkg objects.
+REFNUM, if specified, will specify the FS::pkg_referral record to be created
+and inserted. Multiple FS::pkg_referral records can be created by
+setting I<refnum> to an array reference of refnums or a hash reference with
+refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
+record will be created corresponding to cust_main.refnum.
+
=cut
sub order {
- my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
+ my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
my $conf = new FS::Conf;
@@ -1504,6 +1600,7 @@
foreach my $pkgpart (@$pkgparts) {
my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
pkgpart => $pkgpart,
+ refnum => $refnum,
%hash,
};
$error = $cust_pkg->insert( 'change' => $change );
@@ -1557,11 +1654,54 @@
'';
}
+=item insert_reason
+
+Associates this package with a (suspension or cancellation) reason (see
+L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
+L<FS::reason>).
+
+Available options are:
+
+=over 4
+
+=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
+
+=item date
+
+=back
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
sub insert_reason {
my ($self, %options) = @_;
my $otaker = $FS::CurrentUser::CurrentUser->username;
+ my $reasonnum;
+ if ( $options{'reason'} =~ /^(\d+)$/ ) {
+
+ $reasonnum = $1;
+
+ } elsif ( ref($options{'reason'}) ) {
+
+ return 'Enter a new reason (or select an existing one)'
+ unless $options{'reason'}->{'reason'} !~ /^\s*$/;
+
+ my $reason = new FS::reason({
+ 'reason_type' => $options{'reason'}->{'typenum'},
+ 'reason' => $options{'reason'}->{'reason'},
+ });
+ my $error = $reason->insert;
+ return $error if $error;
+
+ $reasonnum = $reason->reasonnum;
+
+ } else {
+ return "Unparsable reason: ". $options{'reason'};
+ }
+
my $cust_pkg_reason =
new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
'reasonnum' => $options{'reason'},
@@ -1570,7 +1710,8 @@
? $options{'date'}
: time,
});
- return $cust_pkg_reason->insert;
+
+ $cust_pkg_reason->insert;
}
=item set_usage USAGE_VALUE_HASHREF
Index: pay_batch.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/pay_batch.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- pay_batch.pm 26 Apr 2007 01:50:00 -0000 1.11
+++ pay_batch.pm 1 Aug 2007 22:24:37 -0000 1.12
@@ -6,7 +6,6 @@
use Text::CSV_XS;
use FS::Record qw( dbh qsearch qsearchs );
use FS::cust_pay;
-use FS::part_bill_event qw(due_events);
@ISA = qw(FS::Record);
@@ -454,6 +453,20 @@
$new_cust_pay_batch->status('Approved');
+ } elsif ( &{$declined_condition}(\%hash) ) {
+
+ $new_cust_pay_batch->status('Declined');
+
+ }
+
+ my $error = $new_cust_pay_batch->replace($cust_pay_batch);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error updating status of paybatchnum $hash{'paybatchnum'}: $error\n";
+ }
+
+ if ( $new_cust_pay_batch->status =~ /Approved/i ) {
+
my $cust_pay = new FS::cust_pay ( {
'custnum' => $custnum,
'payby' => $payby,
@@ -469,33 +482,38 @@
$cust_pay->cust_main->apply_payments;
- } elsif ( &{$declined_condition}(\%hash) ) {
+ } elsif ( $new_cust_pay_batch->status =~ /Declined/i ) {
- $new_cust_pay_batch->status('Declined');
+ #false laziness w/cust_main::collect
- foreach my $part_bill_event ( due_events ( $new_cust_pay_batch,
- 'DCLN',
- '',
- '') ) {
+ my $due_cust_event = $new_cust_pay_batch->cust_main->due_cust_event(
+ #'check_freq' => '1d', #?
+ 'eventtable' => 'cust_pay_batch',
+ 'objects' => [ $new_cust_pay_batch ],
+ );
+ unless( ref($due_cust_event) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $due_cust_event;
+ }
- # don't run subsequent events if balance<=0
- last if $cust_pay_batch->cust_main->balance <= 0;
+ foreach my $cust_event ( @$due_cust_event ) {
+
+ #XXX lock event
+
+ #re-eval event conditions (a previous event could have changed things)
+ next unless $cust_event->test_conditions;
- if (my $error = $part_bill_event->do_event($new_cust_pay_batch)) {
+ if ( my $error = $cust_event->do_event() ) {
# gah, even with transactions.
- $dbh->commit if $oldAutoCommit; #well.
- return $error;
+ #$dbh->commit if $oldAutoCommit; #well.
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
}
}
}
- my $error = $new_cust_pay_batch->replace($cust_pay_batch);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error updating status of paybatchnum $hash{'paybatchnum'}: $error\n";
- }
}
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.293
retrieving revision 1.294
diff -u -d -r1.293 -r1.294
--- cust_main.pm 13 Jul 2007 23:52:20 -0000 1.293
+++ cust_main.pm 1 Aug 2007 22:24:36 -0000 1.294
@@ -1,5 +1,6 @@
package FS::cust_main;
+require 5.006;
use strict;
use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields
$import $skip_fuzzyfiles $ignore_expired_card @paytypes);
@@ -7,13 +8,9 @@
use Safe;
use Carp;
use Exporter;
-BEGIN {
[...1002 lines suppressed...]
+ unless ( $part_event_option ) {
+ return $self->agent->invoice_template || ''
+ if $option eq '$agent_templatename';
return '';
}
+ $part_event_option->optionvalue;
+
}
=back
@@ -5279,6 +5773,8 @@
The payby for card/check batches is broken. With mixed batching, bad
things will happen.
+B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -d -r1.60 -r1.61
--- Schema.pm 26 Jul 2007 11:13:15 -0000 1.60
+++ Schema.pm 1 Aug 2007 22:24:36 -0000 1.61
@@ -265,15 +265,17 @@
'agent' => {
'columns' => [
- 'agentnum', 'serial', '', '', '', '',
- 'agent', 'varchar', '', $char_d, '', '',
- 'typenum', 'int', '', '', '', '',
- 'freq', 'int', 'NULL', '', '', '',
- 'prog', @perl_type, '', '',
- 'disabled', 'char', 'NULL', 1, '', '',
- 'username', 'varchar', 'NULL', $char_d, '', '',
- '_password','varchar', 'NULL', $char_d, '', '',
- 'ticketing_queueid', 'int', 'NULL', '', '', '',
+ 'agentnum', 'serial', '', '', '', '',
+ 'agent', 'varchar', '', $char_d, '', '',
+ 'typenum', 'int', '', '', '', '',
+ 'disabled', 'char', 'NULL', 1, '', '',
+ 'ticketing_queueid', 'int', 'NULL', '', '', '',
+ 'invoice_template', 'varchar', 'NULL', $char_d, '', '',
+ 'username', 'varchar', 'NULL', $char_d, '', '', #deprecated
+ '_password', 'varchar', 'NULL', $char_d, '', '', #deprecated
+ 'freq', 'int', 'NULL', '', '', '', #deprecated (never used)
+ 'prog', @perl_type, '', '', #deprecated (never used)
+
],
'primary_key' => 'agentnum',
'unique' => [],
@@ -349,6 +351,84 @@
'index' => [ ['payby'], ['disabled'], ],
},
+ 'part_event' => {
+ 'columns' => [
+ 'eventpart', 'serial', '', '', '', '',
+ 'agentnum', 'int', 'NULL', '', '', '',
+ 'event', 'varchar', '', $char_d, '', '',
+ 'eventtable', 'varchar', '', $char_d, '', '',
+ 'check_freq', 'varchar', 'NULL', $char_d, '', '',
+ 'weight', 'int', '', '', '', '',
+ 'action', 'varchar', '', $char_d, '', '',
+ 'disabled', 'char', 'NULL', 1, '', '',
+ ],
+ 'primary_key' => 'eventpart',
+ 'unique' => [],
+ 'index' => [ ['agentnum'], ['eventtable'], ['check_freq'], ['disabled'], ],
+ },
+
+ 'part_event_option' => {
+ 'columns' => [
+ 'optionnum', 'serial', '', '', '', '',
+ 'eventpart', 'int', '', '', '', '',
+ 'optionname', 'varchar', '', $char_d, '', '',
+ 'optionvalue', 'text', 'NULL', '', '', '',
+ ],
+ 'primary_key' => 'optionnum',
+ 'unique' => [],
+ 'index' => [ [ 'eventpart' ], [ 'optionname' ] ],
+ },
+
+ 'part_event_condition' => {
+ 'columns' => [
+ 'eventconditionnum', 'serial', '', '', '', '',
+ 'eventpart', 'int', '', '', '', '',
+ 'conditionname', 'varchar', '', $char_d, '', '',
+ ],
+ 'primary_key' => 'eventconditionnum',
+ 'unique' => [],
+ 'index' => [ [ 'eventpart' ], [ 'conditionname' ] ],
+ },
+
+ 'part_event_condition_option' => {
+ 'columns' => [
+ 'optionnum', 'serial', '', '', '', '',
+ 'eventconditionnum', 'int', '', '', '', '',
+ 'optionname', 'varchar', '', $char_d, '', '',
+ 'optionvalue', 'text', 'NULL', '', '', '',
+ ],
+ 'primary_key' => 'optionnum',
+ 'unique' => [],
+ 'index' => [ [ 'eventconditionnum' ], [ 'optionname' ] ],
+ },
+
+ 'part_event_condition_option_option' => {
+ 'columns' => [
+ 'optionoptionnum', 'serial', '', '', '', '',
+ 'optionnum', 'int', '', '', '', '',
+ 'optionname', 'varchar', '', $char_d, '', '',
+ 'optionvalue', 'text', 'NULL', '', '', '',
+ ],
+ 'primary_key' => 'optionoptionnum',
+ 'unique' => [],
+ 'index' => [ [ 'optionnum' ], [ 'optionname' ] ],
+ },
+
+ 'cust_event' => {
+ 'columns' => [
+ 'eventnum', 'serial', '', '', '', '',
+ 'eventpart', 'int', '', '', '', '',
+ 'tablenum', 'int', '', '', '', '',
+ '_date', @date_type, '', '',
+ 'status', 'varchar', '', $char_d, '', '',
+ 'statustext', 'text', 'NULL', '', '', '',
+ ],
+ 'primary_key' => 'eventnum',
+ #no... there are retries now #'unique' => [ [ 'eventpart', 'invnum' ] ],
+ 'unique' => [],
+ 'index' => [ ['eventpart'], ['tablenum'], ['status'] ],
+ },
+
'cust_bill_pkg' => {
'columns' => [
'billpkgnum', 'serial', '', '', '', '',
@@ -681,7 +761,10 @@
],
'primary_key' => 'pkgnum',
'unique' => [],
- 'index' => [ ['custnum'], ['pkgpart'] ],
+ 'index' => [ ['custnum'], ['pkgpart'],
+ ['setup'], ['last_bill'], ['bill'], ['susp'], ['adjourn'],
+ ['expire'], ['cancel']
+ ],
},
'cust_pkg_option' => {
@@ -1731,6 +1814,16 @@
'index' => [],
},
+ 'pkg_referral' => {
+ 'columns' => [
+ 'pkgrefnum', 'serial', '', '', '', '',
+ 'pkgnum', 'int', '', '', '', '',
+ 'refnum', 'int', '', '', '', '',
+ ],
+ 'primary_key' => 'pkgrefnum',
+ 'unique' => [ [ 'pkgnum', 'refnum' ] ],
+ 'index' => [ [ 'pkgnum' ], [ 'refnum' ] ],
+ },
# name type nullability length default local
#'new_table' => {
Index: cust_pay_batch.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pay_batch.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- cust_pay_batch.pm 5 Feb 2007 17:21:09 -0000 1.23
+++ cust_pay_batch.pm 1 Aug 2007 22:24:36 -0000 1.24
@@ -2,11 +2,14 @@
use strict;
use vars qw( @ISA $DEBUG );
+use Carp qw( confess );
+use Business::CreditCard 0.28;
use FS::Record qw(dbh qsearch qsearchs);
use FS::payinfo_Mixin;
-use Business::CreditCard 0.28;
+use FS::cust_main;
+use FS::cust_bill;
- at ISA = qw( FS::Record FS::payinfo_Mixin );
+ at ISA = qw( FS::payinfo_Mixin FS::Record );
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
@@ -32,7 +35,7 @@
$error = $record->check;
- $error = $record->retriable;
+ #deprecated# $error = $record->retriable;
=head1 DESCRIPTION
@@ -201,19 +204,27 @@
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
-=item retriable
-
-Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
-credit card payment as retriable. Useful if the corresponding financial
-institution account was declined for temporary reasons and/or a manual
-retry is desired.
+#you know what, screw this in the new world of events. we should be able to
+#get the event defs to retry (remove once.pm condition, add every.pm) without
+#mucking about with statuses of previous cust_event records. right?
+#
+#=item retriable
+#
+#Marks the corresponding event (see L<FS::cust_bill_event>) for this batched
+#credit card payment as retriable. Useful if the corresponding financial
+#institution account was declined for temporary reasons and/or a manual
+#retry is desired.
+#
+#Implementation details: For the named customer's invoice, changes the
+#statustext of the 'done' (without statustext) event to 'retriable.'
+#
+#=cut
-Implementation details: For the named customer's invoice, changes the
-statustext of the 'done' (without statustext) event to 'retriable.'
+sub retriable {
-=cut
+ confess "deprecated method cust_pay_batch->retriable called; try removing ".
+ "the once condition and adding an every condition?";
-sub retriable {
my $self = shift;
local $SIG{HUP} = 'IGNORE'; #Hmm
Index: AccessRight.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/AccessRight.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- AccessRight.pm 18 Jul 2007 03:24:25 -0000 1.21
+++ AccessRight.pm 1 Aug 2007 22:24:35 -0000 1.22
@@ -12,6 +12,14 @@
use FS::AccessRight;
+ my @rights = FS::AccessRight->rights;
+
+ #my %rights = FS::AccessRight->rights_categorized;
+ tie my %rights, 'Tie::IxHash', FS::AccessRight->rights_categorized;
+ foreach my $category ( keys %rights ) {
+ my @category_rights = @{ $rights{$category} };
+ }
+
=head1 DESCRIPTION
Access control rights - Permission to perform specific actions that can be
@@ -75,131 +83,202 @@
#
##turn it into a more hash-like structure, but ordered via IxHash
-#well, this is what we have for now. could be ordered better, could be lots of
-# things better, but this ACL system does 99% of what folks need and the UI
-# isn't *that* bad
-#
-# okay, well it *really* needs some catgorization in the UI. badly.
- at rights = (
+#well, this is what we have for now. getting better.
+tie my %rights, 'Tie::IxHash',
+
+ ###
+ # basic customer rights
+ ###
+ 'Customer rights' => [
+ 'New customer',
+ 'View customer',
+ #'View Customer | View tickets',
+ 'Edit customer',
+ 'Cancel customer',
+ 'Complimentary customer', #aka users-allow_comp
+ { rightname=>'Delete customer', desc=>"Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customer's packages if they cancel service." }, #aka. deletecustomers
+ 'Add customer note', #NEW
+ 'Edit customer note', #NEW
+ ],
+
+ ###
+ # customer package rights
+ ###
+ 'Customer package rights' => [
+ 'View customer packages', #NEW
+ 'Order customer package',
+ 'One-time charge',
+ 'Change customer package',
+ 'Bulk change customer packages',
+ 'Edit customer package dates',
+ 'Customize customer package',
+ 'Suspend customer package',
+ 'Suspend customer package later',
+ 'Unsuspend customer package',
+ 'Cancel customer package immediately',
+ 'Cancel customer package later',
+ 'Add on-the-fly cancel reason', #NEW
+ 'Add on-the-fly suspend reason', #NEW
+ ],
+
+ ###
+ # customer service rights
+ ###
+ 'Customer service rights' => [
+ 'Edit usage', #NEW
+ 'Edit home dir', #NEW
+ 'Edit www config', #NEW
+ 'View customer services', #NEW
+ 'Provision customer service',
+ 'Recharge customer service', #NEW
+ 'Unprovision customer service',
+
+ { rightname=>'View/link unlinked services', global=>1 }, #not agent-virtualizable without more work
+ ],
+
+ ###
+ # customer invoice/financial info rights
+ ###
+ 'Customer invoice / financial info rights' => [
+ 'View invoices',
+ 'View customer tax exemptions', #yow
+ 'View customer batched payments', #NEW
+ 'View customer billing events', #NEW
+ ],
+
+ ###
+ # customer payment rights
+ ###
+ 'Customer payment rights' => [
+ 'Post payment',
+ 'Post payment batch',
+ { rightname=>'Unapply payment', desc=>'Enable "unapplication" of unclosed payments from specific invoices.' }, #aka. unapplypayments
+ 'Process payment',
+ 'Refund payment',
+
+ { rightname=>'Delete payment', desc=>'Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments.' }, #aka. deletepayments Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.
+
+ ],
+
+ ###
+ # customer credit rights
+ ###
+ 'Customer credit and refund rights' => [
+ 'Post credit',
+ #'Apply credit',
+ { rightname=>'Unapply credit', desc=>'Enable "unapplication" of unclosed credits.' }, #aka unapplycredits
+ { rightname=>'Delete credit', desc=>'Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments.' }, #aka. deletecredits Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.
+ 'Delete refund', #NEW
+ ],
+
+ ###
+ # customer voiding rights..
+ ###
+ 'Customer void rights' => [
+ { rightname=>'Credit card void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. cc-void
+ { rightname=>'Echeck void', desc=>'Enable local-only voiding of echeck payments in addition to refunds against the payment gateway.' }, #aka. echeck-void
+ 'Regular void',
+ { rightname=>'Unvoid', desc=>'Enable unvoiding of voided payments' }, #aka. unvoid
+
+
+ ],
+
+ ###
+ # report/listing rights...
+ ###
+ 'Reprting/listing rights' => [
+ 'List customers',
+ 'List zip codes', #NEW
+ 'List invoices',
+ 'List packages',
+ 'List services',
+
+ { rightname=> 'List rating data', desc=>'Usage reports', global=>1 },
+ 'Billing event reports',
+ 'Financial reports',
+ ],
+
+ ###
+ # misc rights
+ ###
+ 'Miscellaneous rights' => [
+ { rightname=>'Job queue', global=>1 },
+ { rightname=>'Process batches', global=>1 },
+ { rightname=>'Reprocess batches', global=>1 },
+ { rightname=>'Import', global=>1 }, #some of these are ag-virt'ed now? give em their own ACLs
+ { rightname=>'Export', global=>1 },
+ #],
+ #
+ ###
+ # misc misc rights
+ ###
+ #'Database access rights' => [
+ { rightname=>'Raw SQL', global=>1 }, #NEW
+ ],
+
+ ###
+ # setup/config rights
+ ###
+ 'Configuration rights' => [
+ 'Edit advertising sources',
+ { rightname=>'Edit global advertising sources', global=>1 },
+
+ 'Edit billing events',
+ { rightname=>'Edit global billing events', global=>1 },
+
+ { rightname=>'Configuration', global=>1 }, #most of the rest of the configuraiton is not agent-virtualized
+ ],
+
+;
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item rights
-##
-# basic customer rights
-##
- 'New customer',
- 'View customer',
- #'View Customer | View tickets',
- 'Edit customer',
- 'Cancel customer',
- 'Complimentary customer', #aka users-allow_comp
- 'Delete customer', #aka. deletecustomers #Enable customer deletions. Be very careful! Deleting a customer will remove all traces that this customer ever existed! It should probably only be used when auditing a legacy database. Normally, you cancel all of a customers' packages if they cancel service.
- 'Add customer note', #NEW
- 'Edit customer note', #NEW
+Returns a list of right names.
-###
-# customer package rights
-###
- 'View customer packages', #NEW
- 'Order customer package',
- 'One-time charge',
- 'Change customer package',
- 'Bulk change customer packages',
- 'Edit customer package dates',
- 'Customize customer package',
- 'Suspend customer package',
- 'Suspend customer package later',
- 'Unsuspend customer package',
- 'Cancel customer package immediately',
- 'Cancel customer package later',
- 'Add on-the-fly cancel reason', #NEW
- 'Add on-the-fly suspend reason', #NEW
+=cut
+
+ sub rights {
+ #my $class = shift;
+ map { ref($_) ? $_->{'rightname'} : $_ } map @{ $rights{$_} }, keys %rights;
+ }
+
+=item rights_info
-###
-# customer service rights
-###
- 'Edit usage', #NEW
- 'Edit home dir', #NEW
- 'Edit www config', #NEW
- 'View customer services', #NEW
- 'Provision customer service',
- 'Recharge customer service', #NEW
- 'Unprovision customer service',
+Returns a list of key-value pairs suitable for assigning to a hash. Keys are
+category names and values are list references of rights. Each element of the
+list reference scalar right name or a hashref with the following keys:
- 'View/link unlinked services', #not agent-virtualizable without more work
+=over 4
-###
-# customer invoice/financial info rights
-###
- 'View invoices',
- 'View customer tax exemptions', #yow
- 'View customer batched payments', #NEW
+=item rightname - Right name
-###
-# customer payment rights
-###
- 'Post payment',
- 'Post payment batch',
- 'Unapply payment', #aka. unapplypayments Enable "unapplication" of unclosed payments.
- 'Process payment',
- 'Refund payment',
+=item desc - Extended right description
- 'Delete payment', #aka. deletepayments - Enable deletion of unclosed payments. Be very careful! Only delete payments that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a payment is deleted.
+=item global - Global flag, indicates that this access right provides access to global data which is shared among all agents.
- 'Delete refund', #NEW
+=back
-###
-# customer credit rights
-###
- 'Post credit',
- #'Apply credit',
- 'Unapply credit', #aka unapplycredits Enable "unapplication" of unclosed credits.
- 'Delete credit', #aka. deletecredits Enable deletion of unclosed credits. Be very careful! Only delete credits that were data-entry errors, not adjustments. Optionally specify one or more comma-separated email addresses to be notified when a credit is deleted.
+=cut
-###
-# customer voiding rights..
-###
- 'Credit card void', #aka. cc-void #Enable local-only voiding of echeck payments in addition to refunds against the payment gateway
- 'Echeck void', #aka. echeck-void #Enable local-only voiding of echeck payments in addition to refunds against the payment gateway
- 'Regular void',
- 'Unvoid', #aka. unvoid #Enable unvoiding of voided payments
+sub rights_info {
+ %rights;
+}
-###
-# report/listing rights...
-###
- 'List customers',
- 'List zip codes', #NEW
- 'List invoices',
- 'List packages',
- 'List services',
+=back
- 'List rating data', # 'Usage reports',
- 'Billing event reports',
- 'Financial reports',
+=head1 BUGS
-###
-# misc rights
-###
- 'Job queue', # these are not currently agent-virtualized
- 'Process batches', # NEW
- 'Reprocess batches', # NEW
- 'Import', #
- 'Export', #
+Damn those infernal six-legged creatures!
-###
-# misc misc rights
-###
- 'Raw SQL', #NEW
+=head1 SEE ALSO
-###
-# setup/config rights
-###
- 'Edit advertising sources',
- 'Edit global advertising sources',
+L<FS::access_right>, L<FS::access_group>, L<FS::access_user>
- 'Configuration', #most of the rest of the configuraiton is not
- # agent-virtualized
-);
+=cut
-sub rights {
- @rights;
-}
+1;
Index: svc_forward.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_forward.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- svc_forward.pm 29 Dec 2006 08:51:32 -0000 1.20
+++ svc_forward.pm 1 Aug 2007 22:24:37 -0000 1.21
@@ -195,7 +195,7 @@
local $FS::UID::Autocommit = 0;
my $dbh = dbh;
- my $error = $self->SUPER::delete;
+ my $error = $self->SUPER::delete(@_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
@@ -235,7 +235,7 @@
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $new->SUPER::replace($old);
+ my $error = $new->SUPER::replace($old, @_);
if ($error) {
$dbh->rollback if $oldAutoCommit;
return $error;
--- NEW FILE: cust_event.pm ---
package FS::cust_event;
use strict;
use vars qw( @ISA $DEBUG );
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;
=head1 NAME
FS::cust_event - Object methods for cust_event records
=head1 SYNOPSIS
use FS::cust_event;
$record = new FS::cust_event \%hash;
$record = new FS::cust_event { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::cust_event object represents an completed event. FS::cust_event
inherits from FS::Record. The following fields are currently supported:
=over 4
=item eventnum - primary key
=item eventpart - event definition (see L<FS::part_event>)
=item tablenum - customer, package or invoice, depending on the value of part_event.eventtable (see L<FS::cust_main>, L<FS::cust_pkg>, and L<FS::cust_bill>)
=item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
L<Time::Local> and L<Date::Parse> for conversion functions.
=item status - event status: B<new>, B<locked>, B<done> or B<failed>. Note: B<done> indicates the event is complete and should not be retried (statustext may still be set to an optional message), while B<failed> indicates the event failed and should be retried.
=item statustext - additional status detail (i.e. error or progress message)
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new completed invoice event. To add the compelted invoice event 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<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'cust_event'; }
sub cust_linked { $_[0]->cust_main_custnum; }
sub cust_unlinked_msg {
my $self = shift;
"WARNING: can't find cust_main.custnum ". $self->custnum;
#' (cust_bill.invnum '. $self->invnum. ')';
}
sub custnum {
my $self = shift;
$self->cust_main_custnum(@_) || $self->SUPER::custnum(@_);
}
=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 completed invoice event. 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('eventnum')
|| $self->ut_foreign_key('eventpart', 'part_event', 'eventpart')
;
return $error if $error;
my $eventtable = $self->part_event->eventtable;
my $dbdef_eventtable = dbdef->table( $eventtable );
$error =
$self->ut_foreign_key( 'tablenum',
$eventtable,
$dbdef_eventtable->primary_key
)
|| $self->ut_number('_date')
|| $self->ut_enum('status', [qw( new locked done failed )])
|| $self->ut_textn('statustext')
;
return $error if $error;
$self->SUPER::check;
}
=item part_event
Returns the event definition (see L<FS::part_event>) for this completed event.
=cut
sub part_event {
my $self = shift;
qsearchs( 'part_event', { 'eventpart' => $self->eventpart } );
}
=item cust_X
Returns the customer, package, invoice or batched payment (see
L<FS::cust_main>, L<FS::cust_pkg>, L<FS::cust_bill> or L<FS::cust_pay_batch>)
for this completed invoice event.
=cut
sub cust_bill {
croak "FS::cust_event::cust_bill called";
}
sub cust_X {
my $self = shift;
my $eventtable = $self->part_event->eventtable;
my $dbdef_table = dbdef->table( $eventtable );
my $primary_key = $dbdef_table->primary_key;
qsearchs( $eventtable, { $primary_key => $self->tablenum } );
}
=item test_conditions [ OPTION => VALUE ... ]
Tests conditions for this event, returns true if all conditions are satisfied,
false otherwise.
=cut
sub test_conditions {
my( $self, %opt ) = @_;
my $part_event = $self->part_event;
my $object = $self->cust_X;
my @conditions = $part_event->part_event_condition;
#no unsatisfied conditions
#! grep ! $_->condition( $object, %opt ), @conditions;
my @unsatisfied = grep ! $_->condition( $object, %opt ), @conditions;
if ( $opt{'stats_hashref'} ) {
foreach my $unsat (@unsatisfied) {
$opt{'stats_hashref'}->{$unsat->conditionname}++;
}
}
! @unsatisfied;
}
=item do_event
Runs the event action.
=cut
sub do_event {
my $self = shift;
my $part_event = $self->part_event;
my $object = $self->cust_X;
my $obj_pkey = $object->primary_key;
my $for = "for ". $object->table. " ". $object->$obj_pkey();
warn "running cust_event ". $self->eventnum.
" (". $part_event->action. ") $for\n"
if $DEBUG;
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $error;
{
local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
$error = eval { $part_event->do_action($object); };
}
my $status = '';
my $statustext = '';
if ( $@ ) {
$status = 'failed';
#$statustext = $@;
$statustext = "Error running ". $part_event->action. " action: $@";
} elsif ( $error ) {
$status = 'done';
$statustext = $error;
} else {
$status = 'done';
}
#replace or add myself
$self->_date(time);
$self->status($status);
$self->statustext($statustext);
$error = $self->eventnum ? $self->replace : $self->insert;
if ( $error ) {
#this is why we need that locked state...
my $e = 'WARNING: Event run but database not updated - '.
'error replacing or inserting cust_event '. $self->eventnum.
" $for: $error\n";
warn $e;
return $e;
}
'';
}
=item retry
Changes the status of this event from B<done> to B<failed>, allowing it to be
retried.
=cut
sub retry {
my $self = shift;
return '' unless $self->status eq 'done';
my $old = ref($self)->new( { $self->hash } );
$self->status('failed');
$self->replace($old);
}
#=item retryable
#
#Changes the statustext of this event to B<retriable>, rendering it
#retriable (should retry be called).
#
#=cut
sub retriable {
confess "cust_event->retriable called";
my $self = shift;
return '' unless $self->status eq 'done';
my $old = ref($self)->new( { $self->hash } );
$self->statustext('retriable');
$self->replace($old);
}
=back
=head1 SUBROUTINES
=over 4
=item reprint
=cut
sub process_reprint {
process_re_X('print', @_);
}
=item reemail
=cut
sub process_reemail {
process_re_X('email', @_);
}
=item refax
=cut
sub process_refax {
process_re_X('fax', @_);
}
use Storable qw(thaw);
use Data::Dumper;
use MIME::Base64;
sub process_re_X {
my( $method, $job ) = ( shift, shift );
my $param = thaw(decode_base64(shift));
warn Dumper($param) if $DEBUG;
re_X(
$method,
$param->{'beginning'},
$param->{'ending'},
$param->{'failed'},
$job,
);
}
sub re_X {
my($method, $beginning, $ending, $failed, $job) = @_;
my $from = 'LEFT JOIN part_event USING ( eventpart )';
# yuck! hardcoed *AND* sequential scans!
my $where = " WHERE action LIKE 'cust_bill_send%'".
" AND cust_event._date >= $beginning".
" AND cust_event._date <= $ending";
$where .= " AND statustext != '' AND statustext IS NOT NULL"
if $failed;
my @cust_event = qsearch({
'table' => 'cust_event',
'addl_from' => $from,
'hashref' => {},
'extra_sql' => $where,
});
my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
foreach my $cust_event ( @cust_event ) {
# XXX
$cust_event->cust_bill->$method(
$cust_event->part_event->templatename
|| $cust_event->cust_main->agent_template
);
if ( $job ) { #progressbar foo
$num++;
if ( time - $min_sec > $last ) {
my $error = $job->update_statustext(
int( 100 * $num / scalar(@cust_event) )
);
die $error if $error;
$last = time;
}
}
}
#this doesn't work, but it would be nice
#if ( $job ) { #progressbar foo
# my $error = $job->update_statustext(
# scalar(@cust_event). " invoices re-${method}ed"
# );
# die $error if $error;
#}
}
=back
=head1 SEE ALSO
L<FS::part_event>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
base documentation.
=cut
1;
Index: cust_refund.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_refund.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- cust_refund.pm 8 Jan 2007 17:36:52 -0000 1.29
+++ cust_refund.pm 1 Aug 2007 22:24:36 -0000 1.30
@@ -221,7 +221,8 @@
=cut
sub replace {
- return "Can't (yet?) modify cust_refund records!";
+ my $self = shift;
+ $self->SUPER::replace(@_);
}
=item check
@@ -307,6 +308,36 @@
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item unapplied_sql
+
+Returns an SQL fragment to retreive the unapplied amount.
+
+=cut
+
+sub unapplied_sql {
+ #my $class = shift;
+
+ "refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ";
+
+}
+
+=back
+
=head1 BUGS
Delete and replace methods.
Index: cust_bill.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill.pm,v
retrieving revision 1.174
retrieving revision 1.175
diff -u -d -r1.174 -r1.175
--- cust_bill.pm 13 Jul 2007 23:52:20 -0000 1.174
+++ cust_bill.pm 1 Aug 2007 22:24:36 -0000 1.175
@@ -24,6 +24,7 @@
use FS::pay_batch;
use FS::cust_pay_batch;
use FS::cust_bill_event;
+use FS::cust_event;
use FS::part_pkg;
use FS::cust_bill_pay;
use FS::cust_bill_pay_batch;
@@ -271,8 +272,7 @@
=item cust_bill_event
-Returns the completed invoice events (see L<FS::cust_bill_event>) for this
-invoice.
+Returns the completed invoice events (deprecated, old-style events - see L<FS::cust_bill_event>) for this invoice.
=cut
@@ -281,6 +281,54 @@
qsearch( 'cust_bill_event', { 'invnum' => $self->invnum } );
}
+=item num_cust_bill_event
+
+Returns the number of completed invoice events (deprecated, old-style events - see L<FS::cust_bill_event>) for this invoice.
+
+=cut
+
+sub num_cust_bill_event {
+ my $self = shift;
+ my $sql =
+ "SELECT COUNT(*) FROM cust_bill_event WHERE invnum = ?";
+ my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
+ $sth->execute($self->invnum) or die $sth->errstr. " executing $sql";
+ $sth->fetchrow_arrayref->[0];
+}
+
+=item cust_event
+
+Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_pkg.pm
+sub cust_event {
+ my $self = shift;
+ qsearch({
+ 'table' => 'cust_event',
+ 'addl_from' => 'JOIN part_event USING ( eventpart )',
+ 'hashref' => { 'tablenum' => $self->invnum },
+ 'extra_sql' => " AND eventtable = 'cust_bill' ",
+ });
+}
+
+=item num_cust_event
+
+Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_pkg.pm
+sub num_cust_event {
+ my $self = shift;
+ my $sql =
+ "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
+ " WHERE tablenum = ? AND eventtable = 'cust_bill'";
+ my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
+ $sth->execute($self->invnum) or die $sth->errstr. " executing $sql";
+ $sth->fetchrow_arrayref->[0];
+}
=item cust_main
@@ -2577,6 +2625,8 @@
=back
+
+
=head1 SUBROUTINES
=over 4
@@ -2698,6 +2748,34 @@
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item owed_sql
+
+Returns an SQL fragment to retreived the amount owed.
+
+=cut
+
+sub owed_sql {
+ #my $class = shift;
+
+ "charged
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )
+ ,0
+ )
+ ";
+
+}
+
=head1 BUGS
The delete method.
--- NEW FILE: pkg_referral.pm ---
package FS::pkg_referral;
use strict;
use vars qw( @ISA );
use FS::Record qw( qsearch qsearchs );
@ISA = qw(FS::Record);
=head1 NAME
FS::pkg_referral - Object methods for pkg_referral records
=head1 SYNOPSIS
use FS::pkg_referral;
$record = new FS::pkg_referral \%hash;
$record = new FS::pkg_referral { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::pkg_referral object represents the association of an advertising source
with a specific customer package (purchase). FS::pkg_referral inherits from
FS::Record. The following fields are currently supported:
=over 4
=item pkgrefnum - primary key
=item pkgnum - Customer package. See L<FS::cust_pkg>
=item refnum - Advertising source. See L<FS::part_referral>
=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<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'pkg_referral'; }
=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 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('pkgrefnum')
|| $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum' )
|| $self->ut_foreign_key('refnum', 'part_referral', 'refnum' )
;
return $error if $error;
$self->SUPER::check;
}
=back
=head1 BUGS
Multiple pkg_referral records for a single package (configured off by default)
still seems weird.
=head1 SEE ALSO
L<FS::part_referral>, L<FS::cust_pkg>, L<FS::Record>, schema.html from the
base documentation.
=cut
1;
Index: Record.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Record.pm,v
retrieving revision 1.141
retrieving revision 1.142
diff -u -d -r1.141 -r1.142
--- Record.pm 12 Jul 2007 13:36:26 -0000 1.141
+++ Record.pm 1 Aug 2007 22:24:36 -0000 1.142
@@ -213,6 +213,7 @@
#these are optional...
'select' => '*',
'extra_sql' => 'AND field ',
+ 'order_by' => 'ORDER BY something',
#'cache_obj' => '', #optional
'addl_from' => 'LEFT JOIN othtable USING ( field )',
}
@@ -235,13 +236,14 @@
=cut
sub qsearch {
- my($stable, $record, $select, $extra_sql, $cache, $addl_from );
+ my($stable, $record, $select, $extra_sql, $order_by, $cache, $addl_from );
if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too
my $opt = shift;
$stable = $opt->{'table'} or die "table name is required";
$record = $opt->{'hashref'} || {};
$select = $opt->{'select'} || '*';
$extra_sql = $opt->{'extra_sql'} || '';
+ $order_by = $opt->{'order_by'} || '';
$cache = $opt->{'cache_obj'} || '';
$addl_from = $opt->{'addl_from'} || '';
} else {
@@ -362,6 +364,7 @@
}
$statement .= " $extra_sql" if defined($extra_sql);
+ $statement .= " $order_by" if defined($order_by);
warn "[debug]$me $statement\n" if $DEBUG > 1;
my $sth = $dbh->prepare($statement)
@@ -2143,7 +2146,7 @@
$rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
my $conf = new FS::Conf;
- if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
+ if ($conf->exists('encryptionmodule') && $conf->config_binary('encryptionmodule') ne '') {
$rsa_module = $conf->config('encryptionmodule');
}
@@ -2152,13 +2155,13 @@
$rsa_loaded++;
}
# Initialize Encryption
- if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') {
+ if ($conf->exists('encryptionpublickey') && $conf->config_binary('encryptionpublickey') ne '') {
my $public_key = join("\n",$conf->config('encryptionpublickey'));
$rsa_encrypt = $rsa_module->new_public_key($public_key);
}
# Intitalize Decryption
- if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') {
+ if ($conf->exists('encryptionprivatekey') && $conf->config_binary('encryptionprivatekey') ne '') {
my $private_key = join("\n",$conf->config('encryptionprivatekey'));
$rsa_decrypt = $rsa_module->new_private_key($private_key);
}
Index: Conf.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Conf.pm,v
retrieving revision 1.202
retrieving revision 1.203
diff -u -d -r1.202 -r1.203
--- Conf.pm 1 Aug 2007 19:18:56 -0000 1.202
+++ Conf.pm 1 Aug 2007 22:24:36 -0000 1.203
@@ -171,6 +171,30 @@
}
}
+=item invoice_templatenames
+
+Returns all possible invoice template names.
+
+=cut
+
+sub invoice_templatenames {
+ my( $self ) = @_;
+
+ my %templatenames = ();
+ foreach my $item ( $self->config_items ) {
+ foreach my $base ( @base_items ) {
+ my( $main, $ext) = split(/\./, $base);
+ $ext = ".$ext" if $ext;
+ if ( $item->key =~ /^${main}_(.+)$ext$/ ) {
+ $templatenames{$1}++;
+ }
+ }
+ }
+
+ sort keys %templatenames;
+
+}
+
=item touch KEY [ AGENT ];
Creates the specified configuration key if it does not exist.
@@ -498,6 +522,21 @@
logo.eps
);
+ at base_items = qw (
+ invoice_template
+ invoice_latex
+ invoice_latexreturnaddress
+ invoice_latexfooter
+ invoice_latexsmallfooter
+ invoice_latexnotes
+ invoice_html
+ invoice_htmlreturnaddress
+ invoice_htmlfooter
+ invoice_htmlnotes
+ logo.png
+ logo.eps
+ );
+
@config_items = map { new FS::ConfItem $_ } (
{
@@ -1912,6 +1951,25 @@
},
{
+ 'key' => 'disable-fuzzy',
+ 'section' => 'UI',
+ 'description' => 'Disable fuzzy searching. Speeds up searching for large sites, but only shows exact matches.',
+ 'type' => 'checkbox',
+ },
+
+ { 'key' => 'pkg_referral',
+ 'section' => '',
+ 'description' => 'Enable package-specific advertising sources.',
+ 'type' => 'checkbox',
+ },
+
+ { 'key' => 'pkg_referral-multiple',
+ 'section' => '',
+ 'description' => 'In addition, allow multiple advertising sources to be associated with a single package.',
+ 'type' => 'checkbox',
+ },
+
+ {
'key' => 'dashboard-toplist',
'section' => 'UI',
'description' => 'List of items to display on the top of the front page',
Index: option_Common.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/option_Common.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- option_Common.pm 30 Jan 2007 19:45:51 -0000 1.7
+++ option_Common.pm 1 Aug 2007 22:24:36 -0000 1.8
@@ -79,10 +79,13 @@
my $valuecol = $self->_option_valuecol;
foreach my $optionname ( keys %{$options} ) {
+
+ my $optionvalue = $options->{$optionname};
+
my $href = {
$pkey => $self->get($pkey),
$namecol => $optionname,
- $valuecol => $options->{$optionname},
+ $valuecol => ( ref($optionvalue) || $optionvalue ),
};
#my $option_record = eval "new FS::$option_table \$href";
@@ -92,11 +95,15 @@
#}
my $option_record = "FS::$option_table"->new($href);
- $error = $option_record->insert;
+ my @args = ();
+ push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
+
+ $error = $option_record->insert(@args);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+
}
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -154,8 +161,8 @@
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-If a list hash reference of options is supplied, part_export_option records are
-created or modified (see L<FS::part_export_option>).
+If a list hash reference of options is supplied, option records are created or
+modified.
=cut
@@ -208,10 +215,15 @@
$namecol => $optionname,
} );
+ my $optionvalue = $options->{$optionname};
+
+ my %oldhash = $oldopt ? $oldopt->hash : ();
+
my $href = {
+ %oldhash,
$pkey => $self->get($pkey),
$namecol => $optionname,
- $valuecol => $options->{$optionname},
+ $valuecol => ( ref($optionvalue) || $optionvalue ),
};
#my $newopt = eval "new FS::$option_table \$href";
@@ -224,10 +236,15 @@
my $opt_pkey = $newopt->primary_key;
$newopt->$opt_pkey($oldopt->$opt_pkey) if $oldopt;
+
+ my @args = ();
+ push @args, $optionvalue if ref($optionvalue); #only hashes supported so far
+
warn "FS::option_Common::replace: ".
( $oldopt ? "$newopt -> replace($oldopt)" : "$newopt -> insert" )
if $DEBUG > 2;
- my $error = $oldopt ? $newopt->replace($oldopt) : $newopt->insert;
+ my $error = $oldopt ? $newopt->replace($oldopt, @args)
+ : $newopt->insert( @args);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
Index: access_group.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/access_group.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- access_group.pm 18 Jun 2006 12:54:48 -0000 1.2
+++ access_group.pm 1 Aug 2007 22:24:36 -0000 1.3
@@ -140,7 +140,7 @@
=cut
sub access_right {
- my( $self, $name ) = shift;
+ my( $self, $name ) = @_;
qsearchs('access_right', { 'righttype' => 'FS::access_group',
'rightobjnum' => $self->groupnum,
'rightname' => $name,
Index: cust_credit.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_credit.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- cust_credit.pm 1 Mar 2007 05:24:46 -0000 1.25
+++ cust_credit.pm 1 Aug 2007 22:24:36 -0000 1.26
@@ -333,10 +333,43 @@
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item credited_sql
+
+Returns an SQL fragment to retreive the unapplied amount.
+
+=cut
+
+sub credited_sql {
+ #my $class = shift;
+
+ "amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ";
+
+}
+
+=back
+
=head1 BUGS
The delete method. The replace method.
+B<credited> and B<credited_sql> should probably be called B<unapplied> and
+B<unapplied_sql>.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_credit_refund>, L<FS::cust_refund>,
--- NEW FILE: part_event_condition_option_option.pm ---
package FS::part_event_condition_option_option;
use strict;
use vars qw( @ISA );
use FS::Record qw( qsearch qsearchs );
use FS::part_event_condition_option;
@ISA = qw(FS::Record);
=head1 NAME
FS::part_event_condition_option_option - Object methods for part_event_condition_option_option records
=head1 SYNOPSIS
use FS::part_event_condition_option_option;
$record = new FS::part_event_condition_option_option \%hash;
$record = new FS::part_event_condition_option_option { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::part_event_condition_option_option object represents a nested event
condition option. FS::part_event_condition_option_option inherits from
FS::Record. The following fields are currently supported:
=over 4
=item optionoptionnum - primary key
=item optionnum - Parent option (see L<FS::part_event_option>)
=item optionname - Option name
=item optionvalue - Option value
=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<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'part_event_condition_option_option'; }
=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 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('optionoptionnum')
|| $self->ut_foreign_key('optionnum',
'part_event_condition_option', 'optionnum' )
|| $self->ut_text('optionname')
|| $self->ut_textn('optionvalue')
;
return $error if $error;
$self->SUPER::check;
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::part_event_condition_option>, L<FS::Record>, schema.html from the base
documentation.
=cut
1;
--- NEW FILE: part_event_condition.pm ---
package FS::part_event_condition;
use strict;
use vars qw( @ISA $DEBUG );
use FS::UID qw(dbh);
use FS::Record qw( qsearch qsearchs );
use FS::option_Common;
use FS::part_event; #for order_conditions_sql...
@ISA = qw( FS::option_Common ); # FS::Record );
$DEBUG = 0;
=head1 NAME
FS::part_event_condition - Object methods for part_event_condition records
=head1 SYNOPSIS
use FS::part_event_condition;
$record = new FS::part_event_condition \%hash;
$record = new FS::part_event_condition { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::part_event_condition object represents an event condition.
FS::part_event_condition inherits from FS::Record. The following fields are
currently supported:
=over 4
=item eventconditionnum - primary key
=item eventpart - Event definition (see L<FS::part_event>)
=item conditionname - Condition name - defines which FS::part_event::Condition::I<conditionname> evaluates this condition
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new event. To add the example 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<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'part_event_condition'; }
=item insert [ HASHREF | OPTION => VALUE ... ]
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
If a list or hash reference of options is supplied, part_event_condition_option
records are created (see L<FS::part_event_condition_option>).
=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 [ HASHREF | OPTION => VALUE ... ]
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
If a list or hash reference of options is supplied, part_event_condition_option
records are created or modified (see L<FS::part_event_condition_option>).
=cut
# the replace method can be inherited from FS::Record
=item check
Checks all fields to make sure this is a valid example. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
=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('eventconditionnum')
|| $self->ut_foreign_key('eventpart', 'part_event', 'eventpart')
|| $self->ut_alpha('conditionname')
;
return $error if $error;
#XXX check conditionname to make sure a module exists?
# well it'll die in _rebless...
$self->SUPER::check;
}
=item _rebless
Reblesses the object into the FS::part_event::Condition::CONDITIONNAME class,
where CONDITIONNAME is the object's I<conditionname> field.
=cut
sub _rebless {
my $self = shift;
my $conditionname = $self->conditionname;
#my $class = ref($self). "::$conditionname";
my $class = "FS::part_event::Condition::$conditionname";
eval "use $class";
die $@ if $@;
bless($self, $class); #unless $@;
$self;
}
=back
=head1 CLASS METHODS
=over 4
=item conditions [ EVENTTABLE ]
Return information about the available conditions. If an eventtable is
specified, only return information about conditions available for that
eventtable.
Information is returned as key-value pairs. Keys are condition names. Values
are hashrefs with the following keys:
=over 4
=item description
=item option_fields
# =item default_weight
# =item deprecated
=back
See L<FS::part_event::Condition> for more information.
=cut
#false laziness w/part_event.pm
#some false laziness w/part_export & part_pkg
my %conditions;
foreach my $INC ( @INC ) {
foreach my $file ( glob("$INC/FS/part_event/Condition/*.pm") ) {
warn "attempting to load Condition from $file\n" if $DEBUG;
$file =~ /\/(\w+)\.pm$/ or do {
warn "unrecognized file in $INC/FS/part_event/Condition/: $file\n";
next;
};
my $mod = $1;
my $fullmod = "FS::part_event::Condition::$mod";
eval "use $fullmod;";
if ( $@ ) {
die "error using $fullmod (skipping): $@\n" if $@;
#warn "error using $fullmod (skipping): $@\n" if $@;
#next;
}
#my $full_condition_sql = $fullmod. '::condition_sql';
my $condition_sql_coderef = sub { $fullmod->condition_sql(@_) };
my $order_sql_coderef = $fullmod->can('order_sql')
? sub { $fullmod->order_sql(@_) }
: '';
$conditions{$mod} = {
( map { $_ => $fullmod->$_() }
qw( description eventtable_hashref
implicit_flag remove_warning
order_sql_weight
)
# deprecated
#option_fields_hashref
),
'option_fields' => [ $fullmod->option_fields() ],
'condition_sql' => $condition_sql_coderef,
'order_sql' => $order_sql_coderef,
};
}
}
sub conditions {
my( $class, $eventtable ) = @_;
(
map { $_ => $conditions{$_} }
# sort { $conditions{$a}->{'default_weight'}<=>$conditions{$b}->{'default_weight'} }
# sort by ?
$class->all_conditionnames( $eventtable )
);
}
=item all_conditionnames [ EVENTTABLE ]
Returns a list of just the condition names
=cut
sub all_conditionnames {
my ( $class, $eventtable ) = @_;
grep { !$eventtable || $conditions{$_}->{'eventtable_hashref'}{$eventtable} }
keys %conditions
}
=item join_conditions_sql [ EVENTTABLE ]
Returns an SQL fragment selecting joining all condition options for an event as
tables titled "cond_I<conditionname>". Typically used in conjunction with
B<where_conditions_sql>.
=cut
sub join_conditions_sql {
my ( $class, $eventtable ) = @_;
my %conditions = $class->conditions( $eventtable );
join(' ',
map {
"LEFT JOIN part_event_condition AS cond_$_".
" ON ( part_event.eventpart = cond_$_.eventpart".
" AND cond_$_.conditionname = ". dbh->quote($_).
" )";
}
keys %conditions
);
}
=item where_conditions_sql [ EVENTTABLE [ , OPTION => VALUE, ... ] ]
Returns an SQL fragment to select events which have unsatisfied conditions.
Must be used in conjunction with B<join_conditions_sql>.
The only current option is "time", the current time (or "pretend" current time
as passed to freeside-daily), as a UNIX timestamp.
=cut
sub where_conditions_sql {
my ( $class, $eventtable, %options ) = @_;
my $time = $options{'time'};
my %conditions = $class->conditions( $eventtable );
my $where = join(' AND ',
map {
my $conditionname = $_;
my $coderef = $conditions{$conditionname}->{condition_sql};
my $sql = &$coderef( $eventtable, 'time'=>$time );
die "$coderef is not a CODEREF" unless ref($coderef) eq 'CODE';
"( cond_$conditionname.conditionname IS NULL OR $sql )";
}
keys %conditions
);
$where;
}
=item order_conditions_sql [ EVENTTABLE ]
Returns an SQL fragment to order selected events. Must be used in conjunction
with B<join_conditions_sql>.
=cut
sub order_conditions_sql {
my( $class, $eventtable ) = @_;
my %conditions = $class->conditions( $eventtable );
my $eventtables = join(' ', FS::part_event->eventtables_runorder);
my $order_by = join(', ',
"position( part_event.eventtable in ' $eventtables ')",
( map {
my $conditionname = $_;
my $coderef = $conditions{$conditionname}->{order_sql};
my $sql = &$coderef( $eventtable );
"CASE WHEN cond_$conditionname.conditionname IS NULL
THEN -1
ELSE $sql
END
";
}
sort { $conditions{$a}->{order_sql_weight}
<=> $conditions{$b}->{order_sql_weight}
}
grep { $conditions{$_}->{order_sql} }
keys %conditions
),
'part_event.weight'
);
"ORDER BY $order_by";
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::part_event::Condition>, L<FS::part_event>, L<FS::Record>, schema.html from
the base documentation.
=cut
1;
Index: svc_www.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_www.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- svc_www.pm 24 Apr 2007 00:21:44 -0000 1.15
+++ svc_www.pm 1 Aug 2007 22:24:37 -0000 1.16
@@ -176,7 +176,7 @@
my $self = shift;
my $error;
- $error = $self->SUPER::delete;
+ $error = $self->SUPER::delete(@_);
return $error if $error;
'';
@@ -193,7 +193,7 @@
my ( $new, $old ) = ( shift, shift );
my $error;
- $error = $new->SUPER::replace($old);
+ $error = $new->SUPER::replace($old, @_);
return $error if $error;
'';
Index: svc_Common.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_Common.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- svc_Common.pm 12 Apr 2007 02:42:32 -0000 1.41
+++ svc_Common.pm 1 Aug 2007 22:24:37 -0000 1.42
@@ -187,6 +187,9 @@
jobnums), all provisioning jobs will have a dependancy on the supplied
jobnum(s) (they will not run until the specific job(s) complete(s)).
+If I<export_args> is set to an array reference, the referenced list will be
+passed to export commands.
+
=cut
sub insert {
@@ -279,8 +282,10 @@
warn "[$me] insert: \$FS::queue::jobnums is $FS::queue::jobnums\n"
if $DEBUG;
+ my $export_args = $options{'export_args'} || [];
+
foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- my $error = $part_export->export_insert($self);
+ my $error = $part_export->export_insert($self, @$export_args);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "exporting to ". $part_export->exporttype.
@@ -314,7 +319,7 @@
'';
}
-=item delete
+=item delete [ , OPTION => VALUE ... ]
Deletes this account from the database. If there is an error, returns the
error, otherwise returns false.
@@ -325,7 +330,8 @@
sub delete {
my $self = shift;
- my $error;
+ my %options = @_;
+ my $export_args = $options{'export_args'} || [];
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
@@ -338,10 +344,10 @@
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- $error = $self->SUPER::delete
- || $self->export('delete')
- || $self->return_inventory
- || $self->cust_svc->delete
+ my $error = $self->SUPER::delete
+ || $self->export('delete', @$export_args)
+ || $self->return_inventory
+ || $self->cust_svc->delete
;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
@@ -362,6 +368,7 @@
sub replace {
my ($new, $old) = (shift, shift);
+ my %options = @_;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
@@ -392,6 +399,8 @@
#new-style exports!
unless ( $noexport_hack ) {
+ my $export_args = $options{'export_args'} || [];
+
#not quite false laziness, but same pattern as FS::svc_acct::replace and
#FS::part_export::sqlradius::_export_replace. List::Compare or something
#would be useful but too much of a pain in the ass to deploy
@@ -407,7 +416,7 @@
foreach my $delete_part_export (
grep { ! $new_exportnum{$_->exportnum} } @old_part_export
) {
- my $error = $delete_part_export->export_delete($old);
+ my $error = $delete_part_export->export_delete($old, @$export_args);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "error deleting, export to ". $delete_part_export->exporttype.
@@ -418,7 +427,8 @@
foreach my $replace_part_export (
grep { $old_exportnum{$_->exportnum} } @new_part_export
) {
- my $error = $replace_part_export->export_replace($new,$old);
+ my $error =
+ $replace_part_export->export_replace( $new, $old, @$export_args);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "error exporting to ". $replace_part_export->exporttype.
@@ -429,7 +439,7 @@
foreach my $insert_part_export (
grep { ! $old_exportnum{$_->exportnum} } @new_part_export
) {
- my $error = $insert_part_export->export_insert($new);
+ my $error = $insert_part_export->export_insert($new, @$export_args );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "error inserting export to ". $insert_part_export->exporttype.
@@ -443,7 +453,6 @@
'';
}
-
=item setfixed
Sets any fixed fields for this service (see L<FS::part_svc>). If there is an
@@ -681,7 +690,9 @@
sub suspend {
my $self = shift;
- $self->export('suspend');
+ my %options = @_;
+ my $export_args = $options{'export_args'} || [];
+ $self->export('suspend', @$export_args);
}
=item unsuspend
@@ -692,7 +703,9 @@
sub unsuspend {
my $self = shift;
- $self->export('unsuspend');
+ my %options = @_;
+ my $export_args = $options{'export_args'} || [];
+ $self->export('unsuspend', @$export_args);
}
=item export HOOK [ EXPORT_ARGS ]
Index: access_user.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/access_user.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- access_user.pm 26 Jan 2007 08:18:54 -0000 1.15
+++ access_user.pm 1 Aug 2007 22:24:36 -0000 1.16
@@ -308,22 +308,34 @@
sub agentnums_href {
my $self = shift;
- { map { $_ => 1 } $self->agentnums };
+ scalar( { map { $_ => 1 } $self->agentnums } );
}
-=item agentnums_sql
+=item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
Returns an sql fragement to select only agentnums this user can view.
+Options are passed as a hashref or a list. Available options are:
+
+=over 4
+
+=item null - The frament will also allow the selection of null agentnums.
+
+=item null_right - The fragment will also allow the selection of null agentnums if the current user has the provided access right
+
+=back
+
=cut
sub agentnums_sql {
- my $self = shift;
+ my( $self ) = shift;
+ my %opt = ref($_[0]) ? %{$_[0]} : @_;
my @agentnums = map { "agentnum = $_" } $self->agentnums;
push @agentnums, 'agentnum IS NULL'
- if $self->access_right('View/link unlinked services');
+ if $opt{'null'}
+ || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
return ' 1 = 0 ' unless scalar(@agentnums);
'( '. join( ' OR ', @agentnums ). ' )';
More information about the freeside-commits
mailing list