FS/FS/report_batch.pm

   1 package FS::report_batch;
   2 use base qw( FS::Record );
   3
   4 use strict;
   5 use FS::Record qw( qsearch qsearchs dbdef );
   6 use FS::msg_template;
   7 use FS::cust_main;
   8 use FS::Misc::DateTime qw(parse_datetime);
   9 use FS::Mason qw(mason_interps);
  10 use URI::Escape;
  11 use HTML::Defang;
  12 # 3.x only
  13 use FS::queue;
  14 use FS::Misc qw(send_email generate_email);
  15 use Storable qw(thaw);
  16 use MIME::Base64 qw(decode_base64);
  17
  18 our $DEBUG = 0;
  19
  20 =head1 NAME
  21
  22 FS::report_batch - Object methods for report_batch records
  23
  24 =head1 SYNOPSIS
  25
  26   use FS::report_batch;
  27
  28   $record = new FS::report_batch \%hash;
  29   $record = new FS::report_batch { 'column' => 'value' };
  30
  31   $error = $record->insert;
  32
  33   $error = $new_record->replace($old_record);
  34
  35   $error = $record->delete;
  36
  37   $error = $record->check;
  38
  39 =head1 DESCRIPTION
  40
  41 An FS::report_batch object represents an order to send a batch of reports to
  42 their respective customers or other contacts.  FS::report_batch inherits from
  43 FS::Record.  The following fields are currently supported:
  44
  45 =over 4
  46
  47 =item reportbatchnum
  48
  49 primary key
  50
  51 =item reportname
  52
  53 The name of the report, which will be the same as the file name (minus any
  54 directory names). There's an enumerated set of these; you can't use just any
  55 report.
  56
  57 =item send_date
  58
  59 The date the report was sent.
  60
  61 =item agentnum
  62
  63 The agentnum to limit the report to, if any.
  64
  65 =item sdate
  66
  67 The start date of the report period.
  68
  69 =item edate
  70
  71 The end date of the report period.
  72
  73 =item usernum
  74
  75 The user who ordered the report.
  76
  77 =back
  78
  79 =head1 METHODS
  80
  81 =over 4
  82
  83 =item new HASHREF
  84
  85 Creates a new report batch.  To add the record to the database, see L<"insert">.
  86
  87 =cut
  88
  89 sub table { 'report_batch'; }
  90
  91 =item insert
  92
  93 Adds this record to the database.  If there is an error, returns the error,
  94 otherwise returns false.
  95
  96 =item delete
  97
  98 Deletes this record from the database.
  99
 100 =item replace OLD_RECORD
 101
 102 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 103 returns the error, otherwise returns false.
 104
 105 =item check
 106
 107 Checks all fields to make sure this is a valid record.  If there is
 108 an error, returns the error, otherwise returns false.  Called by the insert
 109 and replace methods.
 110
 111 =cut
 112
 113 sub check {
 114   my $self = shift;
 115
 116   my $error =
 117     $self->ut_numbern('reportbatchnum')
 118     || $self->ut_text('reportname')
 119     || $self->ut_numbern('agentnum')
 120     || $self->ut_numbern('sdate')
 121     || $self->ut_numbern('edate')
 122     || $self->ut_numbern('usernum')
 123   ;
 124   return $error if $error;
 125
 126   $self->set('send_date', time);
 127
 128   $self->SUPER::check;
 129 }
 130
 131 =back
 132
 133 =head1 SUBROUTINES
 134
 135 =over 4
 136
 137 =item process_send_report JOB, PARAMS
 138
 139 Takes a hash of PARAMS, determines all contacts who need to receive a report,
 140 and sends it to them. On completion, creates and stores a report_batch record.
 141 JOB is a queue job to receive status messages.
 142
 143 PARAMS can include:
 144
 145 - reportname: the name of the report (listed in the C<%sendable_reports> hash).
 146 Required.
 147 - msgnum: the L<FS::msg_template> to use for this report. Currently the
 148 content of the template is ignored, but the subject line and From/Bcc addresses
 149 are still used. Required.
 150 - agentnum: the agent to limit the report to.
 151 - beginning, ending: the date range to run the report, as human-readable
 152 dates (I<not> unix timestamps).
 153
 154 =cut
 155
 156 # trying to keep this data-driven, with parameters that tell how the report is
 157 # to be handled rather than callbacks.
 158 # - path: where under the document root the report is located
 159 # - domain: which table to query for objects on which the report is run.
 160 #   Each record in that table produces one report.
 161 # - cust_main: the method on that object that returns its linked customer (to
 162 #   which the report will be sent). If the table has a 'custnum' field, this
 163 #   can be omitted.
 164 our %sendable_reports = (
 165   'sales_commission_pkg' => {
 166     'name'      => 'Sales commission per package',
 167     'path'      => '/search/sales_commission_pkg.html',
 168     'domain'    => 'sales',
 169     'cust_main' => 'sales_cust_main',
 170   },
 171 );
 172
 173 sub process_send_report {
 174   my $job = shift;
 175   my $param = shift;
 176   $param = thaw(decode_base64($param)) unless ref($param);
 177
 178   my $msgnum = $param->{'msgnum'};
 179   my $template = FS::msg_template->by_key($msgnum)
 180     or die "msg_template $msgnum not found\n";
 181
 182   my $reportname = $param->{'reportname'};
 183   my $info = $sendable_reports{$reportname}
 184     or die "don't know how to send report '$reportname'\n";
 185
 186   # the most important thing: which report is it?
 187   my $path = $info->{'path'};
 188
 189   # find all targets for the report:
 190   # - those matching the agentnum if there is one.
 191   # - those that aren't disabled.
 192   my $domain = $info->{domain};
 193   my $dbt = dbdef->table($domain);
 194   my $hashref = {};
 195   if ( $param->{'agentnum'} and $dbt->column('agentnum') ) {
 196     $hashref->{'agentnum'} = $param->{'agentnum'};
 197   }
 198   if ( $dbt->column('disabled') ) {
 199     $hashref->{'disabled'} = '';
 200   }
 201   my @records = qsearch($domain, $hashref);
 202   my $num_targets = scalar(@records);
 203   return if $num_targets == 0;
 204   my $sent = 0;
 205
 206   my $outbuf;
 207   my ($fs_interp) = mason_interps('standalone', 'outbuf' => \$outbuf);
 208   # if generating the report fails, we want to capture the error and exit,
 209   # not send it.
 210   $fs_interp->error_mode('fatal');
 211   $fs_interp->error_format('brief');
 212
 213   # we have to at least have an RT::Handle
 214   require RT;
 215   RT::LoadConfig();
 216   RT::Init();
 217
 218   # hold onto all the reports until we're sure they generated correctly.
 219   my %cust_main;
 220   my %report_content;
 221
 222   # grab the stylesheet
 223   ### note: if we need the ability to support different stylesheets, this
 224   ### is the place to put it in
 225   eval { $fs_interp->exec('/elements/freeside.css') };
 226   die "couldn't load stylesheet via Mason: $@\n" if $@;
 227   my $stylesheet = $outbuf;
 228
 229   my $pkey = $dbt->primary_key;
 230   foreach my $rec (@records) {
 231
 232     $job->update_statustext(int( 100 * $sent / $num_targets ));
 233     my $pkey_val = $rec->get($pkey); # e.g. sales.salesnum
 234
 235     # find the customer we're sending to, and their email
 236     my $cust_main;
 237     if ( $info->{'cust_main'} ) {
 238       my $cust_method = $info->{'cust_main'};
 239       $cust_main = $rec->$cust_method;
 240     } elsif ( $rec->custnum ) {
 241       $cust_main = FS::cust_main->by_key($rec->custnum);
 242     } else {
 243       warn "$pkey = $pkey_val has no custnum; not sending report\n";
 244       next;
 245     }
 246     my @email = $cust_main->invoicing_list_emailonly;
 247     if (!@email) {
 248       warn "$pkey = $pkey_val has no email destinations\n" if $DEBUG;
 249       next;
 250     }
 251
 252     # params to send to the report (as if from the user's browser)
 253     my @report_param = ( # maybe list these in $info
 254       agentnum  => $param->{'agentnum'},
 255       beginning => $param->{'beginning'},
 256       ending    => $param->{'ending'},
 257       $pkey     => $pkey_val,
 258       _type     => 'html-print',
 259     );
 260
 261     # build a query string
 262     my $query_string = '';
 263     while (@report_param) {
 264       $query_string .= uri_escape(shift @report_param)
 265                     .  '='
 266                     .  uri_escape(shift @report_param);
 267       $query_string .= ';' if @report_param;
 268     }
 269     warn "$path?$query_string\n\n" if $DEBUG;
 270
 271     # run the report!
 272     $FS::Mason::Request::QUERY_STRING = $query_string;
 273     $FS::Mason::Request::FSURL = '';
 274     $outbuf = '';
 275     eval { $fs_interp->exec($path) };
 276     die "creating report for $pkey = $pkey_val: $@" if $@;
 277
 278     # make some adjustments to the report
 279     my $html_defang;
 280     $html_defang = HTML::Defang->new(
 281       url_callback      => sub { 1 }, # strip all URLs (they're not accessible)
 282       tags_to_callback  => [ 'body' ], # and after the BODY tag...
 283       tags_callback     => sub {
 284         my $isEndTag = $_[4];
 285         $html_defang->add_to_output("\n<style>\n$stylesheet\n</style>\n")
 286           unless $isEndTag;
 287       },
 288     );
 289     $outbuf = $html_defang->defang($outbuf);
 290
 291     $cust_main{ $cust_main->custnum } = $cust_main;
 292     $report_content{ $cust_main->custnum } = $outbuf;
 293   } # foreach $rec
 294
 295   $job->update_statustext('Sending reports...');
 296   foreach my $custnum (keys %cust_main) {
 297     # create an email message with the report as body
 298     # change this when backporting to 3.x
 299     my %message = $template->prepare(
 300       cust_main         => $cust_main{$custnum},
 301       object            => $cust_main{$custnum},
 302       msgtype           => 'report',
 303     );
 304     $message{'html_body'} = $report_content{$custnum};
 305     my $error = send_email(generate_email(%message));
 306     if ( $error ) {
 307       my $queue = FS::queue->new({
 308           job         => 'FS::Misc::process_send_email',
 309           custnum     => $custnum,
 310           status      => 'failed',
 311           statustext  => $error,
 312       });
 313       $queue->insert(%message);
 314     }
 315   }
 316
 317   my $self = FS::report_batch->new({
 318     reportname  => $param->{'reportname'},
 319     agentnum    => $param->{'agentnum'},
 320     sdate       => parse_datetime($param->{'beginning'}),
 321     edate       => parse_datetime($param->{'ending'}),
 322     usernum     => $job->usernum,
 323     msgnum      => $param->{'msgnum'},
 324   });
 325   my $error = $self->insert;
 326   warn "error recording completion of report: $error\n" if $error;
 327
 328 }
 329
 330 # 3.x stub
 331 sub agent {
 332   my $self = shift;
 333   qsearchs('agent', { agentnum => $self->agentnum });
 334 }
 335
 336 sub access_user {
 337   my $self = shift;
 338   qsearchs('access_user', { usernum => $self->usernum });
 339 }
 340
 341 sub msg_template {
 342   my $self = shift;
 343   qsearchs('msg_template', { msgnum => $self->msgnum });
 344 }
 345
 346 =head1 SEE ALSO
 347
 348 L<FS::Record>
 349
 350 =cut
 351
 352 1;
 353