X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=3e3ecb5bd3417f0b639ea5e7a9f0b5fca849bd24;hb=477015901c379f8cd6ba46cfaa4a9ae284ae582d;hp=dad60f8a5ebd1ed57f31af8d4b65d24c9e7c5ee0;hpb=6a6295a6da63a875192e497ac8e09ec616da95e5;p=freeside.git

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index dad60f8a5..3e3ecb5bd 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;
@@ -83,6 +85,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $smtpmachine = $conf->config('smtpmachine');
   $radius_password = $conf->config('radius-password') || 'Password';
   $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
+  @pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps');
 };
 
 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
@@ -202,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' => {
@@ -268,10 +271,66 @@ sub table_info {
                          disable_select => 1,
                        },
         'seconds'   => { label => 'Seconds',
+                         label_sort => 'with Time Remaining',
                          type  => 'text',
                          disable_inventory => 1,
                          disable_select => 1,
                        },
+        'upbytes'   => { label => 'Upload',
+                         type  => 'text',
+                         disable_inventory => 1,
+                         disable_select => 1,
+                         '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::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::bytecount::display_bytecount,
+                         'parse' => \&FS::UI::bytecount::parse_bytecount,
+                       },
+        'seconds_threshold'   => { label => 'Seconds threshold',
+                                   type  => 'text',
+                                   disable_inventory => 1,
+                                   disable_select => 1,
+                                 },
+        'upbytes_threshold'   => { label => 'Upload threshold',
+                                   type  => 'text',
+                                   disable_inventory => 1,
+                                   disable_select => 1,
+                                   'format' => \&FS::UI::bytecount::display_bytecount,
+                                   'parse' => \&FS::UI::bytecount::parse_bytecount,
+                                 },
+        'downbytes_threshold' => { label => 'Download threshold',
+                                   type  => 'text',
+                                   disable_inventory => 1,
+                                   disable_select => 1,
+                                   'format' => \&FS::UI::bytecount::display_bytecount,
+                                   'parse' => \&FS::UI::bytecount::parse_bytecount,
+                                 },
+        'totalbytes_threshold'=> { label => 'Total up and download threshold',
+                                   type  => 'text',
+                                   disable_inventory => 1,
+                                   disable_select => 1,
+                                   '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',
+                                 },
     },
   };
 }
@@ -294,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.
@@ -640,14 +735,15 @@ contain an arrayref of group names.  See L<FS::radius_usergroup>.
 =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;
 
@@ -730,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;
@@ -796,7 +892,7 @@ Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 sub suspend {
   my $self = shift;
   return "can't suspend system account" if $self->_check_system;
-  $self->SUPER::suspend;
+  $self->SUPER::suspend(@_);
 }
 
 =item unsuspend
@@ -818,7 +914,7 @@ sub unsuspend {
     return $error if $error;
   }
 
-  $self->SUPER::unsuspend;
+  $self->SUPER::unsuspend(@_);
 }
 
 =item cancel
@@ -849,7 +945,7 @@ sub cancel {
     }
   }
 
-  $self->SUPER::cancel;
+  $self->SUPER::cancel(@_);
 }
 
 
@@ -1148,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 } );
@@ -1587,7 +1691,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);
@@ -1601,6 +1708,7 @@ sub _op_usage {
           $new = $self; $old = $other;
         }
         my $error = $part_export->export_replace($new, $old);
+        $error ||= $self->overlimit($action);
         if ( $error ) {
           $dbh->rollback if $oldAutoCommit;
           return "Error replacing radius groups in export, ${op}: $error";
@@ -1613,6 +1721,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);
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return "Error ${action}ing: $error";
@@ -1699,15 +1808,32 @@ 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
       if $rv == 0;
   }
 
-  if ( $conf->exists("svc_acct-usage_unsuspend") && $reset ) {
-    my $error = $self->cust_svc->cust_pkg->unsuspend;
+  if ( $reset ) {
+    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);
+        }
+      }
+    }
+
+    if ( $conf->exists("svc_acct-usage_unsuspend")) {
+      $error ||= $self->cust_svc->cust_pkg->unsuspend;
+    }
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return "Error unsuspending: $error";
@@ -1838,6 +1964,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
@@ -2239,7 +2376,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;
 }
@@ -2252,7 +2389,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
 
@@ -2278,7 +2415,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; $_; } <USERNAMECACHE>;
@@ -2297,7 +2434,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: $!";
@@ -2420,8 +2557,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,
                       } );
 
 
@@ -2465,5 +2606,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<pkgnum> I<svcpart>
+
+=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;