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 [ , OPTION => VALUE ... ]
  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 Currently available options are: I<depend_jobnum>
  78
  79 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
  80 jobnums), all provisioning jobs will have a dependancy on the supplied
  81 jobnum(s) (they will not run until the specific job(s) complete(s)).
  82
  83 =cut
  84
  85 sub insert {
  86   my $self = shift;
  87   my $error;
  88
  89   local $SIG{HUP} = 'IGNORE';
  90   local $SIG{INT} = 'IGNORE';
  91   local $SIG{QUIT} = 'IGNORE';
  92   local $SIG{TERM} = 'IGNORE';
  93   local $SIG{TSTP} = 'IGNORE';
  94   local $SIG{PIPE} = 'IGNORE';
  95
  96   my $oldAutoCommit = $FS::UID::AutoCommit;
  97   local $FS::UID::AutoCommit = 0;
  98   my $dbh = dbh;
  99
 100   $error = $self->check;
 101   return $error if $error;
 102
 103   $error = $self->SUPER::insert(@_);
 104   if ($error) {
 105     $dbh->rollback if $oldAutoCommit;
 106     return $error;
 107   }
 108
 109   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 110   ''; #no error
 111
 112 }
 113
 114 =item delete
 115
 116 Deletes this mail forwarding alias from the database.  If there is an error,
 117 returns the error, otherwise returns false.
 118
 119 The corresponding FS::cust_svc record will be deleted as well.
 120
 121 =cut
 122
 123 sub delete {
 124   my $self = shift;
 125
 126   local $SIG{HUP} = 'IGNORE';
 127   local $SIG{INT} = 'IGNORE';
 128   local $SIG{QUIT} = 'IGNORE';
 129   local $SIG{TERM} = 'IGNORE';
 130   local $SIG{TSTP} = 'IGNORE';
 131   local $SIG{PIPE} = 'IGNORE';
 132
 133   my $oldAutoCommit = $FS::UID::AutoCommit;
 134   local $FS::UID::Autocommit = 0;
 135   my $dbh = dbh;
 136
 137   my $error = $self->SUPER::delete;
 138   if ( $error ) {
 139     $dbh->rollback if $oldAutoCommit;
 140     return $error;
 141   }
 142
 143   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 144   '';
 145 }
 146
 147
 148 =item replace OLD_RECORD
 149
 150 Replaces OLD_RECORD with this one in the database.  If there is an error,
 151 returns the error, otherwise returns false.
 152
 153 =cut
 154
 155 sub replace {
 156   my ( $new, $old ) = ( shift, shift );
 157
 158   if ( $new->srcsvc != $old->srcsvc
 159        && ( $new->dstsvc != $old->dstsvc
 160             || ! $new->dstsvc && $new->dst ne $old->dst
 161           )
 162       ) {
 163     return "Can't change both source and destination of a mail forward!"
 164   }
 165
 166   local $SIG{HUP} = 'IGNORE';
 167   local $SIG{INT} = 'IGNORE';
 168   local $SIG{QUIT} = 'IGNORE';
 169   local $SIG{TERM} = 'IGNORE';
 170   local $SIG{TSTP} = 'IGNORE';
 171   local $SIG{PIPE} = 'IGNORE';
 172
 173   my $oldAutoCommit = $FS::UID::AutoCommit;
 174   local $FS::UID::AutoCommit = 0;
 175   my $dbh = dbh;
 176
 177   my $error = $new->SUPER::replace($old);
 178   if ($error) {
 179     $dbh->rollback if $oldAutoCommit;
 180     return $error;
 181   }
 182
 183   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 184   '';
 185 }
 186
 187 =item suspend
 188
 189 Just returns false (no error) for now.
 190
 191 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 192
 193 =item unsuspend
 194
 195 Just returns false (no error) for now.
 196
 197 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 198
 199 =item cancel
 200
 201 Just returns false (no error) for now.
 202
 203 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 204
 205 =item check
 206
 207 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 208 is an error, returns the error, otherwise returns false.  Called by the insert
 209 and replace methods.
 210
 211 Sets any fixed values; see L<FS::part_svc>.
 212
 213 =cut
 214
 215 sub check {
 216   my $self = shift;
 217
 218   my $x = $self->setfixed;
 219   return $x unless ref($x);
 220   #my $part_svc = $x;
 221
 222   my $error = $self->ut_numbern('svcnum')
 223               || $self->ut_number('srcsvc')
 224               || $self->ut_numbern('dstsvc')
 225   ;
 226   return $error if $error;
 227
 228   return "Unknown srcsvc" unless $self->srcsvc_acct;
 229
 230   return "Both dstsvc and dst were defined; only one can be specified"
 231     if $self->dstsvc && $self->dst;
 232
 233   return "one of dstsvc or dst is required"
 234     unless $self->dstsvc || $self->dst;
 235
 236   #return "Unknown dstsvc: $dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc;
 237   return "Unknown dstsvc"
 238     unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } )
 239            || ! $self->dstsvc;
 240
 241
 242   if ( $self->dst ) {
 243     $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/
 244        or return "Illegal dst: ". $self->dst;
 245     $self->dst("$1\@$2");
 246   } else {
 247     $self->dst('');
 248   }
 249
 250   ''; #no error
 251 }
 252
 253 =item srcsvc_acct
 254
 255 Returns the FS::svc_acct object referenced by the srcsvc column.
 256
 257 =cut
 258
 259 sub srcsvc_acct {
 260   my $self = shift;
 261   qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
 262 }
 263
 264 =item dstsvc_acct
 265
 266 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 267 forwards not local to freeside.
 268
 269 =cut
 270
 271 sub dstsvc_acct {
 272   my $self = shift;
 273   qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
 274 }
 275
 276 =back
 277
 278 =head1 BUGS
 279
 280 =head1 SEE ALSO
 281
 282 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 283 L<FS::svc_acct>, L<FS::svc_domain>, schema.html from the base documentation.
 284
 285 =cut
 286
 287 1;
 288