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->check;
 162   return $error if $error;
 163
 164   $error = $self->SUPER::insert(@_);
 165   if ($error) {
 166     $dbh->rollback if $oldAutoCommit;
 167     return $error;
 168   }
 169
 170   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 171   ''; #no error
 172
 173 }
 174
 175 =item delete
 176
 177 Deletes this mail forwarding alias from the database.  If there is an error,
 178 returns the error, otherwise returns false.
 179
 180 The corresponding FS::cust_svc record will be deleted as well.
 181
 182 =cut
 183
 184 sub delete {
 185   my $self = shift;
 186
 187   local $SIG{HUP} = 'IGNORE';
 188   local $SIG{INT} = 'IGNORE';
 189   local $SIG{QUIT} = 'IGNORE';
 190   local $SIG{TERM} = 'IGNORE';
 191   local $SIG{TSTP} = 'IGNORE';
 192   local $SIG{PIPE} = 'IGNORE';
 193
 194   my $oldAutoCommit = $FS::UID::AutoCommit;
 195   local $FS::UID::Autocommit = 0;
 196   my $dbh = dbh;
 197
 198   my $error = $self->SUPER::delete;
 199   if ( $error ) {
 200     $dbh->rollback if $oldAutoCommit;
 201     return $error;
 202   }
 203
 204   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 205   '';
 206 }
 207
 208
 209 =item replace OLD_RECORD
 210
 211 Replaces OLD_RECORD with this one in the database.  If there is an error,
 212 returns the error, otherwise returns false.
 213
 214 =cut
 215
 216 sub replace {
 217   my ( $new, $old ) = ( shift, shift );
 218
 219   if ( $new->srcsvc != $old->srcsvc
 220        && ( $new->dstsvc != $old->dstsvc
 221             || ! $new->dstsvc && $new->dst ne $old->dst
 222           )
 223       ) {
 224     return "Can't change both source and destination of a mail forward!"
 225   }
 226
 227   local $SIG{HUP} = 'IGNORE';
 228   local $SIG{INT} = 'IGNORE';
 229   local $SIG{QUIT} = 'IGNORE';
 230   local $SIG{TERM} = 'IGNORE';
 231   local $SIG{TSTP} = 'IGNORE';
 232   local $SIG{PIPE} = 'IGNORE';
 233
 234   my $oldAutoCommit = $FS::UID::AutoCommit;
 235   local $FS::UID::AutoCommit = 0;
 236   my $dbh = dbh;
 237
 238   my $error = $new->SUPER::replace($old);
 239   if ($error) {
 240     $dbh->rollback if $oldAutoCommit;
 241     return $error;
 242   }
 243
 244   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 245   '';
 246 }
 247
 248 =item suspend
 249
 250 Just returns false (no error) for now.
 251
 252 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 253
 254 =item unsuspend
 255
 256 Just returns false (no error) for now.
 257
 258 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 259
 260 =item cancel
 261
 262 Just returns false (no error) for now.
 263
 264 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 265
 266 =item check
 267
 268 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 269 is an error, returns the error, otherwise returns false.  Called by the insert
 270 and replace methods.
 271
 272 Sets any fixed values; see L<FS::part_svc>.
 273
 274 =cut
 275
 276 sub check {
 277   my $self = shift;
 278
 279   my $x = $self->setfixed;
 280   return $x unless ref($x);
 281   #my $part_svc = $x;
 282
 283   my $error = $self->ut_numbern('svcnum')
 284               || $self->ut_numbern('srcsvc')
 285               || $self->ut_numbern('dstsvc')
 286   ;
 287   return $error if $error;
 288
 289   return "Both srcsvc and src were defined; only one can be specified"
 290     if $self->srcsvc && $self->src;
 291
 292   return "one of srcsvc or src is required"
 293     unless $self->srcsvc || $self->src;
 294
 295   return "Unknown srcsvc: ". $self->srcsvc
 296     unless ! $self->srcsvc || $self->srcsvc_acct;
 297
 298   return "Both dstsvc and dst were defined; only one can be specified"
 299     if $self->dstsvc && $self->dst;
 300
 301   return "one of dstsvc or dst is required"
 302     unless $self->dstsvc || $self->dst;
 303
 304   return "Unknown dstsvc: ". $self->dstsvc
 305     unless ! $self->dstsvc || $self->dstsvc_acct;
 306   #return "Unknown dstsvc"
 307   #  unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } )
 308   #         || ! $self->dstsvc;
 309
 310   if ( $self->src ) {
 311     $self->src =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/
 312        or return "Illegal src: ". $self->src;
 313     $self->src("$1$2");
 314   } else {
 315     $self->src('');
 316   }
 317
 318   if ( $self->dst ) {
 319     my $conf = new FS::Conf;
 320     if ( $conf->exists('svc_forward-arbitrary_dst') ) {
 321       my $error = $self->ut_textn('dst');
 322       return $error if $error;
 323     } else {
 324       $self->dst =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)$/
 325          or return "Illegal dst: ". $self->dst;
 326       $self->dst("$1$2");
 327     }
 328   } else {
 329     $self->dst('');
 330   }
 331
 332   $self->SUPER::check;
 333 }
 334
 335 =item srcsvc_acct
 336
 337 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 338 literally specified forwards.
 339
 340 =cut
 341
 342 sub srcsvc_acct {
 343   my $self = shift;
 344   qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
 345 }
 346
 347 =item dstsvc_acct
 348
 349 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 350 literally specified forwards.
 351
 352 =cut
 353
 354 sub dstsvc_acct {
 355   my $self = shift;
 356   qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
 357 }
 358
 359 =back
 360
 361 =head1 BUGS
 362
 363 =head1 SEE ALSO
 364
 365 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 366 L<FS::svc_acct>, L<FS::svc_domain>, schema.html from the base documentation.
 367
 368 =cut
 369
 370 1;
 371