FS/FS/svc_forward.pm

   1 package FS::svc_forward;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Conf;
   6 use FS::Record qw( fields qsearch qsearchs dbh );
   7 use FS::svc_Common;
   8 use FS::cust_svc;
   9 use FS::svc_acct;
  10 use FS::svc_domain;
  11
  12 @ISA = qw( FS::svc_Common );
  13
  14 =head1 NAME
  15
  16 FS::svc_forward - Object methods for svc_forward records
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::svc_forward;
  21
  22   $record = new FS::svc_forward \%hash;
  23   $record = new FS::svc_forward { 'column' => 'value' };
  24
  25   $error = $record->insert;
  26
  27   $error = $new_record->replace($old_record);
  28
  29   $error = $record->delete;
  30
  31   $error = $record->check;
  32
  33   $error = $record->suspend;
  34
  35   $error = $record->unsuspend;
  36
  37   $error = $record->cancel;
  38
  39 =head1 DESCRIPTION
  40
  41 An FS::svc_forward object represents a mail forwarding alias.  FS::svc_forward
  42 inherits from FS::Record.  The following fields are currently supported:
  43
  44 =over 4
  45
  46 =item svcnum - primary key (assigned automatcially for new accounts)
  47
  48 =item srcsvc - svcnum of the source of the forward (see L<FS::svc_acct>)
  49
  50 =item dstsvc - svcnum of the destination of the forward (see L<FS::svc_acct>)
  51
  52 =item dst - foreign destination (email address) - forward not local to freeside
  53
  54 =back
  55
  56 =head1 METHODS
  57
  58 =over 4
  59
  60 =item new HASHREF
  61
  62 Creates a new mail forwarding alias.  To add the mail forwarding alias to the
  63 database, see L<"insert">.
  64
  65 =cut
  66
  67 sub table { 'svc_forward'; }
  68
  69 =item insert
  70
  71 Adds this mail forwarding alias to the database.  If there is an error, returns
  72 the error, otherwise returns false.
  73
  74 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  75 defined.  An FS::cust_svc record will be created and inserted.
  76
  77 =cut
  78
  79 sub insert {
  80   my $self = shift;
  81   my $error;
  82
  83   local $SIG{HUP} = 'IGNORE';
  84   local $SIG{INT} = 'IGNORE';
  85   local $SIG{QUIT} = 'IGNORE';
  86   local $SIG{TERM} = 'IGNORE';
  87   local $SIG{TSTP} = 'IGNORE';
  88   local $SIG{PIPE} = 'IGNORE';
  89
  90   my $oldAutoCommit = $FS::UID::AutoCommit;
  91   local $FS::UID::AutoCommit = 0;
  92   my $dbh = dbh;
  93
  94   $error = $self->check;
  95   return $error if $error;
  96
  97   $error = $self->SUPER::insert;
  98   if ($error) {
  99     $dbh->rollback if $oldAutoCommit;
 100     return $error;
 101   }
 102
 103   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 104   ''; #no error
 105
 106 }
 107
 108 =item delete
 109
 110 Deletes this mail forwarding alias from the database.  If there is an error,
 111 returns the error, otherwise returns false.
 112
 113 The corresponding FS::cust_svc record will be deleted as well.
 114
 115 =cut
 116
 117 sub delete {
 118   my $self = shift;
 119
 120   local $SIG{HUP} = 'IGNORE';
 121   local $SIG{INT} = 'IGNORE';
 122   local $SIG{QUIT} = 'IGNORE';
 123   local $SIG{TERM} = 'IGNORE';
 124   local $SIG{TSTP} = 'IGNORE';
 125   local $SIG{PIPE} = 'IGNORE';
 126
 127   my $oldAutoCommit = $FS::UID::AutoCommit;
 128   local $FS::UID::Autocommit = 0;
 129   my $dbh = dbh;
 130
 131   my $error = $self->SUPER::delete;
 132   if ( $error ) {
 133     $dbh->rollback if $oldAutoCommit;
 134     return $error;
 135   }
 136
 137   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 138   '';
 139 }
 140
 141
 142 =item replace OLD_RECORD
 143
 144 Replaces OLD_RECORD with this one in the database.  If there is an error,
 145 returns the error, otherwise returns false.
 146
 147 =cut
 148
 149 sub replace {
 150   my ( $new, $old ) = ( shift, shift );
 151
 152   if ( $new->srcsvc != $old->srcsvc
 153        && ( $new->dstsvc != $old->dstsvc
 154             || ! $new->dstsvc && $new->dst ne $old->dst
 155           )
 156       ) {
 157     return "Can't change both source and destination of a mail forward!"
 158   }
 159
 160   local $SIG{HUP} = 'IGNORE';
 161   local $SIG{INT} = 'IGNORE';
 162   local $SIG{QUIT} = 'IGNORE';
 163   local $SIG{TERM} = 'IGNORE';
 164   local $SIG{TSTP} = 'IGNORE';
 165   local $SIG{PIPE} = 'IGNORE';
 166
 167   my $oldAutoCommit = $FS::UID::AutoCommit;
 168   local $FS::UID::AutoCommit = 0;
 169   my $dbh = dbh;
 170
 171   my $error = $new->SUPER::replace($old);
 172   if ($error) {
 173     $dbh->rollback if $oldAutoCommit;
 174     return $error;
 175   }
 176
 177   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 178   '';
 179 }
 180
 181 =item suspend
 182
 183 Just returns false (no error) for now.
 184
 185 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 186
 187 =item unsuspend
 188
 189 Just returns false (no error) for now.
 190
 191 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 192
 193 =item cancel
 194
 195 Just returns false (no error) for now.
 196
 197 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 198
 199 =item check
 200
 201 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 202 is an error, returns the error, otherwise returns false.  Called by the insert
 203 and replace methods.
 204
 205 Sets any fixed values; see L<FS::part_svc>.
 206
 207 =cut
 208
 209 sub check {
 210   my $self = shift;
 211
 212   my $x = $self->setfixed;
 213   return $x unless ref($x);
 214   #my $part_svc = $x;
 215
 216   my $error = $self->ut_numbern('svcnum')
 217               || $self->ut_number('srcsvc')
 218               || $self->ut_numbern('dstsvc')
 219   ;
 220   return $error if $error;
 221
 222   return "Unknown srcsvc" unless $self->srcsvc_acct;
 223
 224   return "Both dstsvc and dst were defined; only one can be specified"
 225     if $self->dstsvc && $self->dst;
 226
 227   return "one of dstsvc or dst is required"
 228     unless $self->dstsvc || $self->dst;
 229
 230   #return "Unknown dstsvc: $dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc;
 231   return "Unknown dstsvc"
 232     unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } )
 233            || ! $self->dstsvc;
 234
 235
 236   if ( $self->dst ) {
 237     $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/
 238        or return "Illegal dst: ". $self->dst;
 239     $self->dst("$1\@$2");
 240   } else {
 241     $self->dst('');
 242   }
 243
 244   $self->SUPER::check;
 245 }
 246
 247 =item srcsvc_acct
 248
 249 Returns the FS::svc_acct object referenced by the srcsvc column.
 250
 251 =cut
 252
 253 sub srcsvc_acct {
 254   my $self = shift;
 255   qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
 256 }
 257
 258 =item dstsvc_acct
 259
 260 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 261 forwards not local to freeside.
 262
 263 =cut
 264
 265 sub dstsvc_acct {
 266   my $self = shift;
 267   qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
 268 }
 269
 270 =back
 271
 272 =head1 BUGS
 273
 274 =head1 SEE ALSO
 275
 276 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 277 L<FS::svc_acct>, L<FS::svc_domain>, schema.html from the base documentation.
 278
 279 =cut
 280
 281 1;
 282