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