FS/FS/cust_msg.pm

   1 package FS::cust_msg;
   2 use base qw( FS::cust_main_Mixin FS::Record );
   3
   4 use strict;
   5 use FS::Record qw( dbh );
   6 use MIME::Parser;
   7
   8 =head1 NAME
   9
  10 FS::cust_msg - Object methods for cust_msg records
  11
  12 =head1 SYNOPSIS
  13
  14   use FS::cust_msg;
  15
  16   $record = new FS::cust_msg \%hash;
  17   $record = new FS::cust_msg { 'column' => 'value' };
  18
  19   $error = $record->insert;
  20
  21   $error = $record->check;
  22
  23 =head1 DESCRIPTION
  24
  25 An FS::cust_msg object represents an email message generated by Freeside.
  26 FS::cust_msg inherits from FS::Record.  The following fields are currently
  27 supported:
  28
  29 =over 4
  30
  31 =item custmsgnum - primary key
  32
  33 =item custnum - customer number
  34
  35 =item msgnum - template number
  36
  37 =item msgtype - the message type
  38
  39 =item _date - the time the message was sent
  40
  41 =item env_from - envelope From address
  42
  43 =item env_to - envelope To addresses, including Bcc, separated by newlines
  44
  45 =item header - message header
  46
  47 =item body - message body (as a complete MIME document)
  48
  49 =item preview - HTML fragment to show as a preview of the message
  50
  51 =item error - Email::Sender error message (or null for success)
  52
  53 =item status - "prepared", "sent", or "failed"
  54
  55 =back
  56
  57 =head1 METHODS
  58
  59 =over 4
  60
  61 =item new HASHREF
  62
  63 Creates a new
  64
  65 =cut
  66
  67 # the new method can be inherited from FS::Record, if a table method is defined
  68
  69 sub table { 'cust_msg'; }
  70
  71 sub nohistory_fields { ('header', 'body'); }
  72 # history is kind of pointless on this table
  73
  74 our @statuses = qw( prepared sent failed );
  75
  76 =item insert
  77
  78 Adds this record to the database.  If there is an error, returns the error
  79 and emits a warning; otherwise returns false.
  80
  81 =cut
  82
  83 sub insert {
  84   # warn of all errors here; failing to insert/update one of these should
  85   # cause a warning at worst
  86   my $self = shift;
  87   my $error = $self->SUPER::insert;
  88   warn "[cust_msg] error logging message status: $error\n" if $error;
  89   return $error;
  90 }
  91
  92 =item delete
  93
  94 Delete this record from the database.  There's no reason to do this.
  95
  96 =cut
  97
  98 sub delete {
  99   my $self = shift;
 100   warn "[cust_msg] log entry deleted\n";
 101   return $self->SUPER::delete;
 102 }
 103
 104 =item replace OLD_RECORD
 105
 106 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 107 returns the error and emits a warning, otherwise returns false.
 108
 109 =cut
 110
 111 sub replace {
 112   my $self = shift;
 113   my $error = $self->SUPER::replace(@_);
 114   warn "[cust_msg] error logging message status: $error\n" if $error;
 115   return $error;
 116 }
 117
 118 =item check
 119
 120 Checks all fields to make sure this is a valid example.  If there is
 121 an error, returns the error, otherwise returns false.  Called by the insert
 122 and replace methods.
 123
 124 =cut
 125
 126 # the check method should currently be supplied - FS::Record contains some
 127 # data checking routines
 128
 129 sub check {
 130   my $self = shift;
 131
 132   my $error =
 133     $self->ut_numbern('custmsgnum')
 134     || $self->ut_numbern('custnum')
 135     || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
 136     || $self->ut_numbern('msgnum')
 137     || $self->ut_foreign_keyn('msgnum', 'msg_template', 'msgnum')
 138     || $self->ut_numbern('_date')
 139     || $self->ut_textn('env_from')
 140     || $self->ut_textn('env_to')
 141     || $self->ut_anything('header')
 142     || $self->ut_anything('body')
 143     || $self->ut_anything('preview')
 144     || $self->ut_enum('status', \@statuses)
 145     || $self->ut_textn('error')
 146     || $self->ut_enum('msgtype', [  '',
 147                                     'invoice',
 148                                     'receipt',
 149                                     'admin',
 150                                     'report',
 151                                  ])
 152   ;
 153   return $error if $error;
 154
 155   $self->SUPER::check;
 156 }
 157
 158 =item send
 159
 160 Sends the message through its parent L<FS::msg_template>. Returns an error
 161 message on error, or an empty string.
 162
 163 =cut
 164
 165 sub send {
 166   my $self = shift;
 167   # it's still allowed to have cust_msgs without message templates, but only
 168   # for email.
 169   my $msg_template = $self->msg_template || 'FS::msg_template::email';
 170   $msg_template->send_prepared($self);
 171 }
 172
 173 =item entity
 174
 175 Returns the complete message as a L<MIME::Entity>.
 176
 177 XXX this only works if the message in fact contains a MIME entity. Messages
 178 created by external APIs may not look like that.
 179
 180 =item parts
 181
 182 Returns a list of the MIME parts contained in the message, as L<MIME::Entity>
 183 objects.
 184
 185 =cut
 186
 187 sub entity {
 188   my $self = shift;
 189   if ( !exists($self->{entity}) ) {
 190     my $parser = MIME::Parser->new;
 191     my $output_dir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/mimeparts";
 192     mkdir($output_dir) unless -d $output_dir;
 193     $parser->output_under($output_dir);
 194     $self->{entity} =
 195       $parser->parse_data( $self->header . "\n" . $self->body );
 196   }
 197   $self->{entity};
 198 }
 199
 200 sub parts {
 201   my $self = shift;
 202   # return only the parts with bodies, not the multipart containers
 203   grep { $_->bodyhandle } $self->entity->parts_DFS;
 204 }
 205
 206 =back
 207
 208 =head1 SUBROUTINES
 209
 210 =over 4
 211
 212 =item process_send CUSTMSGNUM
 213
 214 Given a C<cust_msg.custmsgnum> value, sends the message. It must already
 215 have been prepared (via L<FS::msg_template/prepare>).
 216
 217 =cut
 218
 219 sub process_send {
 220   my $custmsgnum = shift;
 221   my $cust_msg = FS::cust_msg->by_key($custmsgnum)
 222     or die "cust_msg #$custmsgnum not found";
 223   my $error = $cust_msg->send;
 224   die $error if $error;
 225 }
 226
 227 sub _upgrade_schema {
 228   my ($class, %opts) = @_;
 229
 230   my $sql = '
 231     DELETE FROM cust_msg WHERE NOT EXISTS
 232       ( SELECT 1 FROM cust_main WHERE cust_main.custnum = cust_msg.custnum )
 233   ';
 234
 235   my $sth = dbh->prepare($sql) or die dbh->errstr;
 236   $sth->execute or die $sth->errstr;
 237   '';
 238
 239 }
 240
 241 =back
 242
 243 =head1 SEE ALSO
 244
 245 L<FS::msg_template>, L<FS::cust_main>, L<FS::Record>.
 246
 247 =cut
 248
 249 1;
 250