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