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 FS::Record qw( qsearchs dbh ); # qsearch );
   6 use FS::svc_domain;
   7 use FS::mailinglist;
   8
   9 =head1 NAME
  10
  11 FS::svc_mailinglist - Object methods for svc_mailinglist records
  12
  13 =head1 SYNOPSIS
  14
  15   use FS::svc_mailinglist;
  16
  17   $record = new FS::svc_mailinglist \%hash;
  18   $record = new FS::svc_mailinglist { 'column' => 'value' };
  19
  20   $error = $record->insert;
  21
  22   $error = $new_record->replace($old_record);
  23
  24   $error = $record->delete;
  25
  26   $error = $record->check;
  27
  28 =head1 DESCRIPTION
  29
  30 An FS::svc_mailinglist object represents a mailing list customer service.
  31 FS::svc_mailinglist inherits from FS::Record.  The following fields are
  32 currently supported:
  33
  34 =over 4
  35
  36 =item svcnum
  37
  38 primary key
  39
  40 =item username
  41
  42 username
  43
  44 =item domsvc
  45
  46 domsvc
  47
  48 =item listnum
  49
  50 listnum
  51
  52 =item reply_to_group
  53
  54 reply_to_group
  55
  56 =item remove_author
  57
  58 remove_author
  59
  60 =item reject_auto
  61
  62 reject_auto
  63
  64 =item remove_to_and_cc
  65
  66 remove_to_and_cc
  67
  68 =back
  69
  70 =head1 METHODS
  71
  72 =over 4
  73
  74 =item new HASHREF
  75
  76 Creates a new record.  To add the record to the database, see L<"insert">.
  77
  78 Note that this stores the hash reference, not a distinct copy of the hash it
  79 points to.  You can ask the object for a copy with the I<hash> method.
  80
  81 =cut
  82
  83 # the new method can be inherited from FS::Record, if a table method is defined
  84
  85 sub table { 'svc_mailinglist'; }
  86
  87 sub table_info {
  88   {
  89     'name' => 'Mailing list',
  90     'display_weight' => 80,
  91     'cancel_weight'  => 55,
  92     'fields' => {
  93       'username' => { 'label' => 'List address',
  94                       'disable_default'   => 1,
  95                       'disable_fixed'     => 1,
  96                       'disable_inventory' => 1,
  97                     },
  98       'domsvc' => { 'label' => 'List address domain',
  99                     'disable_inventory' => 1,
 100                     },
 101       'domain' => 'List address domain',
 102       'listnum' => { 'label' => 'List name',
 103                      'disable_inventory' => 1,
 104                    },
 105       'listname' => 'List name', #actually mailinglist.listname
 106       'reply_to' => { 'label' => 'Reply-To list',
 107                       'type'  => 'checkbox',
 108                       'disable_inventory' => 1,
 109                       'disable_select'    => 1,
 110                     },
 111       'remove_from' => { 'label' => 'Remove From: from messages',
 112                           'type'  => 'checkbox',
 113                           'disable_inventory' => 1,
 114                           'disable_select'    => 1,
 115                         },
 116       'reject_auto' => { 'label' => 'Reject automatic messages',
 117                          'type'  => 'checkbox',
 118                          'disable_inventory' => 1,
 119                          'disable_select'    => 1,
 120                        },
 121       'remove_to_and_cc' => { 'label' => 'Remove To: and Cc: from messages',
 122                               'type'  => 'checkbox',
 123                               'disable_inventory' => 1,
 124                               'disable_select'    => 1,
 125                             },
 126     },
 127   };
 128 }
 129
 130 =item insert
 131
 132 Adds this record to the database.  If there is an error, returns the error,
 133 otherwise returns false.
 134
 135 =cut
 136
 137 sub insert {
 138   my $self = shift;
 139
 140   local $SIG{HUP} = 'IGNORE';
 141   local $SIG{INT} = 'IGNORE';
 142   local $SIG{QUIT} = 'IGNORE';
 143   local $SIG{TERM} = 'IGNORE';
 144   local $SIG{TSTP} = 'IGNORE';
 145   local $SIG{PIPE} = 'IGNORE';
 146
 147   my $oldAutoCommit = $FS::UID::AutoCommit;
 148   local $FS::UID::AutoCommit = 0;
 149   my $dbh = dbh;
 150
 151   my $error;
 152
 153   #attach to existing lists?  sound scary
 154   #unless ( $self->listnum ) {
 155     my $mailinglist = new FS::mailinglist {
 156       'listname' => $self->get('listname'),
 157     };
 158     $error = $mailinglist->insert;
 159     if ( $error ) {
 160       $dbh->rollback if $oldAutoCommit;
 161       return $error;
 162     }
 163     warn $mailinglist->listnum;
 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