From eccc8de2366e2e004a37761b8da2b447ec861ecb Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Sat, 27 Oct 2012 14:24:00 -0700 Subject: [PATCH] ICS invoice spool format and email delivery, #17620 --- FS/FS/Conf.pm | 8 + FS/FS/Cron/upload.pm | 153 ++++++++++---- FS/FS/Mason.pm | 2 +- FS/FS/Misc/Invoicing.pm | 2 +- FS/FS/Schema.pm | 11 +- FS/FS/cust_bill.pm | 144 +++++++++++-- FS/FS/ftp_target.pm | 194 ----------------- FS/FS/part_event/Action/cust_bill_spool_csv.pm | 9 +- FS/FS/upload_target.pm | 282 +++++++++++++++++++++++++ FS/MANIFEST | 4 +- FS/t/{ftp_target.t => upload_target.t} | 2 +- httemplate/browse/ftp_target.html | 56 ----- httemplate/browse/upload_target.html | 49 +++++ httemplate/edit/ftp_target.html | 46 ---- httemplate/edit/process/ftp_target.html | 12 -- httemplate/edit/process/upload_target.html | 25 +++ httemplate/edit/upload_target.html | 82 +++++++ httemplate/elements/menu.html | 2 +- 18 files changed, 710 insertions(+), 373 deletions(-) delete mode 100644 FS/FS/ftp_target.pm create mode 100644 FS/FS/upload_target.pm rename FS/t/{ftp_target.t => upload_target.t} (81%) delete mode 100644 httemplate/browse/ftp_target.html create mode 100644 httemplate/browse/upload_target.html delete mode 100755 httemplate/edit/ftp_target.html delete mode 100644 httemplate/edit/process/ftp_target.html create mode 100644 httemplate/edit/process/upload_target.html create mode 100755 httemplate/edit/upload_target.html diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index d8fd54514..c9f30fe6e 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3220,6 +3220,14 @@ and customer address. Include units.', }, { + 'key' => 'ics-confirm_template', + 'section' => '', + 'description' => 'Confirmation email template for uploading to ICS invoice printing. Text::Template format, with variables "%count" and "%sum".', + 'type' => 'textarea', + 'per_agent' => 1, + }, + + { 'key' => 'svc_acct-usage_suspend', 'section' => 'billing', 'description' => 'Suspends the package an account belongs to when svc_acct.seconds or a bytecount is decremented to 0 or below (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm index 51e0d6868..a9094c0b0 100644 --- a/FS/FS/Cron/upload.pm +++ b/FS/FS/Cron/upload.pm @@ -10,12 +10,13 @@ use FS::Conf; use FS::queue; use FS::agent; use FS::Misc qw( send_email ); #for bridgestone -use FS::ftp_target; +use FS::upload_target; use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common; use HTTP::Response; use Net::FTP; +use List::Util qw( sum ); @ISA = qw( Exporter ); @EXPORT_OK = qw ( upload ); @@ -58,7 +59,7 @@ sub upload { my @agentnums = ('', map {$_->agentnum} @agents); - foreach my $target (qsearch('ftp_target', {})) { + foreach my $target (qsearch('upload_target', {})) { # We don't know here if it's spooled on a per-agent basis or not. # (It could even be both, via different events.) So queue up an # upload for each agent, plus one with null agentnum, and we'll @@ -241,7 +242,7 @@ sub spool_upload { else { #not billco my $targetnum = $opt{targetnum}; - my $ftp_target = FS::ftp_target->by_key($targetnum) + my $upload_target = FS::upload_target->by_key($targetnum) or die "FTP target $targetnum not found\n"; $dir .= "/target$targetnum"; @@ -316,49 +317,82 @@ sub spool_upload { warn "compressing to $zipfile\n$command\n" if $DEBUG; system($command) and die "$command failed\n"; - my $connection = $ftp_target->connect; # dies on error - $connection->put($zipfile); - - my $template = join("\n",$conf->config('bridgestone-confirm_template')); - if ( $template ) { - my $tmpl_obj = Text::Template->new( - TYPE => 'STRING', SOURCE => $template - ); - my $content = $tmpl_obj->fill_in( HASH => - { - zipfile => $zipfile, - prefix => $prefix, - seq => $seq, - rows => $rows, - } - ); - my ($head, $body) = split("\n\n", $content, 2); - $head =~ /^subject:\s*(.*)$/im; - my $subject = $1; - - $head =~ /^to:\s*(.*)$/im; - my $to = $1; - - send_email( - to => $to, - from => $conf->config('invoice_from', $agentnum), - subject => $subject, - body => $body, - ); - } else { #!$template - warn "$me agent $agentnum has no bridgestone-confirm_template, no email sent\n"; - } + my $error = $upload_target->put($zipfile); + die $error if $error; + + send_report('bridgestone-confirm_template', + { + agentnum=> $agentnum, + zipfile => $zipfile, + prefix => $prefix, + seq => $seq, + rows => $rows, + } + ); $seq++; warn "setting batch counter to $seq\n" if $DEBUG; $conf->set('bridgestone-batch_counter', $seq, $agentnum); - } else { # not bridgestone + } elsif ( $opt{'handling'} eq 'ics' ) { + + my ($basename, $regfile, $bigfile); + $basename = sprintf('c%sc1', time2str('%m%d', time)); + $regfile = $basename . 'i.txt'; # for "regular" (short) invoices + $bigfile = $basename . 'b.txt'; # for "big" invoices + + warn "copying spool to $regfile, $bigfile\n" if $DEBUG; + + my ($in, $reg, $big); #filehandles + my %count = (B => 0, 1 => 0, 2 => 0); # number of invoices + my %sum = (B => 0, R => 0); # total of charges field + open $in, '<', "$dir/$file-$date.csv" + or die "unable to read $file-$date.csv\n"; + + open $reg, '>', "$dir/$regfile" or die "unable to write $regfile\n"; + open $big, '>', "$dir/$bigfile" or die "unable to write $bigfile\n"; + + while (my $line = <$in>) { + chomp($line); + my $tag = substr($line, -1, 1, ''); + my $charge = substr($line, 252, 10); + if ( $tag eq 'B' ) { + print $big $line, "\n"; + $count{B}++; + $sum{B} += $charge; + } else { + print $reg $line, "\n"; + $count{$tag}++; + $sum{R} += $charge; + } + } + close $in; + close $reg; + close $big; + + my $zipfile = "$basename" . '.zip'; + my $command = "cd $dir; zip $zipfile $regfile $bigfile"; + system($command) and die "'$command' failed\n"; + $upload_target->put("$dir/$zipfile"); + + for (values %sum) { + $_ = sprintf('%.2f', $_); + } + + send_report('ics-confirm_template', + { + agentnum => $agentnum, + count => \%count, + sum => \%sum, + } + ); + + } else { # not bridgestone or ics # this is the usual case - my $connection = $ftp_target->connect; # dies on error - $connection->put("$file-$date.csv"); + my $error = $upload_target->put("$file-$date.csv"); + die $error if $error; } @@ -369,4 +403,47 @@ sub spool_upload { } +=item send_report CONFIG PARAMS + +Retrieves the config value named CONFIG, parses it as a Text::Template, +extracts "to" and "subject" headers, and sends it by email. + +PARAMS is a hashref to be passed to C. It must contain +'agentnum' to look up the per-agent config. + +=cut + +# we used it twice, so it's now a subroutine +sub send_report { + + my ($config, $params) = @_; + my $agentnum = $params->{agentnum}; + my $conf = FS::Conf->new; + + my $template = join("\n", $conf->config($config, $agentnum)); + if (!$template) { + warn "$me agent $agentnum has no $config, no email report sent\n"; + return; + } + + my $tmpl_obj = Text::Template->new( + TYPE => 'STRING', SOURCE => $template + ); + my $content = $tmpl_obj->fill_in( HASH => $params ); + my ($head, $body) = split("\n\n", $content, 2); + $head =~ /^subject:\s*(.*)$/im; + my $subject = $1; + + $head =~ /^to:\s*(.*)$/im; + my $to = $1; + + send_email( + to => $to, + from => $conf->config('invoice_from', $agentnum), + subject => $subject, + body => $body, + ); + +} + 1; diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 11af25efa..f7d98a156 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -312,7 +312,7 @@ if ( -e $addl_handler_use_file ) { use FS::access_groupsales; use FS::contact_class; use FS::part_svc_class; - use FS::ftp_target; + use FS::upload_target; use FS::quotation; use FS::quotation_pkg; use FS::quotation_pkg_discount; diff --git a/FS/FS/Misc/Invoicing.pm b/FS/FS/Misc/Invoicing.pm index 2fc52a99b..92138c2a7 100644 --- a/FS/FS/Misc/Invoicing.pm +++ b/FS/FS/Misc/Invoicing.pm @@ -19,7 +19,7 @@ Returns a list of the invoice spool formats. =cut sub spool_formats { - qw(default oneline billco bridgestone) + qw(default oneline billco bridgestone ics) } 1; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 4832dd2f6..01250e593 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -3948,16 +3948,17 @@ sub tables_hashref { 'index' => [ [ 'upgrade' ] ], }, - 'ftp_target' => { + 'upload_target' => { 'columns' => [ 'targetnum', 'serial', '', '', '', '', 'agentnum', 'int', 'NULL', '', '', '', + 'protocol', 'varchar', '', 10, '', '', 'hostname', 'varchar', '', $char_d, '', '', - 'port', 'int', '', '', '', '', + 'port', 'int', 'NULL', '', '', '', 'username', 'varchar', '', $char_d, '', '', - 'password', 'varchar', '', $char_d, '', '', - 'path', 'varchar', '', $char_d, '', '', - 'secure', 'char', 'NULL', 1, '', '', + 'password', 'varchar', 'NULL', $char_d, '', '', + 'path', 'varchar', 'NULL', $char_d, '', '', + 'subject', 'varchar', 'NULL', '255', '', '', 'handling', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'targetnum', diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index c48c80627..dad54348e 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -6,7 +6,7 @@ use vars qw( $DEBUG $me $date_format ); # but NOT $conf use Fcntl qw(:flock); #for spool_csv use Cwd; -use List::Util qw(min max); +use List::Util qw(min max sum); use Date::Format; use File::Temp 0.14; use HTML::Entities; @@ -1819,13 +1819,16 @@ L). =item agent_spools - if set to a true value, will spool to per-agent files rather than a single global file -=item ftp_targetnum - if set to an FTP target (see L), will +=item upload_targetnum - if set to a target (see L), will append to that spool. L will then send the spool file to that destination. =item balanceover - if set, only spools the invoice if the total amount owed on this invoice and all older invoices is greater than the specified amount. +=item time - the "current time". Controls the printing of past due messages +in the ICS format. + =back =cut @@ -1833,6 +1836,7 @@ this invoice and all older invoices is greater than the specified amount. sub spool_csv { my($self, %opt) = @_; + my $time = $opt{'time'} || time; my $cust_main = $self->cust_main; if ( $opt{'dest'} ) { @@ -1850,7 +1854,7 @@ sub spool_csv { my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/cust_bill"; mkdir $spooldir, 0700 unless -d $spooldir; - my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', time); + my $tracctnum = $self->invnum. time2str('-%Y%m%d%H%M%S', $time); my $file; if ( $opt{'agent_spools'} ) { @@ -1859,8 +1863,8 @@ sub spool_csv { $file = 'spool'; } - if ( $opt{'ftp_targetnum'} ) { - $spooldir .= '/target'.$opt{'ftp_targetnum'}; + if ( $opt{'upload_targetnum'} ) { + $spooldir .= '/target'.$opt{'upload_targetnum'}; mkdir $spooldir, 0700 unless -d $spooldir; } # otherwise it just goes into export.xxx/cust_bill @@ -1870,7 +1874,7 @@ sub spool_csv { $file = "$spooldir/$file.csv"; - my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum ); + my ( $header, $detail ) = $self->print_csv(%opt, 'tracctnum' => $tracctnum); open(CSV, ">>$file") or die "can't open $file: $!"; flock(CSV, LOCK_EX); @@ -1890,7 +1894,7 @@ sub spool_csv { seek(CSV, 0, 2); } - print CSV $detail; + print CSV $detail if defined($detail); flock(CSV, LOCK_UN); close CSV; @@ -2051,8 +2055,11 @@ sub print_csv { my $cust_main = $self->cust_main; my $csv = Text::CSV_XS->new({'always_quote'=>1}); + my $format = lc($opt{'format'}); - if ( lc($opt{'format'}) eq 'billco' ) { + my $time = $opt{'time'} || time; + + if ( $format eq 'billco' ) { my $taxtotal = 0; $taxtotal += $_->{'amount'} foreach $self->_items_tax; @@ -2105,7 +2112,7 @@ sub print_csv { '0', # 29 | Other Taxes & Fees*** NUM* 9 ); - } elsif ( lc($opt{'format'}) eq 'oneline' ) { #name? + } elsif ( $format eq 'oneline' ) { #name my ($previous_balance) = $self->previous; my $totaldue = sprintf('%.2f', $self->owed + $previous_balance); @@ -2136,10 +2143,10 @@ sub print_csv { @items, ); - } elsif ( lc($opt{'format'}) eq 'bridgestone' ) { + } elsif ( $format eq 'bridgestone' ) { # bypass the CSV stuff and just return this - my $longdate = time2str('%B %d, %Y', time); #current time, right? + my $longdate = time2str('%B %d, %Y', $time); #current time, right? my $zip = $cust_main->zip; $zip =~ s/\D//; my $prefix = $self->conf->config('bridgestone-prefix', $cust_main->agentnum) @@ -2161,7 +2168,120 @@ sub print_csv { '' #detail ); - } else { + } elsif ( $format eq 'ics' ) { + + my $bill = $cust_main->bill_location; + my $zip = $bill->zip; + my $zip4 = ''; + + $zip =~ s/\D//; + if ( $zip =~ /^(\d{5})(\d{4})$/ ) { + $zip = $1; + $zip4 = $2; + } + + # minor false laziness with print_generic + my ($previous_balance) = $self->previous; + my $balance_due = $self->owed + $previous_balance; + my $payment_total = sum(0, map { $_->{'amount'} } $self->_items_payments); + my $credit_total = sum(0, map { $_->{'amount'} } $self->_items_credits); + + my $past_due = ''; + if ( $self->due_date and $time >= $self->due_date ) { + $past_due = sprintf('Past due:$%0.2f Due Immediately', $balance_due); + } + + # again, bypass CSV + my $header = sprintf( + '%-10s%-30s%-48s%-2s%-50s%-30s%-30s%-25s%-2s%-5s%-4s%-8s%-8s%-10s%-10s%-10s%-10s%-10s%-10s%-480s%-35s', + $cust_main->display_custnum, #BID + uc($cust_main->first), #FNAME + uc($cust_main->last), #LNAME + '00', #BATCH, should this ever be anything else? + uc($cust_main->company), #COMP + uc($bill->address1), #STREET1 + uc($bill->address2), #STREET2 + uc($bill->city), #CITY + uc($bill->state), #STATE + $zip, + $zip4, + time2str('%Y%m%d', $self->_date), #BILL_DATE + $self->due_date2str('%Y%m%d'), #DUE_DATE, + ( map {sprintf('%0.2f', $_)} + $balance_due, #AMNT_DUE + $previous_balance, #PREV_BAL + $payment_total, #PYMT_RCVD + $credit_total, #CREDITS + $previous_balance, #BEG_BAL--is this correct? + $self->charged, #NEW_CHRG + ), + 'img01', #MRKT_MSG? + $past_due, #PAST_MSG + ); + + my @details; + my %svc_class = ('' => ''); # maybe cache this more persistently? + + foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) { + + my $show_pkgnum = $cust_bill_pkg->pkgnum || ''; + my $cust_pkg = $cust_bill_pkg->cust_pkg if $show_pkgnum; + + if ( $cust_pkg ) { + + my @dates = ( $self->_date, undef ); + if ( my $prev = $cust_bill_pkg->previous_cust_bill_pkg ) { + $dates[1] = $prev->sdate; #questionable + } + + # generate an 01 detail for each service + my @svcs = $cust_pkg->h_cust_svc(@dates, 'I'); + foreach my $cust_svc ( @svcs ) { + $show_pkgnum = ''; # hide it if we're showing svcnums + + my $svcpart = $cust_svc->svcpart; + if (!exists($svc_class{$svcpart})) { + my $classnum = $cust_svc->part_svc->classnum; + my $part_svc_class = FS::part_svc_class->by_key($classnum) + if $classnum; + $svc_class{$svcpart} = $part_svc_class ? + $part_svc_class->classname : + ''; + } + + push @details, sprintf('01%-9s%-20s%-47s', + $cust_svc->svcnum, + $svc_class{$svcpart}, + $cust_svc->svc_x->label, + ); + } #foreach $cust_svc + } #if $cust_pkg + + my $desc = $cust_bill_pkg->desc; # itemdesc or part_pkg.pkg + if ($cust_bill_pkg->recur > 0) { + $desc .= ' '.time2str('%d-%b-%Y', $cust_bill_pkg->sdate).' to '. + time2str('%d-%b-%Y', $cust_bill_pkg->edate - 86400); + } + push @details, sprintf('02%-6s%-60s%-10s', + $show_pkgnum, + $desc, + sprintf('%0.2f', $cust_bill_pkg->setup + $cust_bill_pkg->recur), + ); + } #foreach $cust_bill_pkg + + # Tag this row so that we know whether this is one page (1), two pages + # (2), # or "big" (B). The tag will be stripped off before uploading. + if ( scalar(@details) < 12 ) { + push @details, '1'; + } elsif ( scalar(@details) < 58 ) { + push @details, '2'; + } else { + push @details, 'B'; + } + + return join('', $header, @details, "\n"); + + } else { # default $csv->combine( 'cust_bill', diff --git a/FS/FS/ftp_target.pm b/FS/FS/ftp_target.pm deleted file mode 100644 index bf9fc891a..000000000 --- a/FS/FS/ftp_target.pm +++ /dev/null @@ -1,194 +0,0 @@ -package FS::ftp_target; - -use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearch qsearchs ); -use vars qw($me $DEBUG); - -$DEBUG = 0; - -=head1 NAME - -FS::ftp_target - Object methods for ftp_target records - -=head1 SYNOPSIS - - use FS::ftp_target; - - $record = new FS::ftp_target \%hash; - $record = new FS::ftp_target { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::ftp_target object represents an account on a remote FTP or SFTP -server for transferring files. FS::ftp_target inherits from FS::Record. - -=over 4 - -=item targetnum - primary key - -=item agentnum - L foreign key; can be null - -=item hostname - the DNS name of the FTP site - -=item username - username - -=item password - password - -=item path - the working directory to change to upon connecting - -=item secure - a flag ('Y' or null) for whether to use SFTP - -=back - -=head1 METHODS - -=over 4 - -=cut - -sub table { 'ftp_target'; } - -=item new HASHREF - -Creates a new FTP target. To add it to the database, see L<"insert">. - -=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. - -=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 - -sub check { - my $self = shift; - - if ( !$self->get('port') ) { - if ( $self->secure ) { - $self->set('port', 22); - } else { - $self->set('port', 21); - } - } - - my $error = - $self->ut_numbern('targetnum') - || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') - || $self->ut_text('hostname') - || $self->ut_text('username') - || $self->ut_text('password') - || $self->ut_number('port') - || $self->ut_text('path') - || $self->ut_flag('secure') - || $self->ut_enum('handling', [ $self->handling_types ]) - ; - return $error if $error; - - $self->SUPER::check; -} - -=item connect - -Creates a Net::FTP or Net::SFTP::Foreign object (according to the setting -of the 'secure' flag), connects to 'hostname', attempts to log in with -'username' and 'password', and changes the working directory to 'path'. -On success, returns the object. On failure, dies with an error message. - -=cut - -sub connect { - my $self = shift; - if ( $self->secure ) { - eval "use Net::SFTP::Foreign;"; - die $@ if $@; - my %args = ( - port => $self->port, - user => $self->username, - password => $self->password, - more => ($DEBUG ? '-v' : ''), - timeout => 30, - autodie => 1, #we're doing this anyway - ); - my $sftp = Net::SFTP::Foreign->new($self->hostname, %args); - $sftp->setcwd($self->path); - return $sftp; - } - else { - eval "use Net::FTP;"; - die $@ if $@; - my %args = ( - Debug => $DEBUG, - Port => $self->port, - Passive => 1,# optional? - ); - my $ftp = Net::FTP->new($self->hostname, %args) - or die "connect to ".$self->hostname." failed: $@"; - $ftp->login($self->username, $self->password) - or die "login to ".$self->username.'@'.$self->hostname." failed: $@"; - $ftp->binary; #optional? - $ftp->cwd($self->path) - or ($self->path eq '/') - or die "cwd to ".$self->hostname.'/'.$self->path." failed: $@"; - - return $ftp; - } -} - -=item label - -Returns a descriptive label for this target. - -=cut - -sub label { - my $self = shift; - $self->targetnum . ': ' . $self->username . '@' . $self->hostname; -} - -=item handling_types - -Returns a list of values for the "handling" field, corresponding to the -known ways to preprocess a file before uploading. Currently those are -implemented somewhat crudely in L. - -=cut - -sub handling_types { - '', - #'billco', #not implemented this way yet - 'bridgestone', -} - -=back - -=head1 SEE ALSO - -L, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_event/Action/cust_bill_spool_csv.pm b/FS/FS/part_event/Action/cust_bill_spool_csv.pm index 14349a9dd..250c83042 100644 --- a/FS/FS/part_event/Action/cust_bill_spool_csv.pm +++ b/FS/FS/part_event/Action/cust_bill_spool_csv.pm @@ -26,9 +26,9 @@ sub option_fields { type => 'checkbox', value => '1', }, - 'ftp_targetnum' => { label => 'Upload spool to FTP target', + 'upload_targetnum' => { label => 'Upload spool to target', type => 'select-table', - table => 'ftp_target', + table => 'upload_target', name_col => 'label', empty_label => '(do not upload)', order_by => 'targetnum', @@ -39,16 +39,17 @@ sub option_fields { sub default_weight { 50; } sub do_action { - my( $self, $cust_bill ) = @_; + my( $self, $cust_bill, $cust_event ) = @_; #my $cust_main = $self->cust_main($cust_bill); my $cust_main = $cust_bill->cust_main; $cust_bill->spool_csv( + 'time' => $cust_event->_date, 'format' => $self->option('spoolformat'), 'balanceover' => $self->option('spoolbalanceover'), 'agent_spools' => $self->option('spoolagent_spools'), - 'ftp_targetnum'=> $self->option('ftp_targetnum'), + 'upload_targetnum'=> $self->option('upload_targetnum'), ); } diff --git a/FS/FS/upload_target.pm b/FS/FS/upload_target.pm new file mode 100644 index 000000000..8466a6229 --- /dev/null +++ b/FS/FS/upload_target.pm @@ -0,0 +1,282 @@ +package FS::upload_target; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use FS::Misc qw(send_email); +use FS::Conf; +use File::Spec; +use vars qw($me $DEBUG); + +$DEBUG = 0; + +=head1 NAME + +FS::upload_target - Object methods for upload_target records + +=head1 SYNOPSIS + + use FS::upload_target; + + $record = new FS::upload_target \%hash; + $record = new FS::upload_target { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::upload_target object represents a destination to deliver files (such +as invoice batches) by FTP, SFTP, or email. FS::upload_target inherits from +FS::Record. + +=over 4 + +=item targetnum - primary key + +=item agentnum - L foreign key; can be null + +=item protocol - 'ftp', 'sftp', or 'email'. + +=item hostname - the DNS name of the FTP site, or the domain name of the +email address. + +=item port - the TCP port number, if it's not standard. + +=item username - username + +=item password - password + +=item path - for FTP/SFTP, the working directory to change to upon connecting. + +=item subject - for email, the Subject: header + +=item handling - a string naming an additional process to apply to +the file before sending it. + +=back + +=head1 METHODS + +=over 4 + +=cut + +sub table { 'upload_target'; } + +=item new HASHREF + +Creates a new FTP target. To add it to the database, see L<"insert">. + +=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. + +=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 + +sub check { + my $self = shift; + + my $protocol = lc($self->protocol); + if ( $protocol eq 'email' ) { + $self->set(password => ''); + $self->set(port => ''); + $self->set(path => ''); + } elsif ( $protocol eq 'sftp' ) { + $self->set(port => 22) unless $self->get('port'); + $self->set(subject => ''); + } elsif ( $protocol eq 'ftp' ) { + $self->set('port' => 21) unless $self->get('port'); + $self->set(subject => ''); + } else { + return "protocol '$protocol' not supported"; + } + $self->set(protocol => $protocol); # lowercase it + + my $error = + $self->ut_numbern('targetnum') + || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum') + || $self->ut_text('hostname') + || $self->ut_text('username') + || $self->ut_textn('password') + || $self->ut_numbern('port') + || $self->ut_textn('path') + || $self->ut_textn('subject') + || $self->ut_enum('handling', [ $self->handling_types ]) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item put LOCALNAME [ REMOTENAME ] + +Uploads the file named LOCALNAME, optionally changing its name to REMOTENAME +on the target. For FTP/SFTP, this opens a connection, changes to the working +directory (C), and PUTs the file. For email, it composes an empty +message and attaches the file. + +Returns an error message if anything goes wrong. + +=cut + +sub put { + my $self = shift; + my $localname = shift; + my @s = File::Spec->splitpath($localname); + my $remotename = shift || $s[-1]; + + my $conf = FS::Conf->new; + if ( $self->protocol eq 'ftp' or $self->protocol eq 'sftp' ) { + # could cache this if we ever want to reuse it + local $@; + my $connection = eval { $self->connect }; + return $@ if $@; + $connection->put($localname, $remotename) or return $connection->error; + } elsif ( $self->protocol eq 'email' ) { + + my $to = join('@', $self->username, $self->hostname); + # XXX if we were smarter, this could use a message template for the + # message subject, body, and source address + # (maybe use only the raw content, so that we don't have to supply a + # customer for substitutions? ewww.) + my %message = ( + 'from' => $conf->config('invoice_from'), + 'to' => $to, + 'subject' => $self->subject, + 'nobody' => 1, + 'mimeparts' => [ + { Path => $localname, + Type => 'application/octet-stream', + Encoding => 'base64', + Filename => $remotename, + Disposition => 'attachment', + } + ], + ); + return send_email(%message); + + } else { + return "unknown protocol '".$self->protocol."'"; + } +} + + + + + + + + +=item connect + +Creates a Net::FTP or Net::SFTP::Foreign object (according to the setting +of the 'secure' flag), connects to 'hostname', attempts to log in with +'username' and 'password', and changes the working directory to 'path'. +On success, returns the object. On failure, dies with an error message. + +Always returns an error for email targets. + +=cut + +sub connect { + my $self = shift; + if ( $self->protocol eq 'sftp' ) { + eval "use Net::SFTP::Foreign;"; + die $@ if $@; + my %args = ( + port => $self->port, + user => $self->username, + password => $self->password, + more => ($DEBUG ? '-v' : ''), + timeout => 30, + autodie => 1, #we're doing this anyway + ); + my $sftp = Net::SFTP::Foreign->new($self->hostname, %args); + $sftp->setcwd($self->path); + return $sftp; + } + elsif ( $self->protocol eq 'ftp') { + eval "use Net::FTP;"; + die $@ if $@; + my %args = ( + Debug => $DEBUG, + Port => $self->port, + Passive => 1,# optional? + ); + my $ftp = Net::FTP->new($self->hostname, %args) + or die "connect to ".$self->hostname." failed: $@"; + $ftp->login($self->username, $self->password) + or die "login to ".$self->username.'@'.$self->hostname." failed: $@"; + $ftp->binary; #optional? + $ftp->cwd($self->path) + or ($self->path eq '/') + or die "cwd to ".$self->hostname.'/'.$self->path." failed: $@"; + + return $ftp; + } else { + return "can't connect() to a target of type '".$self->protocol."'"; + } +} + +=item label + +Returns a descriptive label for this target. + +=cut + +sub label { + my $self = shift; + $self->targetnum . ': ' . $self->username . '@' . $self->hostname; +} + +=item handling_types + +Returns a list of values for the "handling" field, corresponding to the +known ways to preprocess a file before uploading. Currently those are +implemented somewhat crudely in L. + +=cut + +sub handling_types { + '', + #'billco', #not implemented this way yet + 'bridgestone', + 'ics', +} + +=back + +=head1 BUGS + +Handling methods should be here, but instead are in FS::Cron. + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index b5ee87e93..f530610e7 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -640,8 +640,8 @@ FS/access_groupsales.pm t/access_groupsales.t FS/part_svc_class.pm t/part_svc_class.t -FS/ftp_target.pm -t/ftp_target.t +FS/upload_target.pm +t/upload_target.t FS/quotation.pm t/quotation.t FS/quotation_pkg.pm diff --git a/FS/t/ftp_target.t b/FS/t/upload_target.t similarity index 81% rename from FS/t/ftp_target.t rename to FS/t/upload_target.t index 1a5928118..6d55de0f2 100644 --- a/FS/t/ftp_target.t +++ b/FS/t/upload_target.t @@ -1,5 +1,5 @@ BEGIN { $| = 1; print "1..1\n" } END {print "not ok 1\n" unless $loaded;} -use FS::ftp_target; +use FS::upload_target; $loaded=1; print "ok 1\n"; diff --git a/httemplate/browse/ftp_target.html b/httemplate/browse/ftp_target.html deleted file mode 100644 index 4a5782058..000000000 --- a/httemplate/browse/ftp_target.html +++ /dev/null @@ -1,56 +0,0 @@ -<& elements/browse.html, - 'title' => 'FTP targets', - 'menubar' => [ 'Add a target' => $p.'edit/ftp_target.html', ], - 'name' => 'FTP targets', - 'query' => { 'table' => 'ftp_target', - 'hashref' => {}, - }, - 'count_query' => $count_query, - 'header' => [ '#', - 'Server', - 'Username', - 'Password', - 'Path', - 'Protocol', - '', #handling - ], - 'fields' => [ 'targetnum', - 'hostname', - 'username', - 'password', - 'path', - sub { - my $ftp_target = shift; - my $label; - if ($ftp_target->secure) { - $label = 'SFTP'; - $label .= ' (port '.$ftp_target->port.')' - if $ftp_target->port != 22; - } - else { - $label = 'FTP'; - $label .= ' (port '.$ftp_target->port.')' - if $ftp_target->port != 21; - } - $label; - }, - 'handling', - ], - 'links' => [ $link, $link ], -&> - - -<% include('/elements/footer.html') %> - -<%once> - -my $count_query = 'SELECT COUNT(*) FROM ftp_target'; - - -<%init> - -die "access denied" - unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); - -my $link = [ $p.'edit/ftp_target.html?', 'targetnum' ]; - diff --git a/httemplate/browse/upload_target.html b/httemplate/browse/upload_target.html new file mode 100644 index 000000000..e166f3520 --- /dev/null +++ b/httemplate/browse/upload_target.html @@ -0,0 +1,49 @@ +<& elements/browse.html, + 'title' => 'Upload targets', + 'menubar' => [ 'Add a target' => $p.'edit/upload_target.html', ], + 'name' => 'targets', + 'query' => { 'table' => 'upload_target', + 'hashref' => {}, + }, + 'count_query' => $count_query, + 'header' => [ '#', + 'Protocol', + 'Username', + 'Server/Domain', + 'Password', + 'Path', + '', #handling + ], + 'fields' => [ 'targetnum', + sub { + my $target = shift; + $label{$target->protocol} + }, + 'username', + 'hostname', + 'password', + 'path', + 'handling', + ], + 'links' => [ $link, $link, $link, $link, ], +&> + + +<% include('/elements/footer.html') %> + +<%once> + +my $count_query = 'SELECT COUNT(*) FROM upload_target'; +my %label = ( + email => 'Email', + ftp => 'FTP', + sftp => 'SFTP', +); + +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); + +my $link = [ $p.'edit/upload_target.html?', 'targetnum' ]; + diff --git a/httemplate/edit/ftp_target.html b/httemplate/edit/ftp_target.html deleted file mode 100755 index aebf9aaed..000000000 --- a/httemplate/edit/ftp_target.html +++ /dev/null @@ -1,46 +0,0 @@ -<& elements/edit.html, - 'post_url' => popurl(1).'process/ftp_target.html', - 'name' => 'FTP target', - 'table' => 'ftp_target', - 'viewall_url' => "${p}browse/ftp_target.html", - 'labels' => { targetnum => 'Target', - hostname => 'Server', - username => 'Username', - password => 'Password', - path => 'Directory', - port => 'Port', - secure => 'Use SFTP', - handling => 'Special handling', - }, - 'fields' => [ - { field => 'hostname', size => 40 }, - { field => 'port', size => 8 }, - { field => 'secure', type => 'checkbox', value => 'Y' }, - 'username', - 'password', - { field => 'path', size => 40 }, - { field => 'handling', - type => 'select', - options => [ FS::ftp_target->handling_types ], - }, - ], - 'menubar' => \@menubar, - 'edit_callback' => $edit_callback, -&> -<%init> - -my $curuser = $FS::CurrentUser::CurrentUser; - -die "access denied" - unless $curuser->access_right('Configuration'); - -my @menubar = ('View all FTP targets' => $p.'browse/ftp_target.html'); -my $edit_callback = sub { - my ($cgi, $object) = @_; - if ( $object->targetnum ) { - push @menubar, 'Delete this target', - $p.'misc/delete-ftp_target.html?'.$object->targetnum; - } -}; - - diff --git a/httemplate/edit/process/ftp_target.html b/httemplate/edit/process/ftp_target.html deleted file mode 100644 index 35f56c490..000000000 --- a/httemplate/edit/process/ftp_target.html +++ /dev/null @@ -1,12 +0,0 @@ -<& elements/process.html, - 'table' => 'ftp_target', - 'viewall_dir' => 'browse', - 'agent_null' => 1, -&> -<%init> -my $curuser = $FS::CurrentUser::CurrentUser; - -die "access denied" - unless $curuser->access_right('Configuration'); - - diff --git a/httemplate/edit/process/upload_target.html b/httemplate/edit/process/upload_target.html new file mode 100644 index 000000000..8755bed56 --- /dev/null +++ b/httemplate/edit/process/upload_target.html @@ -0,0 +1,25 @@ +<& elements/process.html, + 'table' => 'upload_target', + 'viewall_dir' => 'browse', + 'agent_null' => 1, + 'precheck_callback'=> \&precheck, +&> +<%init> +my $curuser = $FS::CurrentUser::CurrentUser; + +die "access denied" + unless $curuser->access_right('Configuration'); + +sub precheck { + my $cgi = shift; + my $protocol = $cgi->param('protocol'); + # promote whatever set of fields was selected to the "real" values + my $params = $cgi->Vars; + foreach ( keys %$params ) { + if ( $_ =~ /^${protocol}_(\w+)/ ) { + $cgi->param($1, $cgi->param($_)); + } + } +} + + diff --git a/httemplate/edit/upload_target.html b/httemplate/edit/upload_target.html new file mode 100755 index 000000000..47fea78a0 --- /dev/null +++ b/httemplate/edit/upload_target.html @@ -0,0 +1,82 @@ +<& elements/edit.html, + 'post_url' => popurl(1).'process/upload_target.html', + 'name' => 'Upload target', + 'table' => 'upload_target', + 'viewall_url' => "${p}browse/upload_target.html", + 'labels' => { targetnum => 'Target', + protocol => 'Protocol', + handling => 'Special handling', + }, + 'fields' => [ + { field => 'protocol', + type => 'selectlayers', + options => [ '', 'sftp', 'ftp', 'email' ], + labels => { '' => '', + 'email' => 'Email', + 'sftp' => 'SFTP', + 'ftp' => 'FTP', + }, + layer_fields => \%protocol_fields, + layer_values_callback => \&values_callback, + }, + { field => 'handling', + type => 'select', + options => [ FS::upload_target->handling_types ], + }, + ], + 'menubar' => \@menubar, + 'edit_callback' => $edit_callback, +&> +<%init> + +my $curuser = $FS::CurrentUser::CurrentUser; + +die "access denied" + unless $curuser->access_right('Configuration'); + +my @menubar = ('View all FTP targets' => $p.'browse/upload_target.html'); +my $edit_callback = sub { + my ($cgi, $object) = @_; + if ( $object->targetnum ) { + push @menubar, 'Delete this target', + $p.'misc/delete-upload_target.html?'.$object->targetnum; + } +}; + +my %protocol_fields = ( + '' => [], + 'sftp' => [ + 'hostname' => { label => 'Server' }, + 'username' => { label => 'Username' }, + 'password' => { label => 'Password' }, + 'port' => { label => 'Port', size => 8 }, + 'path' => { label => 'Path', size => 30 }, + ], + 'email' => [ + 'username' => { label => 'To:' }, + 'hostname' => { label => '@' }, + 'subject' => { label => 'Subject:' }, + ], +); +$protocol_fields{'ftp'} = [ @{ $protocol_fields{'sftp'} } ]; +foreach my $k (keys %protocol_fields) { + # disambiguate the field names + foreach (@{ $protocol_fields{$k} }) { + $_ = $k.'_'.$_ unless ref $_; + } +} + +sub values_callback { + my ($cgi, $object) = @_; + my $layer_values; + # really simple, the interpretation of the fields is the same for all + # three layers + foreach my $l (qw(email ftp sftp)) { + $layer_values->{$l} = { map { $l.'_'.$_ => ($cgi->param($l.'_'.$_) || + $object->get($_) ) } + $object->fields }; + } + $layer_values; +} + + diff --git a/httemplate/elements/menu.html b/httemplate/elements/menu.html index b2141e991..bfbc179b9 100644 --- a/httemplate/elements/menu.html +++ b/httemplate/elements/menu.html @@ -629,7 +629,7 @@ $config_misc{'Inventory classes and inventory'} = [ $fsurl.'browse/inventory_cla || $curuser->access_right('Edit global inventory') || $curuser->access_right('Configuration'); -$config_misc{'FTP targets'} = [ $fsurl.'browse/ftp_target.html', 'FTP servers for billing and payment processing' ] +$config_misc{'Upload targets'} = [ $fsurl.'browse/upload_target.html', 'Billing and payment upload destinations' ] if $curuser->access_right('Configuration'); tie my %config_menu, 'Tie::IxHash'; -- 2.11.0