X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_svc.pm;h=96409c36342a35fdbac4f2205aa2751789363937;hb=bc75a214c30ca0ae7554cc60d4f7754f5ea03366;hp=d6d7d4cf15dfd3efd73161c10e93ce7711129d91;hpb=992f784a5f012c7a954f86c62d0977ec947a3170;p=freeside.git diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index d6d7d4cf1..96409c363 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -1,12 +1,13 @@ package FS::cust_svc; +use base qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record ); use strict; -use vars qw( @ISA $DEBUG $me $ignore_quantity $conf $ticket_system ); +use vars qw( $DEBUG $me $ignore_quantity $conf $ticket_system ); use Carp; #use Scalar::Util qw( blessed ); +use List::Util qw( max ); use FS::Conf; -use FS::Record qw( qsearch qsearchs dbh str2time_sql ); -use FS::cust_pkg; +use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing ); use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; @@ -18,7 +19,6 @@ use FS::UI::Web; #most FS::svc_ classes are autoloaded in svc_x emthod use FS::svc_acct; #this one is used in the cache stuff -@ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record ); $DEBUG = 0; $me = '[cust_svc]'; @@ -113,6 +113,10 @@ my $rt_session; sub delete { my $self = shift; + + my $cust_pkg = $self->cust_pkg; + my $custnum = $cust_pkg->custnum if $cust_pkg; + my $error = $self->SUPER::delete; return $error if $error; @@ -126,7 +130,15 @@ sub delete { $links->Limit(FIELD => 'Target', VALUE => 'freeside://freeside/cust_svc/'.$svcnum); while ( my $l = $links->Next ) { - my ($val, $msg) = $l->Delete; + my ($val, $msg); + if ( $custnum ) { + # re-link to point to the customer instead + ($val, $msg) = + $l->SetTarget('freeside://freeside/cust_main/'.$custnum); + } else { + # unlinked service + ($val, $msg) = $l->Delete; + } # can't do anything useful on error warn "error unlinking ticket $svcnum: $msg\n" if !$val; } @@ -310,17 +322,46 @@ sub replace { my $error = $new->svc_x->export('pkg_change', $new->cust_pkg, $old->cust_pkg, ); + if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error; } - } + } # if pkgnum is changing #my $error = $new->SUPER::replace($old, @_); my $error = $new->SUPER::replace($old); + + #trigger a relocate export on location changes + if ( $new->cust_pkg->locationnum != $old->cust_pkg->locationnum ) { + my $svc_x = $new->svc_x; + if ( $svc_x->locationnum ) { + if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) { + # in this case, set the service location to be the same as the new + # package location + $svc_x->set('locationnum', $new->cust_pkg->locationnum); + # and replace it, which triggers a relocate export so we don't + # need to + $error ||= $svc_x->replace; + } else { + # the service already has a different location from its package + # so don't change it + } + } else { + # the service doesn't have a locationnum (either isn't of a type + # that has the locationnum field, or the locationnum is null and + # defaults to cust_pkg->locationnum) + # so just trigger the export here + $error ||= $new->svc_x->export('relocate', + $new->cust_pkg->cust_location, + $old->cust_pkg->cust_location, + ); + } # if ($svc_x->locationnum) + } # if this is a location change + if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error if $error; + return $error if $error } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -352,15 +393,44 @@ sub check { return "Unknown svcpart" unless $part_svc; if ( $self->pkgnum && ! $ignore_quantity ) { - my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - return "Unknown pkgnum" unless $cust_pkg; - ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc; - return "No svcpart ". $self->svcpart. - " services in pkgpart ". $cust_pkg->pkgpart - unless $part_svc || $ignore_quantity; - return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc. + + #slightly inefficient since ->pkg_svc will also look it up, but fixing + # a much larger perf problem and have bigger fish to fry + my $cust_pkg = $self->cust_pkg; + + my $pkg_svc = $self->pkg_svc + || new FS::pkg_svc { 'svcpart' => $self->svcpart, + 'pkgpart' => $cust_pkg->pkgpart, + 'quantity' => 0, + }; + + #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc + foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) { + my $addon_pkg_svc = qsearchs('pkg_svc', { + pkgpart => $part_pkg_link->dst_pkgpart, + svcpart => $self->svcpart, + }); + $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity ) + if $addon_pkg_svc; + } + + #better error message? UI shouldn't get here + return "No svcpart ". $self->svcpart. + " services in pkgpart ". $cust_pkg->pkgpart + unless $pkg_svc->quantity > 0; + + my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart ); + + #false laziness w/cust_pkg->part_svc + my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity + - $num_cust_svc + ); + + #better error message? again, UI shouldn't get here + return "Already $num_cust_svc ". $pkg_svc->part_svc->svc. " services for pkgnum ". $self->pkgnum - if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ; + if $num_avail <= 0; + } $self->SUPER::check; @@ -397,13 +467,6 @@ sub part_svc { Returns the package this service belongs to, as a FS::cust_pkg object (see L). -=cut - -sub cust_pkg { - my $self = shift; - qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); -} - =item pkg_svc Returns the pkg_svc record for for this service, if applicable. @@ -604,6 +667,7 @@ sub seconds_since_sqlradacct { #select a unix time conversion function based on database type my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} ); my $username = $part_export->export_username($svc_x); @@ -623,9 +687,9 @@ sub seconds_since_sqlradacct { FROM radacct WHERE UserName = ? $realm - AND $str2time AcctStartTime) >= ? - AND $str2time AcctStopTime ) < ? - AND $str2time AcctStopTime ) > 0 + AND $str2time AcctStartTime $closing >= ? + AND $str2time AcctStopTime $closing < ? + AND $str2time AcctStopTime $closing > 0 AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; $sth->execute($username, ($realm ? $realmparam : ()), $start, $end) @@ -636,14 +700,14 @@ sub seconds_since_sqlradacct { if $DEBUG; # count session start->range end - $query = "SELECT SUM( ? - $str2time AcctStartTime ) ) + $query = "SELECT SUM( ? - $str2time AcctStartTime $closing ) FROM radacct WHERE UserName = ? $realm - AND $str2time AcctStartTime ) >= ? - AND $str2time AcctStartTime ) < ? - AND ( ? - $str2time AcctStartTime ) ) < 86400 - AND ( $str2time AcctStopTime ) = 0 + AND $str2time AcctStartTime $closing >= ? + AND $str2time AcctStartTime $closing < ? + AND ( ? - $str2time AcctStartTime $closing ) < 86400 + AND ( $str2time AcctStopTime $closing = 0 OR AcctStopTime IS NULL )"; $sth = $dbh->prepare($query) or die $dbh->errstr; $sth->execute( $end, @@ -659,14 +723,14 @@ sub seconds_since_sqlradacct { if $DEBUG; #count range start->session end - $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) + $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? ) FROM radacct WHERE UserName = ? $realm - AND $str2time AcctStartTime ) < ? - AND $str2time AcctStopTime ) >= ? - AND $str2time AcctStopTime ) < ? - AND $str2time AcctStopTime ) > 0 + AND $str2time AcctStartTime $closing < ? + AND $str2time AcctStopTime $closing >= ? + AND $str2time AcctStopTime $closing < ? + AND $str2time AcctStopTime $closing > 0 AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; $sth->execute( $start, @@ -687,8 +751,8 @@ sub seconds_since_sqlradacct { FROM radacct WHERE UserName = ? $realm - AND $str2time AcctStartTime ) < ? - AND ( $str2time AcctStopTime ) >= ? + AND $str2time AcctStartTime $closing < ? + AND ( $str2time AcctStopTime $closing >= ? )" # OR AcctStopTime = 0 # OR AcctStopTime IS NULL )" @@ -749,6 +813,7 @@ sub attribute_since_sqlradacct { #select a unix time conversion function based on database type my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} ); my $username = $part_export->export_username($svc_x); @@ -766,8 +831,8 @@ sub attribute_since_sqlradacct { FROM radacct WHERE UserName = ? $realm - AND $str2time AcctStopTime ) >= ? - AND $str2time AcctStopTime ) < ? + AND $str2time AcctStopTime $closing >= ? + AND $str2time AcctStopTime $closing < ? AND AcctStopTime IS NOT NULL" ) or die $dbh->errstr; $sth->execute($username, ($realm ? $realmparam : ()), $start, $end) @@ -785,6 +850,78 @@ sub attribute_since_sqlradacct { } +#note: implementation here, POD in FS::svc_acct +# false laziness w/above +sub attribute_last_sqlradacct { + my($self, $attrib) = @_; + + my $mes = "$me attribute_last_sqlradacct:"; + + my $svc_x = $self->svc_x; + + my @part_export = $self->part_svc->part_export_usage; + die "no accounting-capable exports are enabled for ". $self->part_svc->svc. + " service definition" + unless @part_export; + #or return undef; + + my $value = ''; + my $AcctStartTime = 0; + + foreach my $part_export ( @part_export ) { + + next if $part_export->option('ignore_accounting'); + + warn "$mes connecting to sqlradius database\n" + if $DEBUG; + + my $dbh = DBI->connect( map { $part_export->option($_) } + qw(datasrc username password) ) + or die "can't connect to sqlradius database: ". $DBI::errstr; + + warn "$mes connected to sqlradius database\n" + if $DEBUG; + + #select a unix time conversion function based on database type + my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} ); + + my $username = $part_export->export_username($svc_x); + + warn "$mes finding most-recent $attrib\n" + if $DEBUG; + + my $realm = ''; + my $realmparam = ''; + if ($part_export->option('process_single_realm')) { + $realm = 'AND Realm = ?'; + $realmparam = $part_export->option('realm'); + } + + my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing + FROM radacct + WHERE UserName = ? + $realm + ORDER BY AcctStartTime DESC LIMIT 1 + ") or die $dbh->errstr; + $sth->execute($username, ($realm ? $realmparam : ()) ) + or die $sth->errstr; + + my $row = $sth->fetchrow_arrayref; + if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) { + $value = $row->[0]; + $AcctStartTime = $row->[1]; + } + + warn "$mes done\n" + if $DEBUG; + + } + + $value; + +} + =item get_session_history TIMESTAMP_START TIMESTAMP_END See L. Equivalent to @@ -860,6 +997,13 @@ sub tickets { (@tickets); } +sub API_getinfo { + my $self = shift; + my $svc_x = $self->svc_x; + +{ ( map { $_=>$self->$_ } $self->fields ), + ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ), + }; +} =back