projects
/
freeside.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
work around bug in pre-perl5.10 which is at best noisy and at worst missorting
[freeside.git]
/
FS
/
FS
/
cust_pkg.pm
diff --git
a/FS/FS/cust_pkg.pm
b/FS/FS/cust_pkg.pm
index
29f699f
..
a95a67d
100644
(file)
--- a/
FS/FS/cust_pkg.pm
+++ b/
FS/FS/cust_pkg.pm
@@
-1,7
+1,7
@@
package FS::cust_pkg;
use strict;
package FS::cust_pkg;
use strict;
-use vars qw(@ISA $disable_agentcheck $DEBUG);
+use vars qw(@ISA $disable_agentcheck $DEBUG
$me
);
use Carp qw(cluck);
use Scalar::Util qw( blessed );
use List::Util qw(max);
use Carp qw(cluck);
use Scalar::Util qw( blessed );
use List::Util qw(max);
@@
-41,6
+41,7
@@
use FS::Conf;
@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
$DEBUG = 0;
@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
$DEBUG = 0;
+$me = '[FS::cust_pkg]';
$disable_agentcheck = 0;
$disable_agentcheck = 0;
@@
-1534,8
+1535,11
@@
sub h_cust_svc {
sub _sort_cust_svc {
my( $self, $arrayref ) = @_;
sub _sort_cust_svc {
my( $self, $arrayref ) = @_;
+ my $sort =
+ sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
+
map { $_->[0] }
map { $_->[0] }
- sort
{ $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
+ sort
$sort
map {
my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
'svcpart' => $_->svcpart } );
map {
my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
'svcpart' => $_->svcpart } );
@@
-1945,16
+1949,16
@@
sub cust_location_or_main {
$self->cust_location || $self->cust_main;
}
$self->cust_location || $self->cust_main;
}
-=item location_label
_short
+=item location_label
[ OPTION => VALUE ... ]
-Returns the
short
label of the location object (see L<FS::cust_location>).
+Returns the label of the location object (see L<FS::cust_location>).
=cut
=cut
-sub location_label
_short
{
+sub location_label {
my $self = shift;
my $object = $self->cust_location_or_main;
my $self = shift;
my $object = $self->cust_location_or_main;
- $object->location_label
_short
;
+ $object->location_label
(@_)
;
}
=item seconds_since TIMESTAMP
}
=item seconds_since TIMESTAMP
@@
-2778,6
+2782,9
@@
sub order {
# my $cust_main = qsearchs('cust_main', { custnum => $custnum });
# return "Customer not found: $custnum" unless $cust_main;
# my $cust_main = qsearchs('cust_main', { custnum => $custnum });
# return "Customer not found: $custnum" unless $cust_main;
+ warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
+ if $DEBUG;
+
my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
@$remove_pkgnum;
my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
@$remove_pkgnum;
@@
-2786,6
+2793,10
@@
sub order {
my %hash = ();
if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
my %hash = ();
if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
+ warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
+ " to pkgpart ". $pkgparts->[0]. "\n"
+ if $DEBUG;
+
my $err_or_cust_pkg =
$old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
'refnum' => $refnum,
my $err_or_cust_pkg =
$old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
'refnum' => $refnum,
@@
-2797,12
+2808,16
@@
sub order {
}
push @$return_cust_pkg, $err_or_cust_pkg;
}
push @$return_cust_pkg, $err_or_cust_pkg;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
return '';
}
# Create the new packages.
foreach my $pkgpart (@$pkgparts) {
return '';
}
# Create the new packages.
foreach my $pkgpart (@$pkgparts) {
+
+ warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
+
my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
pkgpart => $pkgpart,
refnum => $refnum,
my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
pkgpart => $pkgpart,
refnum => $refnum,
@@
-2821,6
+2836,9
@@
sub order {
# Transfer services and cancel old packages.
foreach my $old_pkg (@old_cust_pkg) {
# Transfer services and cancel old packages.
foreach my $old_pkg (@old_cust_pkg) {
+ warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
+ if $DEBUG;
+
foreach my $new_pkg (@$return_cust_pkg) {
$error = $old_pkg->transfer($new_pkg);
if ($error and $error == 0) {
foreach my $new_pkg (@$return_cust_pkg) {
$error = $old_pkg->transfer($new_pkg);
if ($error and $error == 0) {