FS/FS/svc_Radius_Mixin.pm

   1 package FS::svc_Radius_Mixin;
   2 use base qw( FS::m2m_Common FS::svc_Common );
   3
   4 use strict;
   5 use FS::Record qw( qsearch dbh );
   6 use FS::radius_group;
   7 use FS::radius_usergroup;
   8 use Carp qw( confess );
   9
  10 # not really a mixin since it overrides insert/replace/delete and has svc_Common
  11 #  as a base class, should probably be renamed svc_Radius_Common
  12
  13 =head1 NAME
  14
  15 FS::svc_Radius_Mixin - partial base class for services with RADIUS groups
  16
  17 =head1 METHODS
  18
  19 =over 4
  20
  21 =cut
  22
  23 sub insert {
  24   my $self = shift;
  25
  26   local $SIG{HUP} = 'IGNORE';
  27   local $SIG{INT} = 'IGNORE';
  28   local $SIG{QUIT} = 'IGNORE';
  29   local $SIG{TERM} = 'IGNORE';
  30   local $SIG{TSTP} = 'IGNORE';
  31   local $SIG{PIPE} = 'IGNORE';
  32
  33   my $oldAutoCommit = $FS::UID::AutoCommit;
  34   local $FS::UID::AutoCommit = 0;
  35   my $dbh = dbh;
  36
  37   my $error =  $self->SUPER::insert(@_)
  38             || $self->process_m2m(
  39                                    'link_table'   => 'radius_usergroup',
  40                                    'target_table' => 'radius_group',
  41                                    'params'       => $self->usergroup,
  42                                  );
  43
  44   if ( $error ) {
  45     $dbh->rollback if $oldAutoCommit;
  46     return $error;
  47   }
  48
  49   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
  50   '';
  51 }
  52
  53 sub replace  {
  54   my $new = shift;
  55   my $old = shift;
  56   $old = $new->replace_old if !defined($old);
  57
  58   local $SIG{HUP} = 'IGNORE';
  59   local $SIG{INT} = 'IGNORE';
  60   local $SIG{QUIT} = 'IGNORE';
  61   local $SIG{TERM} = 'IGNORE';
  62   local $SIG{TSTP} = 'IGNORE';
  63   local $SIG{PIPE} = 'IGNORE';
  64
  65   my $oldAutoCommit = $FS::UID::AutoCommit;
  66   local $FS::UID::AutoCommit = 0;
  67   my $dbh = dbh;
  68
  69   $old->usergroup; # make sure this is cached for exports
  70
  71   my $error =  $new->check # make sure fixed fields are set before process_m2m
  72             || $new->process_m2m(
  73                                  'link_table'   => 'radius_usergroup',
  74                                  'target_table' => 'radius_group',
  75                                  'params'       => $new->usergroup,
  76                                )
  77             || $new->SUPER::replace($old, @_);
  78
  79   if ( $error ) {
  80     $dbh->rollback if $oldAutoCommit;
  81     return $error;
  82   }
  83
  84   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
  85   '';
  86 }
  87
  88 sub delete {
  89   my $self = shift;
  90
  91   local $SIG{HUP} = 'IGNORE';
  92   local $SIG{INT} = 'IGNORE';
  93   local $SIG{QUIT} = 'IGNORE';
  94   local $SIG{TERM} = 'IGNORE';
  95   local $SIG{TSTP} = 'IGNORE';
  96   local $SIG{PIPE} = 'IGNORE';
  97
  98   my $oldAutoCommit = $FS::UID::AutoCommit;
  99   local $FS::UID::AutoCommit = 0;
 100   my $dbh = dbh;
 101
 102   my $error =  $self->SUPER::delete(@_)
 103             || $self->process_m2m(
 104                                    'link_table'   => 'radius_usergroup',
 105                                    'target_table' => 'radius_group',
 106                                    'params'       => [],
 107                                  );
 108
 109   if ( $error ) {
 110     $dbh->rollback if $oldAutoCommit;
 111     return $error;
 112   }
 113
 114   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 115   '';
 116 }
 117
 118 sub usergroup {
 119   my $self = shift;
 120   my $value = shift;
 121   if ( defined $value ) {
 122     if ( ref $value ) {
 123       return $self->set('usergroup', $value);
 124     }
 125     else {
 126       return $self->set('usergroup', [ split(/\s*,\s*/, $value) ]);
 127     }
 128   }
 129   $self->get('usergroup') ||
 130     # if no argument is passed and usergroup is not set already,
 131     # fetch this service's group assignments
 132   $self->set('usergroup',
 133     [ map { $_->groupnum }
 134         qsearch('radius_usergroup', { svcnum => $self->svcnum }) ]
 135   );
 136 }
 137
 138 sub _fieldhandlers {
 139   {
 140     'usergroup' => \&usergroup
 141   }
 142 }
 143
 144 =item radius_groups METHOD
 145
 146 Returns a list of RADIUS groups for this service (see L<FS::radius_usergroup>).
 147 METHOD is the field to return, and can be any method on L<FS::radius_group>.
 148 Useful values for METHOD include 'groupnum', 'groupname', and
 149 'long_description'.  Defaults to 'groupname' for historical reasons.
 150
 151 =cut
 152
 153 sub radius_groups {
 154   my $self = shift;
 155   my $method = shift || 'groupname';
 156   my $groups = join(',', @{$self->usergroup}) || return ();
 157   my @groups = qsearch({'table' => 'radius_group',
 158                         'extra_sql' => "where groupnum in ($groups)"});
 159   return map {$_->$method} @groups;
 160 }
 161
 162 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 163
 164 Returns the numbers of seconds this account has been online between
 165 TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
 166 external SQL radacct table, specified via sqlradius export.  Sessions which
 167 started in the specified range but are still open are counted from session
 168 start to the end of the range (unless they are over 1 day old, in which case
 169 they are presumed missing their stop record and not counted).  Also, sessions
 170 which end in the range but started earlier are counted from the start of the
 171 range to session end.  Finally, sessions which start before the range but end
 172 after are counted for the entire range.
 173
 174 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 175 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 176 functions.
 177
 178 =cut
 179
 180 #note: POD here, implementation in FS::cust_svc
 181 sub seconds_since_sqlradacct {
 182   my $self = shift;
 183   $self->cust_svc->seconds_since_sqlradacct(@_);
 184 }
 185
 186 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 187
 188 For this service, returns the sum of the given attribute for sessions ending
 189 between TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive).
 190
 191 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
 192 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
 193 functions.
 194
 195 =cut
 196
 197 #note: POD here, implementation in FS::cust_svc
 198 sub attribute_since_sqlradacct {
 199   my $self = shift;
 200   $self->cust_svc->attribute_since_sqlradacct(@_);
 201 }
 202
 203 =item attribute_last_sqlradacct ATTRIBUTE
 204
 205 For this service, returns the most recent value of the given attribute.
 206
 207 =cut
 208
 209 #note: POD here, implementation in FS::cust_svc
 210 sub attribute_last_sqlradacct {
 211   my $self = shift;
 212   $self->cust_svc->attribute_last_sqlradacct(@_);
 213 }
 214 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 215
 216 Returns an array of hash references of this customers login history for the
 217 given time range.  (document this better)
 218
 219 =cut
 220
 221 sub get_session_history {
 222   my $self = shift;
 223   $self->cust_svc->get_session_history(@_);
 224 }
 225
 226
 227 =back
 228
 229 =cut
 230
 231 1;