},
{
+ '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.',
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 );
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
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";
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;
}
}
+=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<fill_in>. 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;
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;
=cut
sub spool_formats {
- qw(default oneline billco bridgestone)
+ qw(default oneline billco bridgestone ics)
}
1;
'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',
# 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;
=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<FS::ftp_target>), will
+=item upload_targetnum - if set to a target (see L<FS::upload_target>), will
append to that spool. L<FS::Cron::upload> 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
sub spool_csv {
my($self, %opt) = @_;
+ my $time = $opt{'time'} || time;
my $cust_main = $self->cust_main;
if ( $opt{'dest'} ) {
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'} ) {
$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
$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);
seek(CSV, 0, 2);
}
- print CSV $detail;
+ print CSV $detail if defined($detail);
flock(CSV, LOCK_UN);
close 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;
'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);
@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)
'' #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',
+++ /dev/null
-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<FS::agent> 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<FS::Cron::upload>.
-
-=cut
-
-sub handling_types {
- '',
- #'billco', #not implemented this way yet
- 'bridgestone',
-}
-
-=back
-
-=head1 SEE ALSO
-
-L<FS::Record>, schema.html from the base documentation.
-
-=cut
-
-1;
-
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',
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'),
);
}
--- /dev/null
+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<FS::agent> 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<path>), 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<FS::Cron::upload>.
+
+=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<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
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
+++ /dev/null
-BEGIN { $| = 1; print "1..1\n" }
-END {print "not ok 1\n" unless $loaded;}
-use FS::ftp_target;
-$loaded=1;
-print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::upload_target;
+$loaded=1;
+print "ok 1\n";
+++ /dev/null
-<& 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 ],
-&>
-</TABLE>
-
-<% include('/elements/footer.html') %>
-
-<%once>
-
-my $count_query = 'SELECT COUNT(*) FROM ftp_target';
-
-</%once>
-<%init>
-
-die "access denied"
- unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
-
-my $link = [ $p.'edit/ftp_target.html?', 'targetnum' ];
-</%init>
--- /dev/null
+<& 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, ],
+&>
+</TABLE>
+
+<% include('/elements/footer.html') %>
+
+<%once>
+
+my $count_query = 'SELECT COUNT(*) FROM upload_target';
+my %label = (
+ email => 'Email',
+ ftp => 'FTP',
+ sftp => 'SFTP',
+);
+</%once>
+<%init>
+
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
+
+my $link = [ $p.'edit/upload_target.html?', 'targetnum' ];
+</%init>
+++ /dev/null
-<& 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;
- }
-};
-
-</%init>
+++ /dev/null
-<& 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');
-
-</%init>
--- /dev/null
+<& 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($_));
+ }
+ }
+}
+
+</%init>
--- /dev/null
+<& 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;
+}
+
+</%init>
|| $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';
projects / freeside.git / commitdiff