diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/CGI.pm | 18 | ||||
| -rw-r--r-- | FS/FS/Cron/send_subscribed.pm | 32 | ||||
| -rw-r--r-- | FS/FS/Mason.pm | 1 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 22 | ||||
| -rw-r--r-- | FS/FS/access_user.pm | 7 | ||||
| -rw-r--r-- | FS/FS/cdr/callplus.pm | 60 | ||||
| -rw-r--r-- | FS/FS/log_context.pm | 2 | ||||
| -rw-r--r-- | FS/FS/saved_search.pm | 331 | ||||
| -rw-r--r-- | FS/MANIFEST | 2 | ||||
| -rwxr-xr-x | FS/bin/freeside-daily | 4 | ||||
| -rw-r--r-- | FS/t/saved_search.t | 5 |
11 files changed, 473 insertions, 11 deletions
diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index e1645f04c..8be823a4c 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -78,21 +78,17 @@ Sets an http header. sub http_header { my ( $header, $value ) = @_; - if (exists $ENV{MOD_PERL}) { - if ( defined $HTML::Mason::Commands::r ) { #Mason - ## is this the correct pacakge for $r ??? for 1.0x and 1.1x ? - if ( $header =~ /^Content-Type$/ ) { - $HTML::Mason::Commands::r->content_type($value); - } else { - $HTML::Mason::Commands::r->header_out( $header => $value ); - } + if ( defined $HTML::Mason::Commands::r ) { #Mason + apache + if ( $header =~ /^Content-Type$/ ) { + $HTML::Mason::Commands::r->content_type($value); } else { - die "http_header called in unknown environment"; + $HTML::Mason::Commands::r->header_out( $header => $value ); } + } elsif ( defined $HTML::Mason::Commands::m ) { + $HTML::Mason::Commands::m->notes(lc("header-$header"), $value); } else { - die "http_header called not running under mod_perl"; + warn "http_header($header, $value) called with no way to set headers\n"; } - } =item menubar ITEM, URL, ... diff --git a/FS/FS/Cron/send_subscribed.pm b/FS/FS/Cron/send_subscribed.pm new file mode 100644 index 000000000..2b1f662e6 --- /dev/null +++ b/FS/FS/Cron/send_subscribed.pm @@ -0,0 +1,32 @@ +package FS::Cron::send_subscribed; + +use strict; +use base 'Exporter'; +use FS::saved_search; +use FS::Record qw(qsearch); +use FS::queue; + +our @EXPORT_OK = qw( send_subscribed ); +our $DEBUG = 1; + +sub send_subscribed { + + my @subs = qsearch('saved_search', { + 'disabled' => '', + 'freq' => { op => '!=', value => '' }, + }); + foreach my $saved_search (@subs) { + my $date = $saved_search->next_send_date; + warn "checking '".$saved_search->searchname."' with date $date\n" + if $DEBUG; + + if ( $^T > $saved_search->next_send_date ) { + warn "queueing delivery\n"; + my $job = FS::queue->new({ job => 'FS::saved_search::queueable_send' }); + $job->insert( $saved_search->searchnum ); + } + } + +} + +1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 6fc4bf09f..bdae3938c 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -393,6 +393,7 @@ if ( -e $addl_handler_use_file ) { use FS::olt_site; use FS::access_user_page_pref; use FS::part_svc_msgcat; + use FS::saved_search; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index b7ec7df19..57f347555 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -5220,6 +5220,28 @@ sub tables_hashref { ], }, + 'saved_search' => { + 'columns' => [ + 'searchnum', 'serial', '', '', '', '', + 'usernum', 'int', 'NULL', '', '', '', + 'searchname', 'varchar', '', $char_d, '', '', + 'path', 'varchar', '', $char_d, '', '', + 'params', 'text', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', + 'freq', 'varchar', 'NULL', 16, '', '', + 'last_sent', 'int', 'NULL', '', '', '', + 'format', 'varchar', 'NULL', 32, '', '', + ], + 'primary_key' => 'searchnum', + 'unique' => [], + 'index' => [], + 'foreign_keys' => [ + { columns => [ 'usernum' ], + table => 'access_user', + }, + ], + }, + # name type nullability length default local #'new_table' => { diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index d13549dcf..366ae7ee8 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -831,6 +831,13 @@ sub set_page_pref { return $error; } +#3.x + +sub saved_search { + my $self = shift; + qsearch('saved_search', { 'usernum' => $self->usernum }); +} + =back =head1 BUGS diff --git a/FS/FS/cdr/callplus.pm b/FS/FS/cdr/callplus.pm new file mode 100644 index 000000000..fa6c799ad --- /dev/null +++ b/FS/FS/cdr/callplus.pm @@ -0,0 +1,60 @@ +package FS::cdr::callplus; +use base qw( FS::cdr ); + +use strict; +use vars qw( %info ); +use FS::Record qw( qsearchs ); +use Time::Local 'timelocal'; + +# Date format in the Date/Time col: "13/07/2016 2:40:32 p.m." +# d/m/y H:M:S, leading zeroes stripped, 12-hour with "a.m." or "p.m.". +# There are also separate d/m/y and 24-hour time columns, but parsing +# those separately is hard (DST issues). + +%info = ( + 'name' => 'CallPlus', + 'weight' => 610, + 'header' => 1, + 'type' => 'csv', + 'import_fields' => [ + 'uniqueid', # ID + '', # Billing Group (charged_party?) + 'src', # Origin Number + 'dst', # Destination Number + '', # Description (seems to be dest caller id?) + '', # Status + '', # Terminated + '', # Date + '', # Time + sub { # Date/Time + # this format overlaps one of the existing parser cases, so give it + # its own special parser + my ($cdr, $value) = @_; + $value =~ m[^(\d{1,2})/(\d{1,2})/(\d{4}) (\d{1,2}):(\d{2}):(\d{2}) (a\.m\.|p\.m\.)$] + or die "unparseable date: $value"; + my ($day, $mon, $year, $hour, $min, $sec) = ( $1, $2, $3, $4, $5, $6 ); + $hour = $hour % 12; + if ($7 eq 'p.m.') { + $hour = 12; + } + $cdr->set('startdate', + timelocal($sec, $min, $hour, $day, $mon-1, $year) + ); + }, + sub { # Call Length (seconds) + my ($cdr, $value) = @_; + $cdr->set('duration', $value); + $cdr->set('billsec', $value); + }, + sub { # Call Cost (NZD) + my ($cdr,$value) = @_; + $value =~ s/^\$//; + $cdr->upstream_price($value); + }, + skip(4), # Smartcode, Smartcode Description, Type, SubType + ], +); + +sub skip { map {''} (1..$_[0]) } + +1; diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm index d7ea26b37..0d6220915 100644 --- a/FS/FS/log_context.pm +++ b/FS/FS/log_context.pm @@ -12,6 +12,8 @@ my @contexts = ( qw( FS::cust_main::Billing_Realtime::realtime_verify_bop FS::part_pkg FS::Misc::Geo::standardize_uscensus + FS::saved_search::send + FS::saved_search::render Cron::bill Cron::upload spool_upload diff --git a/FS/FS/saved_search.pm b/FS/FS/saved_search.pm new file mode 100644 index 000000000..ec090a9f1 --- /dev/null +++ b/FS/FS/saved_search.pm @@ -0,0 +1,331 @@ +package FS::saved_search; +use base qw( FS::Record ); + +use strict; +use FS::Record qw( qsearch qsearchs ); +use FS::Conf; +use FS::Log; +use FS::Misc qw(send_email); +use MIME::Entity; +use Class::Load 'load_class'; +use URI::Escape; +use DateTime; + +=head1 NAME + +FS::saved_search - Object methods for saved_search records + +=head1 SYNOPSIS + + use FS::saved_search; + + $record = new FS::saved_search \%hash; + $record = new FS::saved_search { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::saved_search object represents a search (a page in the backoffice +UI, typically under search/ or browse/) which a user has saved for future +use or periodic email delivery. + +FS::saved_search inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item searchnum + +primary key + +=item usernum + +usernum of the L<FS::access_user> that created the search. Currently, email +reports will only be sent to this user. + +=item searchname + +A descriptive name. + +=item path + +The path to the page within the Mason document space. + +=item params + +The query string for the search. + +=item disabled + +'Y' to hide the search from the user's Reports / Saved menu. + +=item freq + +A frequency for email delivery of this report: daily, weekly, or +monthly, or null to disable it. + +=item last_sent + +The timestamp of the last time this report was sent. + +=item format + +'html', 'xls', or 'csv'. Not all reports support all of these. + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new saved search. To add it to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub table { 'saved_search'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('searchnum') + || $self->ut_number('usernum') + #|| $self->ut_foreign_keyn('usernum', 'access_user', 'usernum') + || $self->ut_text('searchname') + || $self->ut_text('path') + || $self->ut_textn('params') # URL-escaped, so ut_textn + || $self->ut_flag('disabled') + || $self->ut_enum('freq', [ '', 'daily', 'weekly', 'monthly' ]) + || $self->ut_numbern('last_sent') + || $self->ut_enum('format', [ '', 'html', 'csv', 'xls' ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +sub replace_check { + my ($new, $old) = @_; + if ($new->usernum != $old->usernum) { + return "can't change owner of a saved search"; + } + ''; +} + +=item next_send_date + +Returns the next date this report should be sent next. If it's not set for +periodic email sending, returns undef. If it is set up but has never been +sent before, returns zero. + +=cut + +sub next_send_date { + my $self = shift; + my $freq = $self->freq or return undef; + return 0 unless $self->last_sent; + my $dt = DateTime->from_epoch(epoch => $self->last_sent); + $dt->truncate(to => 'day'); + if ($freq eq 'daily') { + $dt->add(days => 1); + } elsif ($freq eq 'weekly') { + $dt->add(weeks => 1); + } elsif ($freq eq 'monthly') { + $dt->add(months => 1); + } + $dt->epoch; +} + +=item query_string + +Returns the CGI query string for the parameters to this report. + +=cut + +sub query_string { + my $self = shift; + + my $type = $self->format; + $type = 'html-print' if $type eq '' || $type eq 'html'; + $type = '.xls' if $type eq 'xls'; + my $query = "_type=$type"; + $query .= ';' . $self->params if $self->params; + $query; +} + +=item render + +Returns the report content as an HTML or Excel file. + +=cut + +sub render { + my $self = shift; + my $log = FS::Log->new('FS::saved_search::render'); + my $outbuf; + + # delayed loading + load_class('FS::Mason'); + RT::LoadConfig(); + RT::Init(); + + # do this before setting QUERY_STRING/FSURL + my ($fs_interp) = FS::Mason::mason_interps('standalone', + outbuf => \$outbuf + ); + $fs_interp->error_mode('fatal'); + $fs_interp->error_format('text'); + + local $FS::CurrentUser::CurrentUser = $self->access_user; + local $FS::Mason::Request::QUERY_STRING = $self->query_string; + local $FS::Mason::Request::FSURL = $self->access_user->option('rooturl'); + + my $mason_request = $fs_interp->make_request(comp => '/' . $self->path); + $mason_request->notes('inline_stylesheet', 1); + + local $@; + eval { $mason_request->exec(); }; + if ($@) { + my $error = $@; + if ( ref($error) eq 'HTML::Mason::Exception' ) { + $error = $error->message; + } + + $log->error("Error rendering " . $self->path . + " for " . $self->access_user->username . + ":\n$error\n"); + # send it to the user anyway, so there's a way to diagnose the error + $outbuf = '<h3>Error</h3> + <p>There was an error generating the report "'.$self->searchname.'".</p> + <p>' . $self->path . '?' . $self->query_string . '</p> + <p>' . $_ . '</p>'; + } + + my %mime = ( + Data => $outbuf, + Type => $mason_request->notes('header-content-type') + || 'text/html', + Disposition => 'inline', + ); + if (my $disp = $mason_request->notes('header-content-disposition') ) { + $disp =~ /^(attachment|inline)\s*;\s*filename=(.*)$/; + $mime{Disposition} = $1; + my $filename = $2; + $filename =~ s/^"(.*)"$/$1/; + $mime{Filename} = $filename; + } + if ($mime{Type} =~ /^text/) { + $mime{Encoding} = 'quoted-printable'; + } else { + $mime{Encoding} = 'base64'; + } + return MIME::Entity->build(%mime); +} + +=item send + +Sends the search by email. If anything fails, logs and returns an error. + +=cut + +sub send { + my $self = shift; + my $log = FS::Log->new('FS::saved_search::send'); + my $conf = FS::Conf->new; + my $user = $self->access_user; + my $username = $user->username; + my $user_email = $user->option('email_address'); + my $error; + if (!$user_email) { + $error = "User '$username' has no email address."; + $log->error($error); + return $error; + } + $log->debug('Rendering saved search'); + my $part = $self->render; + + my %email_param = ( + 'from' => $conf->config('invoice_from'), + 'to' => $user_email, + 'subject' => $self->searchname, + 'nobody' => 1, + 'mimeparts' => [ $part ], + ); + + $log->debug('Sending to '.$user_email); + $error = send_email(%email_param); + + # update the timestamp + $self->set('last_sent', time); + $error ||= $self->replace; + if ($error) { + $log->error($error); + return $error; + } + +} + +sub queueable_send { + my $searchnum = shift; + my $self = FS::saved_search->by_key($searchnum) + or die "searchnum $searchnum not found\n"; + $self->send; +} + +#3.x +sub access_user { + my $self = shift; + qsearchs('access_user', { 'usernum' => $self->usernum }); +} + +=back + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index c060c140c..93835936a 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -810,3 +810,5 @@ FS/webservice_log.pm t/webservice_log.t FS/access_user_page_pref.pm t/access_user_page_pref.t +FS/saved_search.pm +t/saved_search.t diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 1162e7911..4d432ef06 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -74,6 +74,10 @@ export_batch_submit(%opt); use FS::Cron::agent_email qw(agent_email); agent_email(%opt); +#does nothing unless there are users with subscribed searches +use FS::Cron::send_subscribed qw(send_subscribed); +send_subscribed(%opt); + #clears out cacti imports & deletes select database cache files use FS::Cron::cleanup qw( cleanup cleanup_before_backup ); cleanup_before_backup(); diff --git a/FS/t/saved_search.t b/FS/t/saved_search.t new file mode 100644 index 000000000..8155c6d76 --- /dev/null +++ b/FS/t/saved_search.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::saved_search; +$loaded=1; +print "ok 1\n"; |