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