X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=554cd5e2e9d99c1c365d8d22405942ef409a906d;hb=a7b7036b80d87d690329748a48283ca8b9f87fb9;hp=a244919645d989265110785b8032f9a2517d7af6;hpb=9d658b03441384be42de580d64fefcfb43b16fd2;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index a24491964..554cd5e2e 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -14,16 +14,18 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles $radius_password $radius_ip $dirhash @saltset @pw_set ); +use Scalar::Util qw( blessed ); use Carp; use Fcntl qw(:flock); use Date::Format; use Crypt::PasswdMD5 1.2; use Data::Dumper; use Authen::Passphrase; -use FS::UID qw( datasrc ); +use FS::UID qw( datasrc driver_name ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); use FS::Msgcat qw(gettext); +use FS::UI::bytecount; use FS::svc_Common; use FS::cust_svc; use FS::part_svc; @@ -203,7 +205,7 @@ sub table_info { { 'name' => 'Account', 'longname_plural' => 'Access accounts and mailboxes', - 'sorts' => [ 'username', 'uid', ], + 'sorts' => [ 'username', 'uid', 'seconds', 'last_login' ], 'display_weight' => 10, 'cancel_weight' => 50, 'fields' => { @@ -269,6 +271,7 @@ sub table_info { disable_select => 1, }, 'seconds' => { label => 'Seconds', + label_sort => 'with Time Remaining', type => 'text', disable_inventory => 1, disable_select => 1, @@ -277,48 +280,56 @@ sub table_info { type => 'text', disable_inventory => 1, disable_select => 1, - 'format' => \&FS::UI::Web::display_bytecount, - 'parse' => \&FS::UI::Web::parse_bytecount, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, }, 'downbytes' => { label => 'Download', type => 'text', disable_inventory => 1, disable_select => 1, - 'format' => \&FS::UI::Web::display_bytecount, - 'parse' => \&FS::UI::Web::parse_bytecount, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, }, 'totalbytes'=> { label => 'Total up and download', type => 'text', disable_inventory => 1, disable_select => 1, - 'format' => \&FS::UI::Web::display_bytecount, - 'parse' => \&FS::UI::Web::parse_bytecount, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, }, - 'seconds_threshold' => { label => 'Seconds', + 'seconds_threshold' => { label => 'Seconds threshold', type => 'text', disable_inventory => 1, disable_select => 1, }, - 'upbytes_threshold' => { label => 'Upload', + 'upbytes_threshold' => { label => 'Upload threshold', type => 'text', disable_inventory => 1, disable_select => 1, - 'format' => \&FS::UI::Web::display_bytecount, - 'parse' => \&FS::UI::Web::parse_bytecount, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, }, - 'downbytes_threshold' => { label => 'Download', + 'downbytes_threshold' => { label => 'Download threshold', type => 'text', disable_inventory => 1, disable_select => 1, - 'format' => \&FS::UI::Web::display_bytecount, - 'parse' => \&FS::UI::Web::parse_bytecount, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, }, - 'totalbytes_threshold'=> { label => 'Total up and download', + 'totalbytes_threshold'=> { label => 'Total up and download threshold', type => 'text', disable_inventory => 1, disable_select => 1, - 'format' => \&FS::UI::Web::display_bytecount, - 'parse' => \&FS::UI::Web::parse_bytecount, + 'format' => \&FS::UI::bytecount::display_bytecount, + 'parse' => \&FS::UI::bytecount::parse_bytecount, + }, + 'last_login'=> { + label => 'Last login', + type => 'disabled', + }, + 'last_logout'=> { + label => 'Last logout', + type => 'disabled', }, }, }; @@ -342,6 +353,42 @@ sub _fieldhandlers { }; } +sub last_login { + shift->_lastlog('in', @_); +} + +sub last_logout { + shift->_lastlog('out', @_); +} + +sub _lastlog { + my( $self, $op, $time ) = @_; + + if ( defined($time) ) { + warn "$me last_log$op called on svcnum ". $self->svcnum. + ' ('. $self->email. "): $time\n" + if $DEBUG; + + my $dbh = dbh; + + my $sql = "UPDATE svc_acct SET last_log$op = ? WHERE svcnum = ?"; + warn "$me $sql\n" + if $DEBUG; + + my $sth = $dbh->prepare( $sql ) + or die "Error preparing $sql: ". $dbh->errstr; + my $rv = $sth->execute($time, $self->svcnum); + die "Error executing $sql: ". $sth->errstr + unless defined($rv); + die "Can't update last_log$op for svcnum". $self->svcnum + if $rv == 0; + + $self->{'Hash'}->{"last_log$op"} = $time; + }else{ + $self->getfield("last_log$op"); + } +} + =item search_sql STRING Class method which returns an SQL fragment to search for the given string. @@ -688,14 +735,15 @@ contain an arrayref of group names. See L. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + warn "$me replacing $old with $new\n" if $DEBUG; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } ); - } + my $error; return "can't modify system account" if $old->_check_system; @@ -778,7 +826,7 @@ sub replace { } } - $error = $new->SUPER::replace($old); + $error = $new->SUPER::replace($old, @_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error; @@ -844,7 +892,7 @@ Called by the suspend method of FS::cust_pkg (see L). sub suspend { my $self = shift; return "can't suspend system account" if $self->_check_system; - $self->SUPER::suspend; + $self->SUPER::suspend(@_); } =item unsuspend @@ -866,7 +914,7 @@ sub unsuspend { return $error if $error; } - $self->SUPER::unsuspend; + $self->SUPER::unsuspend(@_); } =item cancel @@ -897,7 +945,7 @@ sub cancel { } } - $self->SUPER::cancel; + $self->SUPER::cancel(@_); } @@ -1092,7 +1140,7 @@ sub check { $recref->{_password} = $1.$2; } else { - return 'Illegal (crypt-encoded) password'; + return 'Illegal (crypt-encoded) password: '. $recref->{_password}; } } elsif ( $recref->{_password_encoding} eq 'plain' ) { @@ -1196,11 +1244,19 @@ sub _check_duplicate { my $global_unique = $conf->config('global_unique-username') || 'none'; return '' if $global_unique eq 'disabled'; - #this is Pg-specific. what to do for mysql etc? - # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ ) warn "$me locking svc_acct table for duplicate search" if $DEBUG; - dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE") - or die dbh->errstr; + if ( driver_name =~ /^Pg/i ) { + dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE") + or die dbh->errstr; + } elsif ( driver_name =~ /^mysql/i ) { + dbh->do("SELECT * FROM duplicate_lock + WHERE lockname = 'svc_acct' + FOR UPDATE" + ) or die dbh->errstr; + } else { + die "unknown database ". driver_name. + "; don't know how to lock for duplicate search"; + } warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG; my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); @@ -1265,7 +1321,8 @@ sub _check_duplicate { foreach my $dup_user ( @dup_user ) { my $dup_svcpart = $dup_user->cust_svc->svcpart; if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { - return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. + return "duplicate username ". $self->username. + ": conflicts with svcnum ". $dup_user->svcnum. " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; } } @@ -1273,9 +1330,9 @@ sub _check_duplicate { foreach my $dup_userdomain ( @dup_userdomain ) { my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - return "duplicate username\@domain: conflicts with svcnum ". - $dup_userdomain->svcnum. " via exportnum ". - $conflict_userdomain_svcpart{$dup_svcpart}; + return "duplicate username\@domain ". $self->email. + ": conflicts with svcnum ". $dup_userdomain->svcnum. + " via exportnum ". $conflict_userdomain_svcpart{$dup_svcpart}; } } @@ -1283,9 +1340,11 @@ sub _check_duplicate { my $dup_svcpart = $dup_uid->cust_svc->svcpart; if ( exists($conflict_user_svcpart{$dup_svcpart}) || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart} - || $conflict_userdomain_svcpart{$dup_svcpart}; + return "duplicate uid ". $self->uid. + ": conflicts with svcnum ". $dup_uid->svcnum. + " via exportnum ". + ( $conflict_user_svcpart{$dup_svcpart} + || $conflict_userdomain_svcpart{$dup_svcpart} ); } } @@ -1635,7 +1694,10 @@ sub _op_usage { my $action = $op2action{$op}; - if ( &{$op2condition{$op}}($self, $column, $amount) ) { + if ( &{$op2condition{$op}}($self, $column, $amount) && + ( $action eq 'suspend' && !$self->overlimit + || $action eq 'unsuspend' && $self->overlimit ) + ) { foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { if ($part_export->option('overlimit_groups')) { my ($new,$old); @@ -1662,7 +1724,7 @@ sub _op_usage { && &{$op2condition{$op}}($self, $column, $amount) ) { #my $error = $self->$action(); my $error = $self->cust_svc->cust_pkg->$action(); - $error ||= $self->overlimit($action); + # $error ||= $self->overlimit($action); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error ${action}ing: $error"; @@ -1749,7 +1811,7 @@ sub set_usage { if (scalar(keys %handyhash)) { my $sth = $dbh->prepare( $sql ) or die "Error preparing $sql: ". $dbh->errstr; - my $rv = $sth->execute((grep{$_} values %handyhash), $self->svcnum); + my $rv = $sth->execute((values %handyhash), $self->svcnum); die "Error executing $sql: ". $sth->errstr unless defined($rv); die "Can't update usage for svcnum ". $self->svcnum @@ -1757,15 +1819,18 @@ sub set_usage { } if ( $reset ) { - my $error = $self->overlimit('unsuspend'); - - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - if ($part_export->option('overlimit_groups')) { - my $old = new FS::svc_acct $self->hashref; - my $groups = &{ $self->_fieldhandlers->{'usergroup'} } - ($self, $part_export->option('overlimit_groups')); - $old->usergroup( $groups ); - $error ||= $part_export->export_replace($self, $old); + my $error; + + if ($self->overlimit) { + $error = $self->overlimit('unsuspend'); + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + if ($part_export->option('overlimit_groups')) { + my $old = new FS::svc_acct $self->hashref; + my $groups = &{ $self->_fieldhandlers->{'usergroup'} } + ($self, $part_export->option('overlimit_groups')); + $old->usergroup( $groups ); + $error ||= $part_export->export_replace($self, $old); + } } } @@ -1902,6 +1967,17 @@ sub get_session_history { $self->cust_svc->get_session_history(@_); } +=item last_login_text + +Returns text describing the time of last login. + +=cut + +sub last_login_text { + my $self = shift; + $self->last_login ? ctime($self->last_login) : 'unknown'; +} + =item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ] =cut @@ -2303,7 +2379,7 @@ sub send_email { =cut sub check_and_rebuild_fuzzyfiles { - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; -e "$dir/svc_acct.username" or &rebuild_fuzzyfiles; } @@ -2316,7 +2392,7 @@ sub rebuild_fuzzyfiles { use Fcntl qw(:flock); - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; #username @@ -2342,7 +2418,7 @@ sub rebuild_fuzzyfiles { =cut sub all_username { - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; open(USERNAMECACHE,"<$dir/svc_acct.username") or die "can't open $dir/svc_acct.username: $!"; my @array = map { chomp; $_; } ; @@ -2361,7 +2437,7 @@ sub append_fuzzyfiles { use Fcntl qw(:flock); - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; open(USERNAME,">>$dir/svc_acct.username") or die "can't open $dir/svc_acct.username: $!"; @@ -2484,8 +2560,12 @@ sub reached_threshold { 'last' => $cust_main->getfield('last'), 'pkg' => $cust_pkg->part_pkg->pkg, 'column' => $opt{'column'}, - 'amount' => $svc_acct->getfield($opt{'column'}), - 'threshold' => $threshold, + 'amount' => $opt{'column'} =~/bytes/ + ? FS::UI::bytecount::display_bytecount($svc_acct->getfield($opt{'column'})) + : $svc_acct->getfield($opt{'column'}), + 'threshold' => $opt{'column'} =~/bytes/ + ? FS::UI::bytecount::display_bytecount($threshold) + : $threshold, } ); @@ -2529,5 +2609,61 @@ schema.html from the base documentation. =cut +=item domain_select_hash %OPTIONS + +Returns a hash SVCNUM => DOMAIN ... representing the domains this customer +may at present purchase. + +Currently available options are: I I + +=cut + +sub domain_select_hash { + my ($self, %options) = @_; + my %domains = (); + my $part_svc; + my $cust_pkg; + + if (ref($self)) { + $part_svc = $self->part_svc; + $cust_pkg = $self->cust_svc->cust_pkg + if $self->cust_svc; + } + + $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} }) + if $options{'svcpart'}; + + $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} }) + if $options{'pkgnum'}; + + if ($part_svc && ( $part_svc->part_svc_column('domsvc')->columnflag eq 'S' + || $part_svc->part_svc_column('domsvc')->columnflag eq 'F')) { + %domains = map { $_->svcnum => $_->domain } + map { qsearchs('svc_domain', { 'svcnum' => $_ }) } + split(',', $part_svc->part_svc_column('domsvc')->columnvalue); + }elsif ($cust_pkg && !$conf->exists('svc_acct-alldomains') ) { + %domains = map { $_->svcnum => $_->domain } + map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum }) } + map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) } + qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum }); + }else{ + %domains = map { $_->svcnum => $_->domain } qsearch('svc_domain', {} ); + } + + if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag eq 'D') { + my $svc_domain = qsearchs('svc_domain', + { 'svcnum' => $part_svc->part_svc_column('domsvc')->columnvalue } ); + if ( $svc_domain ) { + $domains{$svc_domain->svcnum} = $svc_domain->domain; + }else{ + warn "unknown svc_domain.svcnum for part_svc_column domsvc: ". + $part_svc->part_svc_column('domsvc')->columnvalue; + + } + } + + (%domains); +} + 1;