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
  70 sub table_info {
  71   {
  72     'name' => 'Forward',
  73     'name_plural' => 'Mail forwards',
  74     'display_weight' => 30,
  75     'cancel_weight'  => 30,
  76     'fields' => {
  77         'srcsvc'    => 'service from which mail is to be forwarded',
  78         'dstsvc'    => 'service to which mail is to be forwarded',
  79         'dst'       => 'someone@another.domain.com to use when dstsvc is 0',
  80     },
  81   };
  82 }
  83
  84 sub table { 'svc_forward'; }
  85
  86 =item search_sql STRING
  87
  88 Class method which returns an SQL fragment to search for the given string.
  89
  90 =cut
  91
  92 sub search_sql {
  93   my( $class, $string ) = @_;
  94   $class->search_sql_field('src', $string);
  95 }
  96
  97 =item label [ END_TIMESTAMP [ START_TIMESTAMP ] ]
  98
  99 Returns a text string representing this forward.
 100
 101 END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
 102 history records.
 103
 104 =cut
 105
 106 sub label {
 107   my $self = shift;
 108   my $tag = '';
 109
 110   if ( $self->srcsvc ) {
 111     my $svc_acct = $self->srcsvc_acct(@_);
 112     $tag = $svc_acct->email(@_);
 113   } else {
 114     $tag = $self->src;
 115   }
 116
 117   $tag .= ' -> ';
 118
 119   if ( $self->dstsvc ) {
 120     my $svc_acct = $self->dstsvc_acct(@_);
 121     $tag .= $svc_acct->email(@_);
 122   } else {
 123     $tag .= $self->dst;
 124   }
 125
 126   $tag;
 127 }
 128
 129
 130 =item insert [ , OPTION => VALUE ... ]
 131
 132 Adds this mail forwarding alias to the database.  If there is an error, returns
 133 the error, otherwise returns false.
 134
 135 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 136 defined.  An FS::cust_svc record will be created and inserted.
 137
 138 Currently available options are: I<depend_jobnum>
 139
 140 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 141 jobnums), all provisioning jobs will have a dependancy on the supplied
 142 jobnum(s) (they will not run until the specific job(s) complete(s)).
 143
 144 =cut
 145
 146 sub insert {
 147   my $self = shift;
 148   my $error;
 149
 150   local $SIG{HUP} = 'IGNORE';
 151   local $SIG{INT} = 'IGNORE';
 152   local $SIG{QUIT} = 'IGNORE';
 153   local $SIG{TERM} = 'IGNORE';
 154   local $SIG{TSTP} = 'IGNORE';
 155   local $SIG{PIPE} = 'IGNORE';
 156
 157   my $oldAutoCommit = $FS::UID::AutoCommit;
 158   local $FS::UID::AutoCommit = 0;
 159   my $dbh = dbh;
 160
 161   $error = $self->SUPER::insert(@_);
 162   if ($error) {
 163     $dbh->rollback if $oldAutoCommit;
 164     return $error;
 165   }
 166
 167   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 168   ''; #no error
 169
 170 }
 171
 172 =item delete
 173
 174 Deletes this mail forwarding alias from the database.  If there is an error,
 175 returns the error, otherwise returns false.
 176
 177 The corresponding FS::cust_svc record will be deleted as well.
 178
 179 =cut
 180
 181 sub delete {
 182   my $self = shift;
 183
 184   local $SIG{HUP} = 'IGNORE';
 185   local $SIG{INT} = 'IGNORE';
 186   local $SIG{QUIT} = 'IGNORE';
 187   local $SIG{TERM} = 'IGNORE';
 188   local $SIG{TSTP} = 'IGNORE';
 189   local $SIG{PIPE} = 'IGNORE';
 190
 191   my $oldAutoCommit = $FS::UID::AutoCommit;
 192   local $FS::UID::Autocommit = 0;
 193   my $dbh = dbh;
 194
 195   my $error = $self->SUPER::delete(@_);
 196   if ( $error ) {
 197     $dbh->rollback if $oldAutoCommit;
 198     return $error;
 199   }
 200
 201   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 202   '';
 203 }
 204
 205
 206 =item replace OLD_RECORD
 207
 208 Replaces OLD_RECORD with this one in the database.  If there is an error,
 209 returns the error, otherwise returns false.
 210
 211 =cut
 212
 213 sub replace {
 214   my ( $new, $old ) = ( shift, shift );
 215
 216   if ( $new->srcsvc != $old->srcsvc
 217        && ( $new->dstsvc != $old->dstsvc
 218             || ! $new->dstsvc && $new->dst ne $old->dst
 219           )
 220       ) {
 221     return "Can't change both source and destination of a mail forward!"
 222   }
 223
 224   local $SIG{HUP} = 'IGNORE';
 225   local $SIG{INT} = 'IGNORE';
 226   local $SIG{QUIT} = 'IGNORE';
 227   local $SIG{TERM} = 'IGNORE';
 228   local $SIG{TSTP} = 'IGNORE';
 229   local $SIG{PIPE} = 'IGNORE';
 230
 231   my $oldAutoCommit = $FS::UID::AutoCommit;
 232   local $FS::UID::AutoCommit = 0;
 233   my $dbh = dbh;
 234
 235   my $error = $new->SUPER::replace($old, @_);
 236   if ($error) {
 237     $dbh->rollback if $oldAutoCommit;
 238     return $error;
 239   }
 240
 241   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 242   '';
 243 }
 244
 245 =item suspend
 246
 247 Just returns false (no error) for now.
 248
 249 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 250
 251 =item unsuspend
 252
 253 Just returns false (no error) for now.
 254
 255 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 256
 257 =item cancel
 258
 259 Just returns false (no error) for now.
 260
 261 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 262
 263 =item check
 264
 265 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 266 is an error, returns the error, otherwise returns false.  Called by the insert
 267 and replace methods.
 268
 269 Sets any fixed values; see L<FS::part_svc>.
 270
 271 =cut
 272
 273 sub check {
 274   my $self = shift;
 275
 276   my $x = $self->setfixed;
 277   return $x unless ref($x);
 278   #my $part_svc = $x;
 279
 280   my $error = $self->ut_numbern('svcnum')
 281               || $self->ut_numbern('srcsvc')
 282               || $self->ut_numbern('dstsvc')
 283   ;
 284   return $error if $error;
 285
 286   return "Both srcsvc and src were defined; only one can be specified"
 287     if $self->srcsvc && $self->src;
 288
 289   return "one of srcsvc or src is required"
 290     unless $self->srcsvc || $self->src;
 291
 292   return "Unknown srcsvc: ". $self->srcsvc
 293     unless ! $self->srcsvc || $self->srcsvc_acct;
 294
 295   return "Both dstsvc and dst were defined; only one can be specified"
 296     if $self->dstsvc && $self->dst;
 297
 298   return "one of dstsvc or dst is required"
 299     unless $self->dstsvc || $self->dst;
 300
 301   return "Unknown dstsvc: ". $self->dstsvc
 302     unless ! $self->dstsvc || $self->dstsvc_acct;
 303   #return "Unknown dstsvc"
 304   #  unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } )
 305   #         || ! $self->dstsvc;
 306
 307   if ( $self->src ) {
 308     $self->src =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/
 309        or return "Illegal src: ". $self->src;
 310     $self->src("$1$2");
 311   } else {
 312     $self->src('');
 313   }
 314
 315   if ( $self->dst ) {
 316     my $conf = new FS::Conf;
 317     if ( $conf->exists('svc_forward-arbitrary_dst') ) {
 318       my $error = $self->ut_textn('dst');
 319       return $error if $error;
 320     } else {
 321       $self->dst =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/
 322          or return "Illegal dst: ". $self->dst;
 323       $self->dst("$1$2");
 324     }
 325   } else {
 326     $self->dst('');
 327   }
 328
 329   $self->SUPER::check;
 330 }
 331
 332 =item srcsvc_acct
 333
 334 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 335 literally specified forwards.
 336
 337 =cut
 338
 339 sub srcsvc_acct {
 340   my $self = shift;
 341   qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
 342 }
 343
 344 =item dstsvc_acct
 345
 346 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 347 literally specified forwards.
 348
 349 =cut
 350
 351 sub dstsvc_acct {
 352   my $self = shift;
 353   qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
 354 }
 355
 356 =back
 357
 358 =head1 BUGS
 359
 360 =head1 SEE ALSO
 361
 362 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 363 L<FS::svc_acct>, L<FS::svc_domain>, schema.html from the base documentation.
 364
 365 =cut
 366
 367 1;
 368