FS/FS/svc_mailinglist.pm

   1 package FS::svc_mailinglist;
   2
   3 use strict;
   4 use base qw( FS::svc_Domain_Mixin FS::svc_Common );
   5 use Scalar::Util qw( blessed );
   6 use FS::Record qw( qsearchs dbh ); # qsearch );
   7 use FS::svc_domain;
   8 use FS::mailinglist;
   9
  10 =head1 NAME
  11
  12 FS::svc_mailinglist - Object methods for svc_mailinglist records
  13
  14 =head1 SYNOPSIS
  15
  16   use FS::svc_mailinglist;
  17
  18   $record = new FS::svc_mailinglist \%hash;
  19   $record = new FS::svc_mailinglist { 'column' => 'value' };
  20
  21   $error = $record->insert;
  22
  23   $error = $new_record->replace($old_record);
  24
  25   $error = $record->delete;
  26
  27   $error = $record->check;
  28
  29 =head1 DESCRIPTION
  30
  31 An FS::svc_mailinglist object represents a mailing list customer service.
  32 FS::svc_mailinglist inherits from FS::Record.  The following fields are
  33 currently supported:
  34
  35 =over 4
  36
  37 =item svcnum
  38
  39 primary key
  40
  41 =item username
  42
  43 username
  44
  45 =item domsvc
  46
  47 domsvc
  48
  49 =item listnum
  50
  51 listnum
  52
  53 =item reply_to_group
  54
  55 reply_to_group
  56
  57 =item remove_author
  58
  59 remove_author
  60
  61 =item reject_auto
  62
  63 reject_auto
  64
  65 =item remove_to_and_cc
  66
  67 remove_to_and_cc
  68
  69 =back
  70
  71 =head1 METHODS
  72
  73 =over 4
  74
  75 =item new HASHREF
  76
  77 Creates a new record.  To add the record to the database, see L<"insert">.
  78
  79 Note that this stores the hash reference, not a distinct copy of the hash it
  80 points to.  You can ask the object for a copy with the I<hash> method.
  81
  82 =cut
  83
  84 # the new method can be inherited from FS::Record, if a table method is defined
  85
  86 sub table { 'svc_mailinglist'; }
  87
  88 sub table_info {
  89   {
  90     'name' => 'Mailing list',
  91     'display_weight' => 80,
  92     'cancel_weight'  => 55,
  93     'fields' => {
  94       'username' => { 'label' => 'List address',
  95                       'disable_default'   => 1,
  96                       'disable_fixed'     => 1,
  97                       'disable_inventory' => 1,
  98                     },
  99       'domsvc' => { 'label' => 'List address domain',
 100                     'disable_inventory' => 1,
 101                     },
 102       'domain' => 'List address domain',
 103       'listnum' => { 'label' => 'List name',
 104                      'disable_inventory' => 1,
 105                    },
 106       'listname' => 'List name', #actually mailinglist.listname
 107       'reply_to' => { 'label' => 'Reply-To list',
 108                       'type'  => 'checkbox',
 109                       'disable_inventory' => 1,
 110                       'disable_select'    => 1,
 111                     },
 112       'remove_from' => { 'label' => 'Remove From: from messages',
 113                           'type'  => 'checkbox',
 114                           'disable_inventory' => 1,
 115                           'disable_select'    => 1,
 116                         },
 117       'reject_auto' => { 'label' => 'Reject automatic messages',
 118                          'type'  => 'checkbox',
 119                          'disable_inventory' => 1,
 120                          'disable_select'    => 1,
 121                        },
 122       'remove_to_and_cc' => { 'label' => 'Remove To: and Cc: from messages',
 123                               'type'  => 'checkbox',
 124                               'disable_inventory' => 1,
 125                               'disable_select'    => 1,
 126                             },
 127     },
 128   };
 129 }
 130
 131 =item insert
 132
 133 Adds this record to the database.  If there is an error, returns the error,
 134 otherwise returns false.
 135
 136 =cut
 137
 138 sub insert {
 139   my $self = shift;
 140
 141   local $SIG{HUP} = 'IGNORE';
 142   local $SIG{INT} = 'IGNORE';
 143   local $SIG{QUIT} = 'IGNORE';
 144   local $SIG{TERM} = 'IGNORE';
 145   local $SIG{TSTP} = 'IGNORE';
 146   local $SIG{PIPE} = 'IGNORE';
 147
 148   my $oldAutoCommit = $FS::UID::AutoCommit;
 149   local $FS::UID::AutoCommit = 0;
 150   my $dbh = dbh;
 151
 152   my $error;
 153
 154   #attach to existing lists?  sound scary
 155   #unless ( $self->listnum ) {
 156     my $mailinglist = new FS::mailinglist {
 157       'listname' => $self->get('listname'),
 158     };
 159     $error = $mailinglist->insert;
 160     if ( $error ) {
 161       $dbh->rollback if $oldAutoCommit;
 162       return $error;
 163     }
 164     $self->listnum($mailinglist->listnum);
 165   #}
 166
 167   $error = $self->SUPER::insert(@_);
 168   if ( $error ) {
 169     $dbh->rollback if $oldAutoCommit;
 170     return $error;
 171   }
 172
 173   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 174   '';
 175 }
 176
 177 =item delete
 178
 179 Delete this record from the database.
 180
 181 =cut
 182
 183 sub delete {
 184   my $self = shift;
 185
 186   local $SIG{HUP} = 'IGNORE';
 187   local $SIG{INT} = 'IGNORE';
 188   local $SIG{QUIT} = 'IGNORE';
 189   local $SIG{TERM} = 'IGNORE';
 190   local $SIG{TSTP} = 'IGNORE';
 191   local $SIG{PIPE} = 'IGNORE';
 192
 193   my $oldAutoCommit = $FS::UID::AutoCommit;
 194   local $FS::UID::AutoCommit = 0;
 195   my $dbh = dbh;
 196
 197   my $error = $self->mailinglist->delete || $self->SUPER::delete;
 198   if ( $error ) {
 199     $dbh->rollback if $oldAutoCommit;
 200     return $error;
 201   }
 202
 203   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 204   '';
 205
 206 }
 207
 208 =item replace OLD_RECORD
 209
 210 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 211 returns the error, otherwise returns false.
 212
 213 =cut
 214
 215 sub replace {
 216   my $new = shift;
 217
 218   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 219               ? shift
 220               : $new->replace_old;
 221
 222   return "can't change listnum" if $old->listnum != $new->listnum; #?
 223
 224   my %options = @_;
 225
 226   local $SIG{HUP} = 'IGNORE';
 227   local $SIG{INT} = 'IGNORE';
 228   local $SIG{QUIT} = 'IGNORE';
 229   local $SIG{TERM} = 'IGNORE';
 230   local $SIG{TSTP} = 'IGNORE';
 231   local $SIG{PIPE} = 'IGNORE';
 232
 233   my $oldAutoCommit = $FS::UID::AutoCommit;
 234   local $FS::UID::AutoCommit = 0;
 235   my $dbh = dbh;
 236
 237   if ( $new->get('listname') && $new->get('listname') ne $old->listname ) {
 238     my $mailinglist = $old->mailinglist;
 239     $mailinglist->listname($new->get('listname'));
 240     my $error = $mailinglist->replace;
 241     if ( $error ) {
 242       $dbh->rollback if $oldAutoCommit;
 243       return $error if $error;
 244     }
 245   }
 246
 247   my $error = $new->SUPER::replace($old, %options);
 248   if ( $error ) {
 249     $dbh->rollback if $oldAutoCommit;
 250     return $error if $error;
 251   }
 252
 253   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 254   ''; #no error
 255
 256
 257 }
 258
 259 =item check
 260
 261 Checks all fields to make sure this is a valid record.  If there is
 262 an error, returns the error, otherwise returns false.  Called by the insert
 263 and replace methods.
 264
 265 =cut
 266
 267 # the check method should currently be supplied - FS::Record contains some
 268 # data checking routines
 269
 270 sub check {
 271   my $self = shift;
 272
 273   my $error =
 274     $self->ut_numbern('svcnum')
 275     || $self->ut_text('username')
 276     || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum')
 277     #|| $self->ut_foreign_key('listnum', 'mailinglist', 'listnum')
 278     || $self->ut_foreign_keyn('listnum', 'mailinglist', 'listnum')
 279     || $self->ut_enum('reply_to_group', [ '', 'Y' ] )
 280     || $self->ut_enum('remove_author', [ '', 'Y' ] )
 281     || $self->ut_enum('reject_auto', [ '', 'Y' ] )
 282     || $self->ut_enum('remove_to_and_cc', [ '', 'Y' ] )
 283   ;
 284   return $error if $error;
 285
 286   return "Can't remove listnum" if $self->svcnum && ! $self->listnum;
 287
 288   $self->SUPER::check;
 289 }
 290
 291 =item mailinglist
 292
 293 =cut
 294
 295 sub mailinglist {
 296   my $self = shift;
 297   qsearchs('mailinglist', { 'listnum' => $self->listnum } );
 298 }
 299
 300 =item listname
 301
 302 =cut
 303
 304 sub listname {
 305   my $self = shift;
 306   my $mailinglist = $self->mailinglist;
 307   $mailinglist ? $mailinglist->listname : '';
 308 }
 309
 310 =item label
 311
 312 =cut
 313
 314 sub label {
 315   my $self = shift;
 316   $self->listname. ' <'. $self->username. '@'. $self->domain. '>';
 317 }
 318
 319 =back
 320
 321 =head1 BUGS
 322
 323 =head1 SEE ALSO
 324
 325 L<FS::Record>, schema.html from the base documentation.
 326
 327 =cut
 328
 329 1;
 330