'Financial reports',
{ rightname=> 'List inventory', global=>1 },
{ rightname=>'View email logs', global=>1 },
+ { rightname=>'View system logs' },
'Download report data',
'Services: Accounts',
use strict;
use vars qw($DEBUG $me);
use FS::Record qw(qsearchs);
+use FS::Conf;
use FS::rate;
use FS::svc_phone;
return \%return;
}
+ my $conf = new FS::Conf;
+ my $balance = $conf->config_bool('pkg-balances') ? $cust_pkg->balance
+ : $cust_main->balance;
+
#XXX granularity? included minutes? another day...
- if ( $cust_main->balance >= 0 ) {
+ if ( $balance >= 0 ) {
return { 'error'=>'No balance' };
} else {
- $return{'seconds'} = int(60 * abs($cust_main->balance) / $rate_detail->min_charge);
+ $return{'seconds'} = int(60 * abs($balance) / $rate_detail->min_charge);
}
warn "$me returning seconds: ". $return{'seconds'};
my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
- warn "$me returning ". $cust_pkg->cust_main->balance.
- " balance for custnum ". $cust_pkg->custnum
+ my $conf = new FS::Conf;
+ my $balance = $conf->config_bool('pkg-balances')
+ ? $cust_pkg->balance
+ : $cust_pkg->cust_main->balance;
+
+ warn "$me returning $balance balance for pkgnum ". $cust_pkg->pkgnum.
+ ", custnum ". $cust_pkg->custnum
if $DEBUG;
return {
'custnum' => $cust_pkg->custnum,
- 'balance' => $cust_pkg->cust_main->balance,
+ 'balance' => $balance,
};
}
},
{
+ 'key' => 'event_log_level',
+ 'section' => 'notification',
+ 'description' => 'Store events in the internal log if they are at least this severe. "info" is the default, "debug" is very detailed and noisy.',
+ 'type' => 'select',
+ 'select_enum' => [ '', 'debug', 'info', 'notice', 'warning', 'error', ],
+ # don't bother with higher levels
+ },
+
+ {
'key' => 'log_sent_mail',
'section' => 'notification',
'description' => 'Enable logging of template-generated email.',
'section' => 'invoicing',
'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.',
'type' => 'select',
- 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ],
+ 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 3', 'Net 9', 'Net 10', 'Net 15', 'Net 18', 'Net 20', 'Net 21', 'Net 30', 'Net 45', 'Net 60', 'Net 90' ],
},
{
use FS::part_event;
use FS::part_event_condition;
+use FS::Log;
+
@ISA = qw( Exporter );
@EXPORT_OK = qw ( bill bill_where );
sub bill {
my %opt = @_;
+ my $log = FS::Log->new('Cron::bill');
+ $log->info('start');
+
my $check_freq = $opt{'check_freq'} || '1d';
my $debug = 0;
$cursor_dbh->commit or die $cursor_dbh->errstr;
+ $log->info('finish');
}
# freeside-daily %opt:
use FS::Conf;
use FS::queue;
use FS::agent;
+use FS::Log;
use FS::Misc qw( send_email ); #for bridgestone
use FS::upload_target;
use LWP::UserAgent;
sub upload {
my %opt = @_;
+ my $log = FS::Log->new('Cron::upload');
+ $log->info('start');
my $debug = 0;
$debug = 1 if $opt{'v'};
}
} # foreach @agents
+ # if there's nothing to do, don't hold up the rest of the process
+ if (!@tasks) {
+ $log->info('finish (nothing to upload)');
+ return '';
+ }
+
+ # wait for any ongoing billing jobs to complete
+ if ($opt{m}) {
+ my $dbh = dbh;
+ my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
+ "WHERE queue.job='FS::cust_main::queued_bill' AND status != 'failed'";
+ if (@agents) {
+ $sql .= ' AND cust_main.agentnum IN('.
+ join(',', map {$_->agentnum} @agents).
+ ')';
+ }
+ my $sth = $dbh->prepare($sql) or die $dbh->errstr;
+ while (1) {
+ $sth->execute()
+ or die "Unexpected error executing statement $sql: ". $sth->errstr;
+ last if $sth->fetchrow_arrayref->[0] == 0;
+ warn "Waiting 5min for billing to complete...\n" if $DEBUG;
+ sleep 300;
+ }
+ }
+
foreach (@tasks) {
my $agentnum = $_->{agentnum};
}
}
+ $log->info('finish');
}
sub spool_upload {
my %opt = @_;
+ my $log = FS::Log->new('spool_upload');
warn "$me spool_upload called\n" if $DEBUG;
my $conf = new FS::Conf;
my $dbh = dbh;
my $agentnum = $opt{agentnum};
+ $log->debug('start', agentnum => $agentnum);
+
my $agent;
if ( $agentnum ) {
$agent = qsearchs( 'agent', { agentnum => $agentnum } )
{
warn "$me neither $dir/$file-header.csv nor ".
"$dir/$file-detail.csv found\n" if $DEBUG > 1;
+ $log->debug("finish (neither $file-header.csv nor ".
+ "$file-detail.csv found)");
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return;
}
my $username = $opt{username} or die "no username for agent $agentnum\n";
my $password = $opt{password} or die "no password for agent $agentnum\n";
- # a better way?
- if ($opt{m}) {
- my $sql = "SELECT count(*) FROM queue LEFT JOIN cust_main USING(custnum) ".
- "WHERE queue.job='FS::cust_main::queued_bill' AND cust_main.agentnum = ?";
- my $sth = $dbh->prepare($sql) or die $dbh->errstr;
- while (1) {
- $sth->execute( $agentnum )
- or die "Unexpected error executing statement $sql: ". $sth->errstr;
- last if $sth->fetchrow_arrayref->[0];
- sleep 300;
- }
- }
-
foreach ( qw ( header detail ) ) {
rename "$dir/$file-$_.csv",
"$dir/$file-$date-$_.csv";
unless ( -f "$dir/$file.csv" ) {
warn "$me $dir/$file.csv not found\n" if $DEBUG > 1;
+ $log->debug("finish ($dir/$file.csv not found)");
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return;
}
}
}
- send_report('bridgestone-confirm_template',
- {
- agentnum=> $agentnum,
- zipfile => $zipfile,
- prefix => $prefix,
- seq => $seq,
- rows => $rows,
- }
+ send_email(
+ prepare_report('bridgestone-confirm_template',
+ {
+ agentnum=> $agentnum,
+ zipfile => $zipfile,
+ prefix => $prefix,
+ seq => $seq,
+ rows => $rows,
+ }
+ )
);
$seq++;
close $reg;
close $big;
+ # zip up all three files for transport
my $zipfile = "$basename" . '.zip';
my $command = "cd $dir; zip $zipfile $regfile $bigfile";
system($command) and die "'$command' failed\n";
- my $error = $upload_target->put("$dir/$zipfile");
+ # upload them, unless we're using email, in which case
+ # the zip file will ride along with the report. yes, this
+ # kind of defeats the purpose of the upload_target interface,
+ # but at least we have a place to store the configuration.
+ my $error = '';
+ if ( $upload_target->protocol ne 'email' ) {
+ $error = $upload_target->put("$dir/$zipfile");
+ }
+
+ # create the report
for (values %sum) {
$_ = sprintf('%.2f', $_);
}
- send_report('ics-confirm_template',
+ my %report = prepare_report('ics-confirm_template',
{
agentnum => $agentnum,
count => \%count,
error => $error,
}
);
+ if ( $upload_target->protocol eq 'email' ) {
+ $report{'to'} =
+ join('@', $upload_target->username, $upload_target->hostname);
+ $report{'subject'} = $upload_target->subject;
+ $report{'mimeparts'} = [
+ { Path => "$dir/$zipfile",
+ Type => 'application/zip',
+ Encoding => 'base64',
+ Filename => $zipfile,
+ Disposition => 'attachment',
+ }
+ ];
+ }
+ $error = send_email(%report);
if ( $error ) {
+ # put the original spool file back
rename "$dir/$file-$date.csv", "$dir/$file.csv";
die $error;
}
} #opt{handling}
+ $log->debug('finish', agentnum => $agentnum);
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
=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.
+extracts "to" and "subject" headers, and returns a hash that can be passed
+to L<FS::Misc::send_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 {
+
+sub prepare_report {
my ($config, $params) = @_;
my $agentnum = $params->{agentnum};
$head =~ /^to:\s*(.*)$/im;
my $to = $1;
- send_email(
+ (
to => $to,
from => $conf->config('invoice_from', $agentnum),
subject => $subject,
--- /dev/null
+package FS::Log;
+
+use base 'Log::Dispatch';
+use FS::Record qw(qsearch qsearchs);
+use FS::Conf;
+use FS::Log::Output;
+use FS::log;
+use vars qw(@STACK @LEVELS);
+
+# override the stringification of @_ with something more sensible.
+BEGIN {
+ @LEVELS = qw(debug info notice warning error critical alert emergency);
+
+ foreach my $l (@LEVELS) {
+ my $sub = sub {
+ my $self = shift;
+ $self->log( level => $l, message => @_ );
+ };
+ no strict 'refs';
+ *{$l} = $sub;
+ }
+}
+
+=head1 NAME
+
+FS::Log - Freeside event log
+
+=head1 SYNOPSIS
+
+use FS::Log;
+
+sub do_something {
+ my $log = FS::Log->new('do_something'); # set log context to 'do_something'
+
+ ...
+ if ( $error ) {
+ $log->error('something is wrong: '.$error);
+ return $error;
+ }
+ # at this scope exit, do_something is removed from context
+}
+
+=head1 DESCRIPTION
+
+FS::Log provides an interface for logging errors and profiling information
+to the database. FS::Log inherits from L<Log::Dispatch>.
+
+=head1 CLASS METHODS
+
+=over 4
+
+new CONTEXT
+
+Constructs and returns a log handle. CONTEXT must be a known context tag
+indicating what activity is going on, such as the name of the function or
+script that is executing.
+
+Log context is a stack, and each element is removed from the stack when it
+goes out of scope. So don't keep log handles in persistent places (i.e.
+package variables or class-scoped lexicals).
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $context = shift;
+
+ my $min_level = FS::Conf->new->config('event_log_level') || 'info';
+
+ my $self = $class->SUPER::new(
+ outputs => [ [ '+FS::Log::Output', min_level => $min_level ] ],
+ );
+ $self->{'index'} = scalar(@STACK);
+ push @STACK, $context;
+ return $self;
+}
+
+=item context
+
+Returns the current context stack.
+
+=cut
+
+sub context { @STACK };
+
+=item log LEVEL, MESSAGE[, OPTIONS ]
+
+Like L<Log::Dispatch::log>, but OPTIONS may include:
+
+- agentnum
+- object (an <FS::Record> object to reference in this log message)
+- tablename and tablenum (an alternate way of specifying 'object')
+
+=cut
+
+# inherited
+
+sub DESTROY {
+ my $self = shift;
+ splice(@STACK, $self->{'index'}, 1); # delete the stack entry
+}
+
+1;
--- /dev/null
+package FS::Log::Output;
+
+use base Log::Dispatch::Output;
+use FS::Record qw( dbdef );
+
+sub new { # exactly by the book
+ my $proto = shift;
+ my $class = ref $proto || $proto;
+
+ my %p = @_;
+
+ my $self = bless {}, $class;
+
+ $self->_basic_init(%p);
+
+ return $self;
+}
+
+sub log_message {
+ my $self = shift;
+ my %m = @_;
+
+ my $object = $m{'object'};
+ my ($tablename, $tablenum) = @m{'tablename', 'tablenum'};
+ if ( $object and $object->isa('FS::Record') ) {
+ $tablename = $object->table;
+ $tablenum = $object->get( dbdef->table($tablename)->primary_key );
+
+ # get the agentnum from the object if it has one
+ $m{'agentnum'} ||= $object->get('agentnum');
+ # maybe FS::cust_main_Mixin objects should use the customer's agentnum?
+ # I'm trying not to do database lookups in here, though.
+ }
+
+ my $entry = FS::log->new({
+ _date => time,
+ agentnum => $m{'agentnum'},
+ tablename => ($tablename || ''),
+ tablenum => ($tablenum || ''),
+ level => $self->_level_as_number($m{'level'}),
+ message => $m{'message'},
+ });
+ my $error = $entry->insert( FS::Log->context );
+ if ( $error ) {
+ # guh?
+ warn "Error writing log entry: $error";
+ }
+}
+
+1;
#use CGI::Carp qw(fatalsToBrowser);
use CGI::Cookie;
use List::Util qw( max min sum );
+ use List::MoreUtils qw( first_index uniq );
+ use Scalar::Util qw( blessed );
use Data::Dumper;
use Date::Format;
use Time::Local;
use IO::Handle;
use IO::File;
use IO::Scalar;
+ use IO::String;
#not actually using this yet anyway...# use IPC::Run3 0.036;
use Net::Whois::Raw qw(whois);
if ( $] < 5.006 ) {
use FS::agent_pkg_class;
use FS::svc_export_machine;
use FS::GeocodeCache;
+ use FS::log;
+ use FS::log_context;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
foreach my $table (
grep { ! /^clientapi_session/
&& ! /^h_/
+ && ! /^log(_context)?$/
&& ! $tables_hashref_torrus->{$_}
}
$dbdef->tables
'index' => [],
},
+ 'log' => {
+ 'columns' => [
+ 'lognum', 'serial', '', '', '', '',
+ '_date', 'int', '', '', '', '',
+ 'agentnum', 'int', 'NULL', '', '', '',
+ 'tablename', 'varchar', 'NULL', $char_d, '', '',
+ 'tablenum', 'int', 'NULL', '', '', '',
+ 'level', 'int', '', '', '', '',
+ 'message', 'text', '', '', '', '',
+ ],
+ 'primary_key' => 'lognum',
+ 'unique' => [],
+ 'index' => [ ['_date'], ['level'] ],
+ },
+
+ 'log_context' => {
+ 'columns' => [
+ 'logcontextnum', 'serial', '', '', '', '',
+ 'lognum', 'int', '', '', '', '',
+ 'context', 'varchar', '', 32, '', '',
+ ],
+ 'primary_key' => 'logcontextnum',
+ 'unique' => [ [ 'lognum', 'context' ] ],
+ 'index' => [],
+ },
+
%{ tables_hashref_torrus() },
# tables of ours for doing torrus virtual port combining
=item disintegrate
-Returns a list of cust_bill_pkg objects each with no more than a single class
-(including setup or recur) of charge.
+Returns a hash: keys are "setup", "recur" or usage classnum, values are
+FS::cust_bill_pkg objects, each with no more than a single class (setup or
+recur) of charge.
=cut
$self->cust_pkg->_X_show_zero($what);
}
+=item credited [ BEFORE, AFTER, OPTIONS ]
+
+Returns the sum of credits applied to this item. Arguments are the same as
+owed_sql/paid_sql/credited_sql.
+
+=cut
+
+sub credited {
+ my $self = shift;
+ $self->scalar_sql('SELECT '. $self->credited_sql(@_).' FROM cust_bill_pkg WHERE billpkgnum = ?', $self->billpkgnum);
+}
+
=back
=head1 CLASS METHODS
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- #false laziness w/ cust_credit::insert
+ #false laziness w/ cust_pay::insert
if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) {
my @errors = $cust_main->unsuspend;
#return
unapplied_sql();
}
+=item credit_lineitems
+
+Example:
+
+ my $error = FS::cust_credit->credit_lineitems(
+
+ #the lineitems to credit
+ 'billpkgnums' => \@billpkgnums,
+ 'setuprecurs' => \@setuprecurs,
+ 'amounts' => \@amounts,
+
+ #the credit
+ 'newreasonnum' => scalar($cgi->param('newreasonnum')),
+ 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')),
+ map { $_ => scalar($cgi->param($_)) }
+ #fields('cust_credit')
+ qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+
+ );
+
+=cut
+
+#maybe i should just be an insert with extra args instead of a class method
+use FS::cust_bill_pkg;
+sub credit_lineitems {
+ my( $class, %arg ) = @_;
+
+ my $curuser = $FS::CurrentUser::CurrentUser;
+
+ #some false laziness w/misc/xmlhttp-cust_bill_pkg-calculate_taxes.html
+
+ my $cust_main = qsearchs({
+ 'table' => 'cust_main',
+ 'hashref' => { 'custnum' => $arg{custnum} },
+ 'extra_sql' => ' AND '. $curuser->agentnums_sql,
+ }) or return 'unknown customer';
+
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ #my @cust_bill_pkg = qsearch({
+ # 'select' => 'cust_bill_pkg.*',
+ # 'table' => 'cust_bill_pkg',
+ # 'addl_from' => ' LEFT JOIN cust_bill USING (invnum) '.
+ # ' LEFT JOIN cust_main USING (custnum) ',
+ # 'extra_sql' => ' WHERE custnum = $custnum AND billpkgnum IN ('.
+ # join( ',', @{$arg{billpkgnums}} ). ')',
+ # 'order_by' => 'ORDER BY invnum ASC, billpkgnum ASC',
+ #});
+
+ my $error = '';
+ if ($arg{reasonnum} == -1) {
+
+ $error = 'Enter a new reason (or select an existing one)'
+ unless $arg{newreasonnum} !~ /^\s*$/;
+ my $reason = new FS::reason {
+ 'reason' => $arg{newreasonnum},
+ 'reason_type' => $arg{newreasonnum_type},
+ };
+ $error ||= $reason->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error inserting reason: $error";
+ }
+ $arg{reasonnum} = $reason->reasonnum;
+ }
+
+ my $cust_credit = new FS::cust_credit ( {
+ map { $_ => $arg{$_} }
+ #fields('cust_credit')
+ qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+ } );
+ $error = $cust_credit->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error inserting credit: $error";
+ }
+
+ #my $subtotal = 0;
+ my $taxlisthash = {};
+ my %cust_credit_bill = ();
+ my %cust_bill_pkg = ();
+ my %cust_credit_bill_pkg = ();
+ foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
+ my $setuprecur = shift @{$arg{setuprecurs}};
+ my $amount = shift @{$arg{amounts}};
+
+ my $cust_bill_pkg = qsearchs({
+ 'table' => 'cust_bill_pkg',
+ 'hashref' => { 'billpkgnum' => $billpkgnum },
+ 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
+ 'extra_sql' => 'AND custnum = '. $cust_main->custnum,
+ }) or die "unknown billpkgnum $billpkgnum";
+
+ if ( $setuprecur eq 'setup' ) {
+ $cust_bill_pkg->setup($amount);
+ $cust_bill_pkg->recur(0);
+ $cust_bill_pkg->unitrecur(0);
+ $cust_bill_pkg->type('');
+ } else {
+ $setuprecur = 'recur'; #in case its a usage classnum?
+ $cust_bill_pkg->recur($amount);
+ $cust_bill_pkg->setup(0);
+ $cust_bill_pkg->unitsetup(0);
+ }
+
+ push @{$cust_bill_pkg{$cust_bill_pkg->invnum}}, $cust_bill_pkg;
+
+ #unapply any payments applied to this line item (other credits too?)
+ foreach my $cust_bill_pay_pkg ( $cust_bill_pkg->cust_bill_pay_pkg($setuprecur) ) {
+ $error = $cust_bill_pay_pkg->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error unapplying payment: $error";
+ }
+ }
+
+ #$subtotal += $amount;
+ $cust_credit_bill{$cust_bill_pkg->invnum} += $amount;
+ push @{ $cust_credit_bill_pkg{$cust_bill_pkg->invnum} },
+ new FS::cust_credit_bill_pkg {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'amount' => $amount,
+ 'setuprecur' => $setuprecur,
+ 'sdate' => $cust_bill_pkg->sdate,
+ 'edate' => $cust_bill_pkg->edate,
+ };
+
+ my $part_pkg = $cust_bill_pkg->part_pkg;
+ $cust_main->_handle_taxes( $part_pkg,
+ $taxlisthash,
+ $cust_bill_pkg,
+ $cust_bill_pkg->cust_pkg,
+ $cust_bill_pkg->cust_bill->_date,
+ $cust_bill_pkg->cust_pkg->pkgpart,
+ );
+ }
+
+ ###
+ # now loop through %cust_credit_bill and insert those
+ ###
+
+ # (hack to prevent cust_credit_bill_pkg insertion)
+ local($FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack) = 1;
+
+ foreach my $invnum ( sort { $a <=> $b } keys %cust_credit_bill ) {
+
+ #taxes
+
+ if ( @{ $cust_bill_pkg{$invnum} } ) {
+
+ my $listref_or_error =
+ $cust_main->calculate_taxes( $cust_bill_pkg{$invnum}, $taxlisthash, $cust_bill_pkg{$invnum}->[0]->cust_bill->_date );
+
+ unless ( ref( $listref_or_error ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error calculating taxes: $listref_or_error";
+ }
+
+ # so, loop through the taxlines, apply just that amount to the tax line
+ # item (save for later insert) & add to $
+
+ #my @taxlines = ();
+ #my $taxtotal = 0;
+ foreach my $taxline ( @$listref_or_error ) {
+
+ #find equivalent tax line items on the existing invoice
+ # (XXX need a more specific/deterministic way to find these than itemdesc..)
+ my $tax_cust_bill_pkg = qsearchs('cust_bill_pkg', {
+ 'invnum' => $invnum,
+ 'pkgnum' => 0, #$taxline->invnum
+ 'itemdesc' => $taxline->desc,
+ });
+
+ my $amount = $taxline->setup;
+ my $desc = $taxline->desc;
+
+ foreach my $location ( $tax_cust_bill_pkg->cust_bill_pkg_tax_Xlocation ) {
+
+ $location->cust_bill_pkg_desc($taxline->desc); #ugh @ that kludge
+
+ #$taxtotal += $location->amount;
+ $amount -= $location->amount;
+
+ #push @taxlines,
+ # #[ $location->desc, $taxline->setup, $taxlocnum, $taxratelocnum ];
+ # [ $location->desc, $location->amount, $taxlocnum, $taxratelocnum ];
+ $cust_credit_bill{$invnum} += $location->amount;
+ push @{ $cust_credit_bill_pkg{$invnum} },
+ new FS::cust_credit_bill_pkg {
+ 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum,
+ 'amount' => $location->amount,
+ 'setuprecur' => 'setup',
+ 'billpkgtaxlocationnum' => $location->billpkgtaxlocationnum,
+ 'billpkgtaxratelocationnum' => $location->billpkgtaxratelocationnum,
+ };
+
+ }
+ if ($amount > 0) {
+ #$taxtotal += $amount;
+ #push @taxlines,
+ # [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ];
+
+ $cust_credit_bill{$invnum} += $amount;
+ push @{ $cust_credit_bill_pkg{$invnum} },
+ new FS::cust_credit_bill_pkg {
+ 'billpkgnum' => $tax_cust_bill_pkg->billpkgnum,
+ 'amount' => $amount,
+ 'setuprecur' => 'setup',
+ };
+
+ }
+ }
+
+ }
+
+ #insert cust_credit_bill
+
+ my $cust_credit_bill = new FS::cust_credit_bill {
+ 'crednum' => $cust_credit->crednum,
+ 'invnum' => $invnum,
+ 'amount' => $cust_credit_bill{$invnum},
+ };
+ $error = $cust_credit_bill->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error applying credit of $cust_credit_bill{$invnum} ".
+ " to invoice $invnum: $error";
+ }
+
+ #and then insert cust_credit_bill_pkg for each cust_bill_pkg
+ foreach my $cust_credit_bill_pkg ( @{$cust_credit_bill_pkg{$invnum}} ) {
+ $cust_credit_bill_pkg->creditbillnum( $cust_credit_bill->creditbillnum );
+ $error = $cust_credit_bill_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error applying credit to line item: $error";
+ }
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=back
=head1 BUGS
my $dbh = dbh;
my $error = '';
+ # prevent this from failing because of pkg_svc quantity limits
+ local( $FS::cust_svc::ignore_quantity ) = 1;
+
if ( !$new->locationnum ) {
$error = $new->insert;
if ( $error ) {
use FS::part_event;
use FS::part_event_condition;
use FS::pkg_category;
+use FS::Log;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
sub bill_and_collect {
my( $self, %options ) = @_;
+ my $log = FS::Log->new('bill_and_collect');
+ $log->debug('start', object => $self, agentnum => $self->agentnum);
+
my $error;
#$options{actual_time} not $options{time} because freeside-daily -d is for
}
}
$job->update_statustext('100,finished') if $job;
+ $log->debug('finish', object => $self, agentnum => $self->agentnum);
'';
$conf = new FS::Conf;
};
+my %is_location = map { $_ => 1 } FS::cust_main::Location->location_fields;
+
=head1 NAME
FS::cust_main::Import - Batch customer importing
custbatch => $custbatch,
agentnum => $agentnum,
refnum => $refnum,
- country => $conf->config('countrydefault') || 'US',
payby => $payby, #default
paydate => '12/2037', #default
);
my $billtime = time;
my %cust_pkg = ( pkgpart => $pkgpart );
my %svc_x = ();
+ my %bill_location = ();
+ my %ship_location = ();
foreach my $field ( @fields ) {
if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
$svc_x{$1} = shift @columns;
+ } elsif ( $is_location{$field} ) {
+
+ $bill_location{$field} = shift @columns;
+
+ } elsif ( $field =~ /^ship_(.*)$/ and $is_location{$1} ) {
+
+ $ship_location{$1} = shift @columns;
+
} else {
#refnum interception
my $value = shift @columns;
$cust_main{$field} = $value if length($value);
}
+ } # foreach my $field
+ # finished importing columns
+
+ $bill_location{'country'} ||= $conf->config('countrydefault') || 'US';
+ $cust_main{'bill_location'} = FS::cust_location->new(\%bill_location);
+ if ( grep $_, values(%ship_location) ) {
+ $ship_location{'country'} ||= $conf->config('countrydefault') || 'US';
+ $cust_main{'ship_location'} = FS::cust_location->new(\%ship_location);
+ } else {
+ $cust_main{'ship_location'} = $cust_main{'bill_location'};
}
if ( defined $cust_main{'payinfo'} && length $cust_main{'payinfo'} ) {
Optional subject for a ticket created and attached to this customer
-=item ticket_subject
+=item ticket_queue
Optional queue name for ticket additions
$_->taxnum($self->taxnum) foreach @new_exemptions;
- if ( $cust_bill_pkg->billpkgnum ) {
- die "tried to calculate tax exemptions on a previously billed line item\n";
+ #if ( $cust_bill_pkg->billpkgnum ) {
+
+ #no, need to do this to e.g. calculate tax credit amounts
+ #die "tried to calculate tax exemptions on a previously billed line item\n";
+
# this is unnecessary
# foreach my $cust_tax_exempt_pkg (@new_exemptions) {
# my $error = $cust_tax_exempt_pkg->insert;
# return "can't insert cust_tax_exempt_pkg: $error";
# }
# }
- }
+ #}
# attach them to the line item
push @{ $cust_bill_pkg->cust_tax_exempt_pkg }, @new_exemptions;
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
+=item balance
+
+Returns the balance for this specific package, when using
+experimental package balance.
+
+=cut
+
+sub balance {
+ my $self = shift;
+ $self->cust_main->balance_pkgnum( $self->pkgnum );
+}
+
#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
=item cust_location
}
foreach my $cust_svc ($self->cust_svc) {
- if($target{$cust_svc->svcpart} > 0) {
+ if($target{$cust_svc->svcpart} > 0
+ or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
$target{$cust_svc->svcpart}--;
my $new = new FS::cust_svc { $cust_svc->hash };
$new->pkgnum($dest_pkgnum);
sub export_links {
my $self = shift;
my $svc_x = $self->svc_x
- or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
+ or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
$svc_x->export_links;
}
--- /dev/null
+package FS::log;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs dbdef );
+use FS::UID qw( dbh driver_name );
+use FS::log_context;
+
+=head1 NAME
+
+FS::log - Object methods for log records
+
+=head1 SYNOPSIS
+
+ use FS::log;
+
+ $record = new FS::log \%hash;
+ $record = new FS::log { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::log object represents a log entry. FS::log inherits from
+FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item lognum - primary key
+
+=item _date - Unix timestamp
+
+=item agentnum - L<FS::agent> to which the log pertains. If it involves a
+specific customer, package, service, invoice, or other agent-specific object,
+this will be set to that agentnum.
+
+=item tablename - table name to which the log pertains, if any.
+
+=item tablenum - foreign key to that table.
+
+=item level - log level: 'debug', 'info', 'notice', 'warning', 'error',
+'critical', 'alert', 'emergency'.
+
+=item message - contents of the log entry
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new log entry. Use FS::Log instead of calling this directly,
+please.
+
+=cut
+
+sub table { 'log'; }
+
+=item insert [ CONTEXT... ]
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+CONTEXT may be a list of context tags to attach to this record.
+
+=cut
+
+sub insert {
+ # not using process_o2m for this, because we don't have a web interface
+ my $self = shift;
+ my $error = $self->SUPER::insert;
+ return $error if $error;
+ foreach ( @_ ) {
+ my $context = FS::log_context->new({
+ 'lognum' => $self->lognum,
+ 'context' => $_
+ });
+ $error = $context->insert;
+ return $error if $error;
+ }
+ '';
+}
+
+# the insert method can be inherited from FS::Record
+
+sub delete { die "Log entries can't be modified." };
+
+sub replace { die "Log entries can't be modified." };
+
+=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 $error =
+ $self->ut_numbern('lognum')
+ || $self->ut_number('_date')
+ || $self->ut_numbern('agentnum')
+ || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
+ || $self->ut_textn('tablename')
+ || $self->ut_numbern('tablenum')
+ || $self->ut_number('level')
+ || $self->ut_text('message')
+ ;
+ return $error if $error;
+
+ if ( my $tablename = $self->tablename ) {
+ my $dbdef_table = dbdef->table($tablename)
+ or return "tablename '$tablename' does not exist";
+ $error = $self->ut_foreign_key('tablenum',
+ $tablename,
+ $dbdef_table->primary_key);
+ return $error if $error;
+ }
+
+ $self->SUPER::check;
+}
+
+=item context
+
+Returns the context for this log entry, as an array, from least to most
+specific.
+
+=cut
+
+sub context {
+ my $self = shift;
+ map { $_->context } qsearch({
+ table => 'log_context',
+ hashref => { lognum => $self->lognum },
+ order_by => 'ORDER BY logcontextnum ASC',
+ });
+}
+
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item search HASHREF
+
+Returns a qsearch hash expression to search for parameters specified in
+HASHREF. Valid parameters are:
+
+=over 4
+
+=item agentnum
+
+=item date - arrayref of start and end date
+
+=item level - either a specific level, or an arrayref of min and max level
+
+=item context - a context string that the log entry must have. This may
+change in the future to allow searching for combinations of context strings.
+
+=item object - any database object, to find log entries related to it.
+
+=item tablename, tablenum - alternate way of specifying 'object'.
+
+=item custnum - a customer number, to find log entries related to the customer
+or any of their subordinate objects (invoices, packages, etc.).
+
+=item message - a text string to search in messages. The search will be
+a case-insensitive LIKE with % appended at both ends.
+
+=back
+
+=cut
+
+# used for custnum search: all tables with custnums
+my @table_stubs;
+
+sub _setup_table_stubs {
+ foreach my $table (
+ qw(
+ contact
+ cust_attachment
+ cust_bill
+ cust_credit
+ cust_location
+ cust_main
+ cust_main_exemption
+ cust_main_note
+ cust_msg
+ cust_pay
+ cust_pay_batch
+ cust_pay_pending
+ cust_pay_void
+ cust_pkg
+ cust_refund
+ cust_statement
+ cust_tag
+ cust_tax_adjustment
+ cust_tax_exempt
+ did_order_item
+ qual
+ queue ) )
+ {
+ my $pkey = dbdef->table($table)->primary_key;
+ push @table_stubs,
+ "log.tablename = '$table' AND ".
+ "EXISTS(SELECT 1 FROM $table WHERE log.tablenum = $table.$pkey AND ".
+ "$table.custnum = "; # needs a closing )
+ }
+ # plus this case
+ push @table_stubs,
+ "(log.tablename LIKE 'svc_%' OR log.tablename = 'cust_svc') AND ".
+ "EXISTS(SELECT 1 FROM cust_svc JOIN cust_pkg USING (svcnum) WHERE ".
+ "cust_pkg.custnum = "; # needs a closing )
+}
+
+sub search {
+ my ($class, $params) = @_;
+ my @where;
+
+ ##
+ # parse agent
+ ##
+
+ if ( $params->{'agentnum'} =~ /^(\d+)$/ ) {
+ push @where,
+ "log.agentnum = $1";
+ }
+
+ ##
+ # parse custnum
+ ##
+
+ if ( $params->{'custnum'} =~ /^(\d+)$/ ) {
+ _setup_table_stubs() unless @table_stubs;
+ my $custnum = $1;
+ my @orwhere = map { "( $_ $custnum) )" } @table_stubs;
+ push @where, join(' OR ', @orwhere);
+ }
+
+ ##
+ # parse level
+ ##
+
+ if ( ref $params->{'level'} eq 'ARRAY' ) {
+ my ($min, $max) = @{ $params->{'level'} };
+ if ( $min =~ /^\d+$/ ) {
+ push @where, "log.level >= $min";
+ }
+ if ( $max =~ /^\d+$/ ) {
+ push @where, "log.level <= $max";
+ }
+ } elsif ( $params->{'level'} =~ /^(\d+)$/ ) {
+ push @where, "log.level = $1";
+ }
+
+ ##
+ # parse date
+ ##
+
+ if ( ref $params->{'date'} eq 'ARRAY' ) {
+ my ($beg, $end) = @{ $params->{'date'} };
+ if ( $beg =~ /^\d+$/ ) {
+ push @where, "log._date >= $beg";
+ }
+ if ( $end =~ /^\d+$/ ) {
+ push @where, "log._date <= $end";
+ }
+ }
+
+ ##
+ # parse object
+ ##
+
+ if ( $params->{'object'} and $params->{'object'}->isa('FS::Record') ) {
+ my $table = $params->{'object'}->table;
+ my $pkey = dbdef->table($table)->primary_key;
+ my $tablenum = $params->{'object'}->get($pkey);
+ if ( $table and $tablenum ) {
+ push @where, "log.tablename = '$table'", "log.tablenum = $tablenum";
+ }
+ } elsif ( $params->{'tablename'} =~ /^(\w+)$/ ) {
+ my $table = $1;
+ if ( $params->{'tablenum'} =~ /^(\d+)$/ ) {
+ push @where, "log.tablename = '$table'", "log.tablenum = $1";
+ }
+ }
+
+ ##
+ # parse message
+ ##
+
+ if ( $params->{'message'} ) { # can be anything, really, so escape it
+ my $quoted_message = dbh->quote('%' . $params->{'message'} . '%');
+ my $op = (driver_name eq 'Pg' ? 'ILIKE' : 'LIKE');
+ push @where, "log.message $op $quoted_message";
+ }
+
+ ##
+ # parse context
+ ##
+
+ if ( $params->{'context'} ) {
+ my $quoted = dbh->quote($params->{'context'});
+ push @where,
+ "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ".
+ "AND log_context.context = $quoted)";
+ }
+
+ # agent virtualization
+ my $access_user = $FS::CurrentUser::CurrentUser;
+ push @where, $access_user->agentnums_sql(
+ table => 'log',
+ viewall_right => 'Configuration',
+ null => 1,
+ );
+
+ # put it together
+ my $extra_sql = '';
+ $extra_sql .= 'WHERE ' . join(' AND ', @where) if @where;
+ my $count_query = 'SELECT COUNT(*) FROM log '.$extra_sql;
+ my $sql_query = {
+ 'table' => 'log',
+ 'hashref' => {},
+ 'select' => 'log.*',
+ 'extra_sql' => $extra_sql,
+ 'count_query' => $count_query,
+ 'order_by' => 'ORDER BY _date ASC',
+ #addl_from, not needed
+ };
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
--- /dev/null
+package FS::log_context;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+
+my @contexts = ( qw(
+ test
+ bill_and_collect
+ Cron::bill
+ Cron::upload
+ spool_upload
+ daily
+ queue
+) );
+
+=head1 NAME
+
+FS::log_context - Object methods for log_context records
+
+=head1 SYNOPSIS
+
+ use FS::log_context;
+
+ $record = new FS::log_context \%hash;
+ $record = new FS::log_context { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::log_context object represents a context tag attached to a log entry
+(L<FS::log>). FS::log_context inherits from FS::Record. The following
+fields are currently supported:
+
+=over 4
+
+=item logcontextnum - primary key
+
+=item lognum - lognum (L<FS::log> foreign key)
+
+=item context - context
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new context tag. To add the example 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
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'log_context'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=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('logcontextnum')
+ || $self->ut_number('lognum')
+ || $self->ut_enum('context', \@contexts)
+ ;
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=back
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item contexts
+
+Returns a list of all valid contexts.
+
+=cut
+
+sub contexts { @contexts }
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Log>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
#my $cust_main = $self->cust_main($cust_pkg);
- $cust_pkg->dundate <= $opt{time};
+ ( $cust_pkg->dundate || 0 ) <= $opt{time};
}
export_info()->{$self->exporttype}->{'weight'} || 0;
}
+=item info
+
+Returns a reference to (a copy of) the export's %info hash.
+
+=cut
+
+sub info {
+ my $self = shift;
+ $self->{_info} ||= {
+ %{ export_info()->{$self->exporttype} }
+ };
+}
+
+#default fallbacks... FS::part_export::DID_Common ?
+sub get_dids_can_tollfree { 0; }
+sub get_dids_npa_select { 1; }
+
=back
=head1 SUBROUTINES
"password \$new->_password",
),
},
+ 'suspend_data' => {
+ label => 'Suspend data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
+ 'unsuspend_data' => {
+ label => 'Unsuspend data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
'success_regexp' => {
label => 'Success Regexp',
default => '',
old_ for replace operations):
<UL>
<LI><code>$username</code>
+ <LI><code>$domain</code>
+ <LI><code>$email</code> - username@domain
<LI><code>$_password</code>
<LI><code>$crypt_password</code> - encrypted password
<LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4")
} else {
return Frontier::RPC2::String->new( $svc_acct->$value() );
}
- } elsif ( $value eq 'domain' ) {
- return Frontier::RPC2::String->new( $svc_acct->domain );
+ } elsif ( $value =~ /^(domain|email)$/ ) {
+ return Frontier::RPC2::String->new( $svc_acct->$value() );
} elsif ( $value eq 'crypt_password' ) {
return Frontier::RPC2::String->new( $svc_acct->crypt_password( $self->option('crypt') ) );
} elsif ( $value eq 'ldap_password' ) {
#XXX
}
+#this is the "cust_main" email, not svc_acct->email
# my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
# if ( $cust_pkg ) {
# no strict 'vars';
type => 'textarea',
default => '',
},
+ 'suspend_data' => {
+ label => 'Suspend data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
+ 'unsuspend_data' => {
+ label => 'Unsuspend data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
'success_regexp' => {
label => 'Success Regexp',
default => '',
use strict;
use vars qw(%info $DEBUG);
use base 'FS::part_export';
-use Net::SNMP qw(:asn1 :snmp);
+use SNMP;
use Tie::IxHash;
$DEBUG = 0;
my $me = '['.__PACKAGE__.']';
tie my %snmp_version, 'Tie::IxHash',
- v1 => 'snmpv1',
- v2c => 'snmpv2c',
- # 3 => 'v3' not implemented
+ v1 => '1',
+ v2c => '2c',
+ # v3 unimplemented
;
-tie my %snmp_type, 'Tie::IxHash',
- i => INTEGER,
- u => UNSIGNED32,
- s => OCTET_STRING,
- n => NULL,
- o => OBJECT_IDENTIFIER,
- t => TIMETICKS,
- a => IPADDRESS,
- # others not implemented yet
-;
+#tie my %snmp_type, 'Tie::IxHash',
+# i => INTEGER,
+# u => UNSIGNED32,
+# s => OCTET_STRING,
+# n => NULL,
+# o => OBJECT_IDENTIFIER,
+# t => TIMETICKS,
+# a => IPADDRESS,
+# # others not implemented yet
+#;
tie my %options, 'Tie::IxHash',
'version' => { label=>'SNMP version',
options => [ keys %snmp_version ],
},
'community' => { label=>'Community', default=>'public' },
- (
- map { $_.'_command',
- { label => ucfirst($_) . ' commands',
- type => 'textarea',
- default => '',
- }
- } qw( insert delete replace suspend unsuspend )
- ),
+
+ 'action' => { multiple=>1 },
+ 'oid' => { multiple=>1 },
+ 'value' => { multiple=>1 },
+
'ip_addr_change_to_new' => {
label=>'Send IP address changes to new address',
type=>'checkbox'
%info = (
'svc' => 'svc_broadband',
'desc' => 'Send SNMP requests to the service IP address',
+ 'config_element' => '/edit/elements/part_export/broadband_snmp.html',
'options' => \%options,
'no_machine' => 1,
'weight' => 10,
'notes' => <<'END'
Send one or more SNMP SET requests to the IP address registered to the service.
-Enter one command per line. Each command is a target OID, data type flag,
-and value, separated by spaces.
-The data type flag is one of the following:
-<font size="-1"><ul>
-<li><i>i</i> = INTEGER</li>
-<li><i>u</i> = UNSIGNED32</li>
-<li><i>s</i> = OCTET-STRING (as ASCII)</li>
-<li><i>a</i> = IPADDRESS</li>
-<li><i>n</i> = NULL</li></ul>
The value may interpolate fields from svc_broadband by prefixing the field
name with <b>$</b>, or <b>$new_</b> and <b>$old_</b> for replace operations.
-The value may contain whitespace; quotes are not necessary.<br>
-<br>
-For example, to set the SNMPv2-MIB "sysName.0" object to the string
-"svc_broadband" followed by the service number, use the following
-command:<br>
-<pre>1.3.6.1.2.1.1.5.0 s svc_broadband$svcnum</pre><br>
END
);
my $self = shift;
my ($action, $svc_new, $svc_old) = @_;
- my $command_text = $self->option($action.'_command');
- return if !length($command_text);
-
- warn "$me parsing ${action}_command:\n" if $DEBUG;
+ my @a = split("\n", $self->option('action'));
+ my @o = split("\n", $self->option('oid'));
+ my @v = split("\n", $self->option('value'));
my @commands;
- foreach (split /\n/, $command_text) {
- my ($oid, $type, $value) = split /\s/, $_, 3;
- $oid =~ /^(\d+\.)*\d+$/ or die "invalid OID '$oid'\n";
- my $typenum = $snmp_type{$type} or die "unknown data type '$type'\n";
- $value = '' if !defined($value); # allow sending an empty string
+ warn "$me parsing $action commands:\n" if $DEBUG;
+ while (@a) {
+ my $oid = shift @o;
+ my $value = shift @v;
+ next unless shift(@a) eq $action; # ignore commands for other actions
$value = $self->substitute($value, $svc_new, $svc_old);
- warn "$me $oid $type $value\n" if $DEBUG;
- push @commands, $oid, $typenum, $value;
+ warn "$me $oid :=$value\n" if $DEBUG;
+ push @commands, $oid, $value;
}
my $ip_addr = $svc_new->ip_addr;
warn "$me opening session to $ip_addr\n" if $DEBUG;
my %opt = (
- -hostname => $ip_addr,
- -community => $self->option('community'),
- -timeout => $self->option('timeout') || 20,
+ DestHost => $ip_addr,
+ Community => $self->option('community'),
+ Timeout => ($self->option('timeout') || 20) * 1000,
);
my $version = $self->option('version');
- $opt{-version} = $snmp_version{$version} or die 'invalid version';
- $opt{-varbindlist} = \@commands; # just for now
+ $opt{Version} = $snmp_version{$version} or die 'invalid version';
+ $opt{VarList} = \@commands; # for now
$self->snmp_queue( $svc_new->svcnum, %opt );
}
sub snmp_request {
my %opt = @_;
- my $varbindlist = delete $opt{-varbindlist};
- my ($session, $error) = Net::SNMP->session(%opt);
- die "Couldn't create SNMP session: $error" if !$session;
+ my $flatvarlist = delete $opt{VarList};
+ my $session = SNMP::Session->new(%opt);
warn "$me sending SET request\n" if $DEBUG;
- my $result = $session->set_request( -varbindlist => $varbindlist );
- $error = $session->error();
- $session->close();
- if (!defined $result) {
+ my @varlist;
+ while (@$flatvarlist) {
+ my @this = splice(@$flatvarlist, 0, 2);
+ push @varlist, [ $this[0], 0, $this[1], undef ];
+ # XXX new option to choose the IID (array index) of the object?
+ }
+
+ $session->set(\@varlist);
+ my $error = $session->{ErrorStr};
+
+ if ( $session->{ErrorNum} ) {
die "SNMP request failed: $error\n";
}
}
$value;
}
+sub _upgrade_exporttype {
+ eval 'use FS::Record qw(qsearch qsearchs)';
+ # change from old style with numeric oid, data type flag, and value
+ # on consecutive lines
+ foreach my $export (qsearch('part_export',
+ { exporttype => 'broadband_snmp' } ))
+ {
+ # for the new options
+ my %new_options = (
+ 'action' => [],
+ 'oid' => [],
+ 'value' => [],
+ );
+ foreach my $action (qw(insert replace delete suspend unsuspend)) {
+ my $old_option = qsearchs('part_export_option',
+ { exportnum => $export->exportnum,
+ optionname => $action.'_command' } );
+ next if !$old_option;
+ my $text = $old_option->optionvalue;
+ my @commands = split("\n", $text);
+ foreach (@commands) {
+ my ($oid, $type, $value) = split /\s/, $_, 3;
+ push @{$new_options{action}}, $action;
+ push @{$new_options{oid}}, $oid;
+ push @{$new_options{value}}, $value;
+ }
+ my $error = $old_option->delete;
+ warn "error migrating ${action}_command option: $error\n" if $error;
+ }
+ foreach (keys(%new_options)) {
+ my $new_option = FS::part_export_option->new({
+ exportnum => $export->exportnum,
+ optionname => $_,
+ optionvalue => join("\n", @{ $new_options{$_} })
+ });
+ my $error = $new_option->insert;
+ warn "error inserting '$_' option: $error\n" if $error;
+ }
+ } #foreach $export
+ '';
+}
+
1;
--- /dev/null
+package FS::part_export::fibernetics_did;
+use base qw( FS::part_export );
+
+use strict;
+use vars qw( %info $DEBUG );
+use Data::Dumper;
+use URI::Escape;
+#use Locale::SubCountry;
+#use FS::Record qw(qsearch dbh);
+use XML::Simple;
+#use Net::HTTPS::Any qw( 0.10 https_get );
+use LWP::UserAgent;
+use HTTP::Request::Common;
+
+$DEBUG = 0;
+
+tie my %options, 'Tie::IxHash',
+ 'country' => { 'label' => 'Country', 'default' => 'CA', size=>2, },
+;
+
+%info = (
+ 'svc' => 'svc_phone',
+ 'desc' => 'Provision phone numbers to Fibernetics web services API',
+ 'options' => \%options,
+ 'notes' => '',
+);
+
+sub rebless { shift; }
+
+sub get_dids_can_tollfree { 0; };
+sub get_dids_npa_select { 0; };
+
+# i guess we could get em from the API, but since its returning states without
+# availability, there's no advantage
+ # not really needed, we maintain our own list of provinces, but would
+ # help to hide the ones without availability (need to fix the selector too)
+our @states = (
+ 'Alberta',
+ 'British Columbia',
+ 'Ontario',
+ 'Quebec',
+ #'Saskatchewan',
+ #'The Territories',
+ #'PEI/Nova Scotia',
+ #'Manitoba',
+ #'Newfoundland',
+ #'New Brunswick',
+);
+
+sub get_dids {
+ my $self = shift;
+ my %opt = ref($_[0]) ? %{$_[0]} : @_;
+
+ if ( $opt{'tollfree'} ) {
+ warn 'Fibernetics DID provisioning does not yet support toll-free numbers';
+ return [];
+ }
+
+ my %query_hash = ();
+
+ #ratecenter + state: return numbers (more structured names, npa selection)
+ #areacode + exchange: return numbers
+ #areacode: return city/ratecenter/whatever
+ #state: return areacodes
+
+ #region + state: return numbers (arbitrary names, no npa selection)
+ #state: return regions
+
+# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
+#
+# $query_hash{'region'} = $opt{'exchange'};
+#
+# } elsif ( $opt{'areacode'} ) {
+#
+# $query_hash{'npa'} = $opt{'areacode'};
+
+ #if ( $opt{'state'} && $opt{'region'} ) { #return numbers
+ if ( $opt{'region'} ) { #return numbers
+
+ #$query_hash{'province'} = $country->full_name($opt{'state'});
+ $query_hash{'region'} = $opt{'region'}
+
+ } elsif ( $opt{'state'} ) { #return regions
+
+ #my $country = new Locale::SubCountry( $self->option('country') );
+ #$query_hash{'province'} = $country->full_name($opt{'state'});
+ $query_hash{'province'} = $opt{'state'};
+ $query_hash{'listregion'} = 1;
+
+ } else { #nothing passed, return states (provinces)
+
+ return \@states;
+
+ }
+
+
+ my $url = 'http://'. $self->machine. '/porta/cgi-bin/porta_query.cgi';
+ if ( keys %query_hash ) {
+ $url .= '?'. join('&', map "$_=". uri_escape($query_hash{$_}),
+ keys %query_hash
+ );
+ }
+ warn $url if $DEBUG;
+
+ #my( $page, $response, %reply_headers) = https_get(
+ # 'host' => $self->machine,
+ #);
+
+ my $ua = LWP::UserAgent->new;
+ #my $response = $ua->$method(
+ # $url, \%data,
+ # 'Content-Type'=>'application/x-www-form-urlencoded'
+ #);
+ my $req = HTTP::Request::Common::GET( $url );
+ my $response = $ua->request($req);
+
+ die $response->error_as_HTML if $response->is_error;
+
+ my $page = $response->content;
+
+ my $data = XMLin( $page );
+
+ warn Dumper($data) if $DEBUG;
+
+# if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers
+#
+# [ map $_->{'number'}, @{ $data->{'item'} } ];
+#
+# } elsif ( $opt{'areacode'} ) {
+#
+# [ map $_->{'region'}, @{ $data->{'item'} } ];
+#
+# } elsif ( $opt{'state'} ) { #return areacodes
+#
+# [ map $_->{'npa'}, @{ $data->{'item'} } ];
+
+ #if ( $opt{'state'} && $opt{'region'} ) { #return numbers
+ if ( $opt{'region'} ) { #return numbers
+
+ [ map { $_ =~ /^(\d?)(\d{3})(\d{3})(\d{4})$/
+ #? ($1 ? "$1 " : ''). "$2 $3 $4"
+ ? "$2 $3 $4"
+ : $_;
+ }
+ sort { $a <=> $b }
+ map $_->{'phone'},
+ @{ $data->{'item'} }
+ ];
+
+ } elsif ( $opt{'state'} ) { #return regions
+
+ #[ map $_->{'region'}, @{ $data->{'item'} } ];
+ my %regions = map { $_ => 1 } map $_->{'region'}, @{ $data->{'item'} };
+ [ sort keys %regions ];
+
+ #} else { #nothing passed, return states (provinces)
+ # not really needed, we maintain our own list of provinces, but would
+ # help to hide the ones without availability (need to fix the selector too)
+ }
+
+
+}
+
+#insert, delete, etc... handled with shellcommands
+
+sub _export_insert {
+ #my( $self, $svc_phone ) = (shift, shift);
+}
+sub _export_delete {
+ #my( $self, $svc_phone ) = (shift, shift);
+}
+
+sub _export_replace { ''; }
+sub _export_suspend { ''; }
+sub _export_unsuspend { ''; }
+
+1;
default => join("\n",
),
},
+ 'suspend_data' => {
+ label => 'Suspend data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
+ 'unsuspend_data' => {
+ label => 'Unsuspend data',
+ type => 'textarea',
+ default => join("\n",
+ ),
+ },
'success_regexp' => {
label => 'Success Regexp',
default => '',
$self->_export_command('delete', @_);
}
+sub _export_suspend {
+ my $self = shift;
+ $self->_export_command('suspend', @_);
+}
+
+sub _export_unsuspend {
+ my $self = shift;
+ $self->_export_command('unsuspend', @_);
+}
+
sub _export_command {
my( $self, $action, $svc_x ) = ( shift, shift, shift );
return $error;
}
}
+ $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
}
my @del = grep { !exists $new{$_} } keys %old;
return $error;
}
}
+ $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
}
}
sub sqlradius_queue {
my( $self, $svcnum, $method ) = (shift, shift, shift);
- my %args = @_;
+ #my %args = @_;
my $queue = new FS::queue {
'svcnum' => $svcnum,
'job' => "FS::part_export::sqlradius::sqlradius_$method",
my $error = $err_or_queue->depend_insert( $jobnum );
return $error if $error;
}
+ $jobnum = $err_or_queue->jobnum; # chain all of these dependencies
}
if ( @newgroups ) {
sub rebless { shift; }
+sub get_dids_can_tollfree { 1; };
+
sub get_dids {
my $self = shift;
my %opt = ref($_[0]) ? %{$_[0]} : @_;
}
push @fields, sprintf('%05s', $branch),
sprintf('%03s', $bankno),
- sprintf('%012s', $account),
+ $account,
sprintf('%.02f', $cust_pay_batch->amount);
# DB = debit
push @fields, 'DB', $trans_code, $process_date;
# in use, yes?
my %hash = ( $ip_field => { op => '!=', value => '' } );
- $hash{'blocknum'} = $block->blocknum if $block;
+ #$hash{'blocknum'} = $block->blocknum if $block;
$hash{'svcnum'} = { op => '!=', value => $exclude->svcnum } if ref $exclude;
map { $_->NetAddr->addr } qsearch($class->table, \%hash);
}
$old->usergroup; # make sure this is cached for exports
- my $error = $new->process_m2m(
+ my $error = $new->check # make sure fixed fields are set before process_m2m
+ || $new->process_m2m(
'link_table' => 'radius_usergroup',
'target_table' => 'radius_group',
'params' => $new->usergroup,
t/svc_export_machine.t
FS/GeocodeCache.pm
t/GeocodeCache.t
+FS/log.pm
+t/log.t
+FS/log_context.pm
+t/log_context.t
use Getopt::Std;
use FS::UID qw(adminsuidsetup);
use FS::Conf;
+use FS::Log;
&untaint_argv; #what it sounds like (eww)
use vars qw(%opt);
my $user = shift or die &usage;
adminsuidsetup $user;
+my $log = FS::Log->new('daily');
+$log->info('start');
#you can skip this by not having a NetworkMonitoringSystem configured
use FS::Cron::nms_report qw(nms_report);
use FS::Cron::backup qw(backup);
backup();
+$log->info('finish');
+
###
# subroutines
###
-l: debugging level
- -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
+ -m: Multi-process mode uses the job queue for multi-process and/or multi-machine billing.
-r: Multi-process mode dry run option
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use Getopt::Std;
+use Date::Format qw(time2str);
+use File::Temp qw(tempdir);
+use Net::SFTP::Foreign;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+use FS::Conf;
+use Text::CSV;
+
+my %opt;
+getopts('va:P:C:', \%opt);
+
+#$Net::SFTP::Foreign::debug = -1;
+sub HELP_MESSAGE { '
+ Usage:
+ freeside-ipifony-download
+ [ -v ]
+ [ -a archivedir ]
+ [ -P port ]
+ [ -C category ]
+ freesideuser sftpuser@hostname[:path]
+' }
+
+my @fields = (
+ 'custnum',
+ 'date_desc',
+ 'quantity',
+ 'amount',
+ 'classname',
+);
+
+my $user = shift or die &HELP_MESSAGE;
+adminsuidsetup $user;
+
+# for statistics
+my $num_charges = 0;
+my $num_errors = 0;
+my $sum_charges = 0;
+# cache classnums
+my %classnum_of;
+
+if ( $opt{a} ) {
+ die "no such directory: $opt{a}\n"
+ unless -d $opt{a};
+ die "archive directory $opt{a} is not writable by the freeside user\n"
+ unless -w $opt{a};
+}
+
+my $categorynum = '';
+if ( $opt{C} ) {
+ # find this category (don't auto-create it, it should exist already)
+ my $category = qsearchs('pkg_category', { categoryname => $opt{C} });
+ if (!defined($category)) {
+ die "Package category '$opt{C}' does not exist.\n";
+ }
+ $categorynum = $category->categorynum;
+}
+
+#my $tmpdir = File::Temp->newdir();
+my $tmpdir = tempdir( CLEANUP => 1 ); #DIR=>somewhere?
+
+my $host = shift
+ or die &HELP_MESSAGE;
+my ($sftpuser, $path);
+$host =~ s/^(.+)\@//;
+$sftpuser = $1 || $ENV{USER};
+$host =~ s/:(.*)//;
+$path = $1;
+
+my $port = 22;
+if ( $opt{P} =~ /^(\d+)$/ ) {
+ $port = $1;
+}
+
+# for now assume SFTP download as the only method
+print STDERR "Connecting to $sftpuser\@$host...\n" if $opt{v};
+
+my $sftp = Net::SFTP::Foreign->new(
+ host => $host,
+ user => $sftpuser,
+ port => $port,
+ # for now we don't support passwords. use authorized_keys.
+ timeout => 30,
+ more => ($opt{v} ? '-v' : ''),
+);
+die "failed to connect to '$sftpuser\@$host'\n(".$sftp->error.")\n"
+ if $sftp->error;
+
+$sftp->setcwd($path) if $path;
+
+my $files = $sftp->ls('.', wanted => qr/\.csv$/, names_only => 1);
+if (!@$files) {
+ print STDERR "No charge files found.\n" if $opt{v};
+ exit(-1);
+}
+FILE: foreach my $filename (@$files) {
+ print STDERR "Retrieving $filename\n" if $opt{v};
+ $sftp->get("$filename", "$tmpdir/$filename");
+ if($sftp->error) {
+ warn "failed to download $filename\n";
+ next FILE;
+ }
+
+ # make sure server archive dir exists
+ if ( !$sftp->stat('Archive') ) {
+ print STDERR "Creating $path/Archive\n" if $opt{v};
+ $sftp->mkdir('Archive');
+ if($sftp->error) {
+ # something is seriously wrong
+ die "failed to create archive directory on server:\n".$sftp->error."\n";
+ }
+ }
+ #move to server archive dir
+ $sftp->rename("$filename", "Archive/$filename");
+ if($sftp->error) {
+ warn "failed to archive $filename on server:\n".$sftp->error."\n";
+ } # process it anyway, I guess/
+
+ #copy to local archive dir
+ if ( $opt{a} ) {
+ print STDERR "Copying $tmpdir/$filename to archive dir $opt{a}\n"
+ if $opt{v};
+ copy("$tmpdir/$filename", $opt{a});
+ warn "failed to copy $tmpdir/$filename to $opt{a}: $!" if $!;
+ }
+
+ open my $fh, "<$tmpdir/$filename";
+ my $header = <$fh>;
+ if ($header !~ /^cust_id/) {
+ warn "warning: $filename has incorrect header row:\n$header\n";
+ # but try anyway
+ }
+ my $csv = Text::CSV->new; # orthodox CSV
+ my %hash;
+ while (my $line = <$fh>) {
+ $csv->parse($line) or do {
+ warn "can't parse $filename: ".$csv->error_input."\n";
+ next FILE;
+ };
+ @hash{@fields} = $csv->fields();
+ my $cust_main = FS::cust_main->by_key($hash{custnum});
+ if (!$cust_main) {
+ warn "customer #$hash{custnum} not found\n";
+ next;
+ }
+ print STDERR "Found customer #$hash{custnum}: ".$cust_main->name."\n"
+ if $opt{v};
+
+ # construct arguments for $cust_main->charge
+ my %opt = (
+ amount => $hash{amount},
+ quantity => $hash{quantity},
+ start_date => $cust_main->next_bill_date,
+ pkg => $hash{date_desc},
+ );
+ if (my $classname = $hash{classname}) {
+ if (!exists($classnum_of{$classname}) ) {
+ # then look it up
+ my $pkg_class = qsearchs('pkg_class', {
+ classname => $classname,
+ categorynum => $categorynum,
+ });
+ if (!defined($pkg_class)) {
+ # then create it
+ $pkg_class = FS::pkg_class->new({
+ classname => $classname,
+ categorynum => $categorynum,
+ });
+ my $error = $pkg_class->insert;
+ die "Error creating package class for product code '$classname':\n".
+ "$error\n"
+ if $error;
+ }
+
+ $classnum_of{$classname} = $pkg_class->classnum;
+ }
+ $opt{classnum} = $classnum_of{$classname};
+ }
+ # XXX what's the tax status of these charges?
+ print STDERR " Charging $hash{amount}\n"
+ if $opt{v};
+ my $error = $cust_main->charge(\%opt);
+ if ($error) {
+ warn "Error creating charge: $error" if $error;
+ $num_errors++;
+ } else {
+ $num_charges++;
+ $sum_charges += $hash{amount};
+ }
+ } #while $line
+ close $fh;
+} #FILE
+
+if ($opt{v}) {
+ print STDERR "
+Finished!
+ Processed files: @$files
+ Created charges: $num_charges
+ Sum of charges: \$".sprintf('%0.2f', $sum_charges)."
+ Errors: $num_errors
+";
+}
+
+=head1 NAME
+
+freeside-eftca-download - Retrieve payment batch responses from EFT Canada.
+
+=head1 SYNOPSIS
+
+ freeside-eftca-download [ -v ] [ -a archivedir ] user
+
+=head1 DESCRIPTION
+
+Command line tool to download returned payment reports from the EFT Canada
+gateway and void the returned payments. Uses the login and password from
+'batchconfig-eft_canada'.
+
+-v: Be verbose.
+
+-a directory: Archive response files in the provided directory.
+
+user: freeside username
+
+=head1 BUGS
+
+You need to manually SFTP to ftp.eftcanada.com from the freeside account
+and accept their key before running this script.
+
+=head1 SEE ALSO
+
+L<FS::pay_batch>
+
+=cut
+
+1;
+
&untaint_argv; #what it sounds like (eww)
#use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y);
use vars qw(%opt);
-getopts("p:a:d:vsy:", \%opt);
+getopts("p:a:d:vsy:m", \%opt);
my $user = shift or die &usage;
adminsuidsetup $user;
-v: enable debugging
+ -m: Experimental multi-process mode (delay upload jobs until billing jobs complete)
+
user: From the mapsecrets file - see config.html from the base documentation
custnum: if one or more customer numbers are specified, only bills those
use FS::Record qw(qsearch);
use FS::queue;
use FS::queue_depend;
+use FS::Log;
# no autoloading for non-FS classes...
use Net::SSH 0.07;
}
}
+my $log = FS::Log->new('queue');
logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc );
warn "completing daemonization (detaching))\n" if $DEBUG;
foreach my $job ( @jobs ) {
+ $log->debug('locking queue job', object => $job);
+
my %hash = $job->hash;
$hash{'status'} = 'locked';
my $ljob = new FS::queue ( \%hash );
dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile');
#auto-use classes...
- if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg)::\w+)::/
+ if ( $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg|Cron)::\w+)::/
|| $ljob->job =~ /(FS::\w+)::/
)
{
}
my $eval = "&". $ljob->job. '(@args);';
+ # don't put @args in the log, may expose passwords
+ $log->info('starting job ('.$ljob->job.')');
warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG;
eval $eval; #throw away return value? suppose so
if ( $@ ) {
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::log;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::log_context;
+$loaded=1;
+print "ok 1\n";
<HTML><HEAD><TITLE>ISP Signup</TITLE></HEAD>
<BODY BGCOLOR="#e8e8e8"><FONT SIZE=7>ISP Signup - promotional code</FONT><BR><BR>
-<SCRIPT>
-function gotoURL(object) {
- window.location.href = 'signup.cgi?promo_code=' + object.promo_code.value;
-}
-</SCRIPT>
-<FORM>
+<FORM ACTION="signup.cgi" METHOD="GET">
Enter promotional code <INPUT TYPE="text" NAME="promo_code">
-<INPUT type="submit" VALUE="Signup" onClick="gotoURL(this.form)">
+<INPUT type="submit" VALUE="Signup">
</FORM>
</BODY>
'session_id' => $session_id,
'svcnum' => $svcnum,
'beginning' => str2time($cgi->param('start')." 00:00:00"),
- 'ending' => str2time($cgi->param('end')." 23:59:59"),
+ 'ending' => str2time($cgi->param('end') ." 23:59:59"),
);
my @usage = @{$res->{'usage'}};
my $png = $usage[0]->{'png'};
PerlSetVar MasonArgsMethod CGI
PerlModule HTML::Mason::ApacheHandler
+PerlChildInitHandler "sub { srand }"
+
PerlRequire "%%%MASON_HANDLER%%%"
#Locale::SubCountry
[
{
#'data' => $part_pkg->pkg. ' - '. $part_pkg->comment,
- 'data' => $type_pkgs->pkg. ' - '.
+ 'data' => encode_entities($type_pkgs->pkg). ' - '.
( $type_pkgs->custom ? '(CUSTOM) ' : '' ).
- $type_pkgs->comment,
+ encode_entities($type_pkgs->comment),
'align' => 'left',
'link' => $p. 'edit/part_pkg.cgi?'. $type_pkgs->pkgpart,
},
<TD CLASS="inv" BGCOLOR="<% $bgcolor %>">
<% itable() %>
% my %opt = $part_export->options;
-% foreach my $opt ( keys %opt ) {
+% my $defs = $part_export->info->{options};
+% my %multiples;
+% foreach my $opt (keys %$defs) { # is a Tie::IxHash
+% my $group = $defs->{$opt}->{multiple};
+% if ( $group ) {
+% my @values = split("\n", $opt{$opt});
+% $multiples{$group} ||= [];
+% push @{ $multiples{$group} }, [ $opt, @values ] if @values;
+% delete $opt{$opt};
+% } elsif (length($opt{$opt})) { # the normal case
+%# foreach my $opt ( keys %opt ) {
<TR>
<TD ALIGN="right" VALIGN="top" WIDTH="33%"><% $opt %>: </TD>
<TD ALIGN="left" WIDTH="67%"><% encode_entities($opt{$opt}) %></TD>
</TR>
-% }
-
+% delete $opt{$opt};
+% }
+% }
+% # now any that are somehow not in the options list
+% foreach my $opt (keys %opt) {
+% if ( length($opt{$opt}) ) {
+ <TR>
+ <TD ALIGN="right" VALIGN="top" WIDTH="33%"><% $opt %>: </TD>
+ <TD ALIGN="left" WIDTH="67%"><% encode_entities($opt{$opt}) %></TD>
+ </TR>
+% }
+% }
+% # now show any multiple-option groups
+% foreach (sort keys %multiples) {
+% my $set = $multiples{$_};
+ <TR><TD ALIGN="center" COLSPAN=2><TABLE CLASS="grid">
+ <TR>
+% foreach my $col (@$set) {
+ <TH><% shift @$col %></TH>
+% }
+ </TR>
+% while ( 1 ) {
+ <TR>
+% my $end = 1;
+% foreach my $col (@$set) {
+ <TD><% shift @$col %></TD>
+% $end = 0 if @$col;
+% }
+ </TR>
+% last if $end;
+% }
+ </TABLE></TD></TR>
+% } #foreach keys %multiples
+
</TABLE>
</TD>
'source_obj' => $agent_type,
'link_table' => 'type_pkgs',
'target_table' => 'part_pkg',
- 'name_callback' => sub { $_[0]->pkg_comment(nopkgpart => 1); },
+ 'name_callback' => sub { encode_entities( $_[0]->pkg_comment(nopkgpart => 1) ); },
'target_link' => $p.'edit/part_pkg.cgi?',
'disable-able' => 1,
configured in the rate tables.
<BR>
<FORM METHOD="POST" ACTION="<% "${p}edit/process/cdr_type.cgi" %>">
-<% include('/elements/auto-table.html',
- 'header' => [ 'Type#', 'Name' ],
- 'fields' => [ qw( cdrtypenum cdrtypename ) ],
+<TABLE ID="AutoTable" BORDER=0 CELLSPACING=0>
+ <TR>
+ <TH>Type#</TH>
+ <TH>Name</TH>
+ </TR>
+ <TR ID="cdr_template">
+ <TD>
+ <INPUT NAME="cdrtypenum" SIZE=16 MAXLENGTH=16 ALIGN="right">
+ </TD>
+ <TD>
+ <INPUT NAME="cdrtypename" SIZE=16 MAXLENGTH=16>
+ </TD>
+ </TR>
+<& /elements/auto-table.html,
+ 'template_row' => 'cdr_template',
'data' => \@data,
- ) %>
+&>
+</TABLE>
<INPUT TYPE="submit" VALUE="Apply changes"> </FORM> <BR>
<% include('/elements/footer.html') %>
<%init>
unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
my @data = (
- map { [ $_->cdrtypenum, $_->cdrtypename ] }
qsearch({
'table' => 'cdr_type',
'hashref' => {},
--- /dev/null
+<& /elements/header-popup.html, 'Credit line items' &>
+
+<FORM ACTION="process/credit-cust_bill_pkg.html" METHOD="POST">
+<INPUT TYPE="hidden" NAME="crednum" VALUE="">
+<INPUT TYPE="hidden" NAME="custnum" VALUE="<% $custnum |h %>">
+<INPUT TYPE="hidden" NAME="paybatch" VALUE="">
+<INPUT TYPE="hidden" NAME="_date" VALUE="<% time %>">
+<table>
+
+% my $old_invnum = 0;
+%# foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
+% foreach my $item ( @items ) {
+% my( $setuprecur, $cust_bill_pkg ) = @$item;
+
+% my $method = $setuprecur eq 'setup' ? 'setup' : 'recur';
+% my $amount = $cust_bill_pkg->$method();
+% my $credited = $cust_bill_pkg->credited('', '', 'setuprecur'=>$method);
+% $amount -= $credited;
+% $amount = sprintf('%.2f', $amount);
+% next unless $amount > 0;
+
+% if ( $cust_bill_pkg->invnum ne $old_invnum ) {
+ <TR><TD COLSPAN=3 BGCOLOR="#f8f8f8"> </TD></TR>
+ <TR><TH COLSPAN=3 BGCOLOR="#f8f8f8" ALIGN="left">Invoice #<% $cust_bill_pkg->invnum %> - <% time2str($date_format, $cust_bill_pkg->cust_bill->_date) %></TD></TR>
+% $old_invnum = $cust_bill_pkg->invnum;
+% }
+
+ <TR>
+ <TD>
+ <INPUT TYPE = "checkbox"
+ NAME = "billpkgnum<% $cust_bill_pkg->billpkgnum.'-'. $setuprecur %>"
+ VALUE = "<% $amount %>"
+ onClick = "calc_total(this)"
+ data-amount = "<% $amount %>"
+ data-billpkgnum = "<% $cust_bill_pkg->billpkgnum %>"
+ data-setuprecur = "<% $setuprecur %>"
+ >
+ </TD>
+ <TD BGCOLOR="#ffffff"><% $cust_bill_pkg->desc |h %></TD>
+%# show one-time/setup vs recur vs usage?
+ <TD BGCOLOR="#ffffff" ALIGN="right"><% $money_char. $amount %></TD>
+ </TR>
+
+% }
+
+<TR><TD COLSPAN=3 BGCOLOR="#f8f8f8"> </TD></TR>
+<TR>
+ <TD></TD>
+ <TD ALIGN="right">Subtotal: </TD>
+ <TD ALIGN="right" ID="subtotal_td"><% $money_char %><% sprintf('%.2f', 0) %></TD>
+</TR>
+<TR>
+ <TD></TD>
+ <TD ALIGN="right">Taxes: </TD>
+ <TD ALIGN="right" ID="taxtotal_td"><% $money_char %><% sprintf('%.2f', 0) %></TD>
+</TR>
+<TR>
+ <TD></TD>
+ <TH ALIGN="right">Total credit amount: </TD>
+ <TH ALIGN="right" ID="total_td"><% $money_char %><% sprintf('%.2f', 0) %></TD>
+</TR>
+<INPUT TYPE="hidden" NAME="amount" ID="total_el" VALUE="0.00">
+
+</table>
+
+<table>
+
+<& /elements/tr-select-reason.html,
+ 'field' => 'reasonnum',
+ 'reason_class' => 'R',
+ #XXX reconcile both this and show_taxes wanteding to enable this
+ 'control_button' => "document.getElementById('credit_button')",
+ 'cgi' => $cgi,
+&>
+
+<TR>
+ <TD ALIGN="right"><% mt('Additional info') |h %></TD>
+ <TD>
+ <INPUT TYPE="text" NAME="addlinfo" VALUE="<% $cgi->param('addlinfo') |h %>">
+ </TD>
+</TR>
+
+</table>
+
+<BR>
+<INPUT TYPE="submit" ID="credit_button" VALUE="Credit" DISABLED>
+
+</FORM>
+
+<% include( '/elements/xmlhttp.html',
+ 'url' => $p.'misc/xmlhttp-cust_bill_pkg-calculate_taxes.html',
+ 'subs' => [ 'calculate_taxes' ],
+ )
+%>
+<SCRIPT TYPE="text/javascript">
+
+function show_taxes(arg) {
+ var argsHash = eval('(' + arg + ')');
+
+ //XXX add an 'ErrorMessage' section to the HTML and re-enable
+ //var error = argsHash['error'];
+
+ //var paragraph = document.getElementById('ErrorMessage');
+ //if (error) {
+ // paragraph.innerHTML = 'Error: ' + error;
+ // paragraph.style.color = '#ff0000';
+ //} else {
+ // paragraph.innerHTML = '';
+ //}
+
+ var taxlines = argsHash['taxlines'];
+
+//XXX display the tax lines? just a total will do for now
+//
+// var table = document.getElementById('ApplicationTable');
+//
+// var aFoundRow = 0;
+// for (i = 0; taxlines[i]; i++) {
+// var itemdesc = taxlines[i][0];
+// var locnum = taxlines[i][2];
+// if (taxlines[i][3]) {
+// locnum = taxlines[i][3];
+// }
+//
+// var found = 0;
+// for (var row = 2; table.rows[row]; row++) {
+// var inputs = table.rows[row].getElementsByTagName('input');
+// if (! inputs.length) {
+// while ( table.rows[row] ) {
+// table.deleteRow(row);
+// }
+// break;
+// }
+// if ( inputs.item(4).value == itemdesc && inputs.item(2).value == locnum )
+// {
+// inputs.item(0).value = taxlines[i][1];
+// aFoundRow = found = row;
+// break;
+// }
+// }
+// if (! found) {
+// var row = table.insertRow(table.rows.length);
+// var warning_cell = document.createElement('TD');
+// warning_cell.style.color = '#ff0000';
+// warning_cell.colSpan = 2;
+// warning_cell.innerHTML = 'Calculated Tax - ' + itemdesc + ' - ' +
+// taxlines[i][1] + ' will not be applied';
+// row.appendChild(warning_cell);
+// }
+// }
+//
+// if (aFoundRow) {
+// sub_changed(table.rows[aFoundRow].getElementsByTagName('input').item(0));
+// }
+
+ var subtotal = parseFloat( argsHash['subtotal'] );
+
+ var taxtotal = parseFloat( argsHash['taxtotal'] );
+ document.getElementById('taxtotal_td').innerHTML =
+ '<% $money_char %>' + taxtotal.toFixed(2);
+
+ var total = subtotal + taxtotal;
+ document.getElementById('total_td').innerHTML =
+ '<% $money_char %>' + total.toFixed(2);
+ document.getElementById('total_el').value = total.toFixed(2);
+
+ //XXX reconcile both this and the reason selector wanteding to enable this
+ if ( total > 0 ) {
+ document.getElementById('credit_button').disabled = false;
+ }
+
+}
+
+function calc_total(what) {
+
+ document.getElementById('credit_button').disabled = true;
+
+ var subtotal = 0;
+ // bah, a pain, just using an attribute var re = /^billpkgnum(\d+)$/;
+
+ var el = what.form.elements;
+ var billpkgnums = [];
+ var setuprecurs = [];
+ var amounts = [];
+ for (var i=0; i<el.length; i++) {
+ if ( el[i].type == 'checkbox' && el[i].checked ) {
+ subtotal += parseFloat( el[i].getAttribute('data-amount') );
+ amounts.push( el[i].getAttribute('data-amount') );
+ billpkgnums.push( el[i].getAttribute('data-billpkgnum') );
+ setuprecurs.push( el[i].getAttribute('data-setuprecur') );
+ }
+ }
+
+ document.getElementById('subtotal_td').innerHTML =
+ '<% $money_char %>' + subtotal.toFixed(2);
+
+ var args = new Array(
+ 'custnum', '<% $custnum %>',
+ 'subtotal', subtotal,
+ 'billpkgnums', billpkgnums.join(),
+ 'setuprecurs', setuprecurs.join(),
+ 'amounts', amounts.join()
+ );
+
+ calculate_taxes( args, show_taxes );
+
+}
+</SCRIPT>
+
+<%init>
+
+my $curuser = $FS::CurrentUser::CurrentUser;
+die "access denied" unless $curuser->access_right('Post credit');
+
+#a tiny bit of false laziness w/search/cust_bill_pkg.cgi, but we're pretty
+# specialized and a piece of UI, not a report
+#slightly more false laziness w/httemplate/edit/elements/ApplicationCommon.html
+# show_taxes & calc_total here/do_calculate_tax there
+
+my $conf = new FS::Conf;
+my $money_char = $conf->config('money_char') || '$';
+my $date_format = $conf->config('date_format') || '%m/%d/%Y';
+
+$cgi->param('custnum') =~ /^(\d+)$/ or die 'illegal custnum';
+my $custnum = $1;
+
+my $cust_main = qsearchs({
+ 'table' => 'cust_main',
+ 'hashref' => { 'custnum' => $custnum },
+ 'extra_sql' => ' AND '. $curuser->agentnums_sql,
+}) or die 'unknown customer';
+
+my @cust_bill_pkg = qsearch({
+ 'select' => 'cust_bill_pkg.*',
+ 'table' => 'cust_bill_pkg',
+ 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
+ 'extra_sql' => "WHERE custnum = $custnum AND pkgnum != 0",
+ 'order_by' => 'ORDER BY invnum ASC, billpkgnum ASC',
+});
+
+my @items = map { my %hash = $_->disintegrate;
+ map [ $_, $hash{$_} ],
+ keys(%hash);
+ }
+ @cust_bill_pkg;
+
+#omit line items which have been previously credited? would be nice
+
+</%init>
<TD>
<INPUT TYPE="text" NAME="addlinfo" VALUE="<% $cgi->param('addlinfo') |h %>">
</TD>
+ </TR>
% if ( $conf->exists('credits-auto-apply-disable') ) {
<INPUT TYPE="HIDDEN" NAME="apply" VALUE="no">
--- /dev/null
+<%doc>
+</%doc>
+<& head.html, %opt &>
+<INPUT TYPE="hidden" NAME="options" VALUE="community,version,ip_addr_change_to_new,timeout">
+<& /elements/tr-select.html,
+ label => 'SNMP version',
+ field => 'version',
+ options => [ '', 'v1', 'v2c' ],
+ labels => { v1 => '1', v2c => '2c' },
+ curr_value => $part_export->option('version') &>
+<& /elements/tr-input-text.html,
+ label => 'Community',
+ field => 'community',
+ curr_value => $part_export->option('community'),
+&>
+<& /elements/tr-checkbox.html,
+ label => 'Send IP address changes to new address',
+ field => 'ip_addr_change_to_new',
+ value => 1,
+ curr_value => $part_export->option('ip_addr_change_to_new'),
+&>
+<& /elements/tr-input-text.html,
+ label => 'Timeout (seconds)',
+ field => 'timeout',
+ curr_value => $part_export->option('timeout'),
+&>
+</TABLE>
+<script type="text/javascript">
+function open_select_mib(obj) {
+ nd(1); // if there's already one open, close it
+ var rownum = obj.rownum;
+ var curr_oid = obj.value || '';
+ var url = '<%$fsurl%>/elements/select-mib-popup.html?' +
+ 'callback=receive_mib;' +
+ 'arg=' + rownum +
+ ';curr_value=' + curr_oid;
+ overlib(
+ OLiframeContent(url, 550, 450, '<% $popup_name %>', 0, 'auto'),
+ CAPTION, 'Select MIB object', STICKY, AUTOSTATUSCAP,
+ MIDX, 0, MIDY, 0, DRAGGABLE, CLOSECLICK,
+ BGCOLOR, '#333399', CGCOLOR, '#333399',
+ CLOSETEXT, 'Close'
+ );
+}
+function receive_mib(obj, rownum) {
+ //console.log(JSON.stringify(obj));
+ // we don't really need the numeric OID or any of the other properties
+ document.getElementById('oid'+rownum).value = obj.fullname;
+ document.getElementById('datatype'+rownum).value = obj.type;
+}
+</script>
+
+<table bgcolor="#cccccc" border=0 cellspacing=3>
+<TR>
+ <TH>Action</TH>
+ <TH>Object</TH>
+ <TH>Type</TH>
+ <TH>Value</TH>
+</TR>
+<TR id="mytemplate">
+ <TD>
+ <SELECT NAME="action">
+% foreach ('', qw(insert delete replace suspend unsuspend)) {
+ <OPTION VALUE="<%$_%>"><%$_%></OPTION>
+% }
+ </SELECT>
+ </TD>
+ <TD>
+ <INPUT NAME="oid" ID="oid" SIZE="60" onclick="open_select_mib(this)">
+ </TD>
+ <TD>
+ <INPUT TYPE="text" NAME="datatype" ID="datatype" READONLY=1>
+ </TD>
+ <TD>
+ <INPUT NAME="value" ID="value">
+ </TD>
+</TR>
+<& /elements/auto-table.html,
+ template_row => 'mytemplate',
+ fieldorder => ['action', 'oid', 'datatype', 'value'],
+ data => \@data,
+&>
+<INPUT TYPE="hidden" NAME="multi_options" VALUE="action,oid,datatype,value">
+<& foot.html, %opt &>
+<%init>
+my %opt = @_;
+my $part_export = $opt{part_export} || FS::part_export->new;
+
+my @actions = split("\n", $part_export->option('action'));
+my @oids = split("\n", $part_export->option('oid'));
+my @types = split("\n", $part_export->option('datatype'));
+my @values = split("\n", $part_export->option('value'));
+
+my @data;
+while (@actions or @oids or @values) {
+ my @thisrow = (shift(@actions), shift(@oids), shift(@types), shift(@values));
+ push @data, \@thisrow if grep length($_), @thisrow;
+}
+
+my $popup_name = 'popup-'.time."-$$-".rand() * 2**32;
+</%init>
--- /dev/null
+</TABLE>
+<INPUT TYPE="hidden" NAME="nodomain" VALUE="<% $opt{export_info}{nodomain} %>">
+<INPUT TYPE="submit" VALUE="<% $opt{part_export}->exportnum ? 'Apply changes' : 'Add export' %>">
+<%init>
+my %opt = @_;
+</%init>
--- /dev/null
+% if ( $export_info->{no_machine} ) {
+<INPUT TYPE="hidden" NAME="machine" VALUE="">
+<INPUT TYPE="hidden" NAME="svc_machine" VALUE="N">
+% } else {
+% # clone this from edit/part_export.cgi if this case ever gets used
+% }
+<INPUT TYPE="hidden" NAME="exporttype" VALUE="<%$layer |h%>">
+<% ntable('cccccc', 2) %>
+<TR>
+ <TD ALIGN="right" ><% emt('Description') %></TD>
+ <TD BGCOLOR="#ffffff" WIDTH="600"><% $notes %></TD>
+</TR>
+<%init>
+my %opt = @_;
+my $layer = $opt{layer};
+my $part_export = $opt{part_export};
+my $export_info = $opt{export_info};
+my $notes = $opt{notes} || $export_info->{notes};
+</%init>
'html_between' => "</TD></TR></TABLE>\n",
'layer_callback' => sub {
my $layer = shift;
+ # create 'config_element' to generate the whole layer with a Mason component
+ if ( my $include = $exports->{$layer}{config_element} ) {
+ # might need to adjust the scope of this at some point
+ return $m->scomp($include,
+ part_export => $part_export,
+ layer => $layer,
+ export_info => $exports->{$layer}
+ );
+ }
my $html = qq!<INPUT TYPE="hidden" NAME="exporttype" VALUE="$layer">!.
ntable("#cccccc",2);
my $warning =
'Changing the setup or recurring fee will create a new package definition. '.
'Continue?';
-
+
+$javascript .= "function confirm_submit(f) {";
if ( $conf->exists('part_pkg-lineage') ) {
$javascript .= "
- function confirm_submit(f) {
-
- var fields = Array('setup_fee','recur_fee');
- for(var i=0; i < fields.length; i++) {
- if ( f[fields[i]].value != f[fields[i]].defaultValue ) {
- return confirm('$warning');
- }
- }
- return true;
+
+ var fields = Array('setup_fee','recur_fee');
+ for(var i=0; i < fields.length; i++) {
+ if ( f[fields[i]].value != f[fields[i]].defaultValue ) {
+ return confirm('$warning');
+ }
}
";
}
-
-$javascript .= '</SCRIPT>';
+$javascript .= "
+ return true;
+}
+</SCRIPT>";
tie my %plans, 'Tie::IxHash', %{ FS::part_pkg::plan_info() };
unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
my %vars = $cgi->Vars;
-warn Dumper(\%vars)."\n";
my %old = map { $_->cdrtypenum => $_ } qsearch('cdr_type', {});
--- /dev/null
+%if ($error) {
+% errorpage_popup($error); #XXX redirect back for correction...
+%} else {
+<& /elements/header-popup.html, 'Credit successful' &>
+ <SCRIPT TYPE="text/javascript">
+ window.top.location.reload();
+ </SCRIPT>
+ </BODY></HTML>
+% }
+<%init>
+
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('Post credit');
+
+my @billpkgnum_setuprecurs =
+ map { $_ =~ /^billpkgnum(\d+\-\w*)$/ or die 'gm#23'; $1; }
+ grep { $_ =~ /^billpkgnum\d+\-\w*$/ && $cgi->param($_) } $cgi->param;
+
+my @billpkgnums = ();
+my @setuprecurs = ();
+my @amounts = ();
+foreach my $billpkgnum_setuprecur (@billpkgnum_setuprecurs) {
+ my $amount = $cgi->param("billpkgnum$billpkgnum_setuprecur");
+ my( $billpkgnum, $setuprecur ) = split('-', $billpkgnum_setuprecur);
+ push @billpkgnums, $billpkgnum;
+ push @setuprecurs, $setuprecur;
+ push @amounts, $amount;
+}
+
+my $error = FS::cust_credit->credit_lineitems(
+ #the lineitems to credit
+ 'billpkgnums' => \@billpkgnums,
+ 'setuprecurs' => \@setuprecurs,
+ 'amounts' => \@amounts,
+
+ #the credit
+ 'newreasonnum' => scalar($cgi->param('newreasonnum')),
+ 'newreasonnum_type' => scalar($cgi->param('newreasonnumT')),
+ map { $_ => scalar($cgi->param($_)) }
+ #fields('cust_credit')
+ qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
+);
+
+</%init>
%
% $dbh->commit or die $dbh->errstr if $oldAutoCommit;
%
-<% header(emt('Credit sucessful')) %>
+<% header(emt('Credit successful')) %>
<SCRIPT TYPE="text/javascript">
window.top.location.reload();
</SCRIPT>
die "access denied"
unless $FS::CurrentUser::CurrentUser->access_right('Post credit');
-$cgi->param('custnum') =~ /^(\d*)$/ or die "Illegal custnum!";
+$cgi->param('custnum') =~ /^(\d+)$/ or die "Illegal custnum!";
my $custnum = $1;
$cgi->param('reasonnum') =~ /^(-?\d+)$/ or die "Illegal reasonnum";
my $old = qsearchs('part_export', { 'exportnum'=>$exportnum } ) if $exportnum;
+my %vars = $cgi->Vars;
#fixup options
#warn join('-', split(',',$cgi->param('options')));
my %options = map {
- my @values = $cgi->param($_);
- my $value = scalar(@values) > 1 ? join (' ', @values) : $values[0];
+ my $value = $vars{$_};
+ $value =~ s/\0/ /g; # deal with multivalued options
$value =~ s/\r\n/\n/g; #browsers? (textarea)
$_ => $value;
} split(',', $cgi->param('options'));
+# deal with multiline options
+# %vars should never contain incomplete rows, but just in case it does,
+# we make a list of all the row indices that contain values, and
+# then write a line in each option for each row, even if it's empty.
+# This ensures that all values with the same row index line up.
+my %optionrows;
+foreach my $option (split(',', $cgi->param('multi_options'))) {
+ $optionrows{$option} = {};
+ my %values; # bear with me
+ for (keys %vars) {
+ /^$option(\d+)/ or next;
+ $optionrows{$option}{$1} = $vars{$option.$1};
+ $optionrows{_ALL_}{$1} = 1 if length($vars{$option.$1});
+ }
+}
+foreach my $option (split(',', $cgi->param('multi_options'))) {
+ my $value = '';
+ foreach my $row (sort keys %{$optionrows{_ALL_}}) {
+ $value .= ($optionrows{$option}{$row} || '') . "\n";
+ }
+ chomp($value);
+ $options{$option} = $value;
+}
+
my $new = new FS::part_export ( {
map {
$_, scalar($cgi->param($_));
<TD><INPUT TYPE="text" NAME="ratetimename" VALUE="<% $rate_time ? $rate_time->ratetimename : '' %>"></TD>
</TR>
</TABLE>
-<% include('/elements/auto-table.html',
- 'header' => [ '', 'Start','','', '','End','','' ],
- 'fields' => [ qw(sd sh sm sa ed eh em ea) ],
- 'select' => [ ($day, $hour, $min, $ampm) x 2 ],
- 'data' => \@data,
- ) %>
+<TABLE>
+ <TR>
+ <TH COLSPAN=4 ALIGN="center">Start</TH>
+ <TH COLSPAN=4 ALIGN="center">End</TH>
+ </TR>
+ <TR id="mytemplate">
+% for my $pre (qw(s e)) {
+% for my $f (qw(d h m a)) { # day, hour, minute, am/pm
+ <TD>
+ <SELECT NAME="<%$pre.$f%>">
+% my $i = 0;
+% while ($i < @{ $choices{$f} }) {
+ <OPTION VALUE="<%$choices{$f}[$i]%>">
+% $i++;
+ <%$choices{$f}[$i]%></OPTION>
+% $i++;
+% }
+ </SELECT>
+ </TD>
+% } #$f
+% } #$pre
+ </TR>
+<& /elements/auto-table.html,
+ 'template_row' => 'mytemplate',
+ 'data' => \@data,
+ 'fieldorder' => [qw(sd sh sm sa ed eh em ea)],
+&>
+</TABLE>
<INPUT TYPE="submit" VALUE="<% $rate_time ? 'Apply changes' : 'Add period'%>">
</FORM>
<BR>
my $hour = [ map( {$_, sprintf('%02d',$_) } 12, 1..11 )];
my $min = [ map( {$_, sprintf('%02d',$_) } 0,30 )];
my $ampm = [ 0 => 'AM', 1 => 'PM' ];
-
+my %choices = (
+ 'd' => $day,
+ 'h' => $hour,
+ 'm' => $min,
+ 'a' => $ampm,
+);
if($ratetimenum) {
$action = 'Edit';
$rate_time = qsearchs('rate_time', {ratetimenum => $ratetimenum})
<%doc>
-
-Example:
-<% include('/elements/auto-table.html',
-
- ###
- # required
- ###
-
- 'header' => [ '#', 'Item', 'Amount' ],
- 'fields' => [ 'id', 'name', 'amount' ],
-
- ###
- # highly recommended
- ###
-
- 'size' => [ 4, 12, 8 ],
- 'maxl' => [ 4, 12, 8 ],
- 'align' => [ 'right', 'left', 'right' ],
-
- ###
- # optional
- ###
-
- 'data' => [ [ 1, 'Widget', 25 ],
- [ 12, 'Super Widget, 7 ] ],
- #or
- 'records' => [ qsearch('item', { } ) ],
- # or any other array of FS::Record objects
-
- 'select' => [ '',
- [ 1 => 'option 1',
- 2 => 'option 2', ...
- ], # options for second field
- '' ],
-
- 'prefix' => 'mytable_',
-) %>
-
-Values will be passed through as "mytable_id1", etc.
+(within a form)
+<table>
+<tr>
+ <th>Field 1</th>
+ <th>Field 2</th>
+</tr>
+<tr id="mytemplate">
+ <td><input type="text" name="field1"></td>
+ <td><select name="field2">...</td>
+ ...
+</tr>
+</table>
+<& /elements/auto-table.html,
+ table => 'mytable',
+ template_row = 'mytemplate',
+ rows => [
+ { field1 => 'foo', field2 => 'CA', ... },
+ { field1 => 'bar', field2 => 'TX', ... }, ...
+ ],
+&>
+
+ or if you prefer:
+...
+ fieldorder => [ 'field1', 'field2', ... ],
+ rows => [
+ [ 'foo', 'CA' ],
+ [ 'bar', 'TX' ],
+ ],
+
+In the process/ handler, something like:
+my @rows;
+my %vars = $cgi->Vars;
+for my $k ( keys %vars ) {
+ $k =~ /^${pre}magic(\d+)$/ or next;
+ my $rownum = $1;
+ # find all submitted names ending in this rownum
+ my %thisrow =
+ map { $_ => $vars{$_} }
+ grep /^(.*[\d])$rownum$/, keys %vars;
+ $thisrow->{num} = delete $thisrow{"${pre}magic$rownum"};
+ push @rows, $thisrow;
+}
</%doc>
-
-<TABLE ID="<% $prefix %>AutoTable" BGCOLOR="#cccccc" BORDER=0 CELLSPACING=0>
- <TR>
-% foreach (@header) {
- <TH><% $_ %></TH>
-% }
- </TR>
-% my $row = 0;
-% for ( $row = 0; $row < scalar @data; $row++ ) {
- <TR>
-% my $col = 0;
-% for ( $col = 0; $col < scalar @fields; $col++ ) {
-% my $id = $prefix . $fields[$col];
-% # don't suffix rownum in the final, blank row
-% $id .= $row if $row < (scalar @data) - 1;
- <TD>
-% my @o = @{ $select[$col] };
-% if( @o ) {
- <SELECT NAME="<% $id %>" ID="<% $id %>">
-% while(@o) {
-% my $val = shift @o;
- <OPTION VALUE=<% $val %><%
-$val eq $data[$row][$col] ? ' SELECTED' : ''%>><% shift @o %></OPTION>
-% }
- </SELECT>
-% }
-% else {
- <INPUT TYPE = "text"
- NAME = "<% $id %>"
- ID = "<% $id %>"
- SIZE = <% $size[$col] %>
- MAXLENGTH = <% $maxl[$col] %>
- STYLE = "text-align:<% $align[$col] %>"
- VALUE = "<% $data[$row][$col] %>"
-% if( $opt{'autoadd'} ) {
- onchange = "possiblyAddRow(this);"
-% }
- >
- </TD>
-% }
-% }
- <TD>
- <IMG SRC = "<% "${p}images/cross.png" %>"
- ALT = "X"
- onclick = "deleteRow(this);"
- >
- </TD>
- </TR>
-% }
-</TABLE>
-% if( !$opt{'autoadd'} ) {
-<INPUT TYPE="button" VALUE="Add" onclick="<% $prefix %>addRow();"><BR>
-% }
-
-<SCRIPT TYPE="text/javascript">
- var <% $prefix %>rownum = <% $row %>;
- var <% $prefix %>table = document.getElementById('<% $prefix %>AutoTable');
- // last row is initially blank, clone it and remove it
- var <% $prefix %>_blank =
- <% $prefix %>table.rows[<% $prefix %>table.rows.length-1].cloneNode(true);
-% if( !$opt{'autoadd'} ) {
- <% $prefix %>table.deleteRow(<% $prefix %>table.rows.length-1);
-% }
-
-
-
- function rownum_of(obj) {
- return (obj.parentNode.parentNode.sectionRowIndex);
+<tbody id="<%$pre%>autotable"></tbody>
+<script type="text/javascript">
+var <%$pre%>template;
+var <%$pre%>tbody;
+var <%$pre%>next_rownum;
+var <%$pre%>set_rownum;
+var <%$pre%>addRow;
+var <%$pre%>deleteRow;
+var <%$pre%>fieldorder = <% to_json($fieldorder) %>;
+
+function <%$pre%>possiblyAddRow_factory(obj) {
+ var callback = obj.onchange;
+ return function() {
+ if ( obj.rownum == <%$pre%>tbody.lastChild.rownum ) {
+ // then this is the last row, and it's being changed, so spawn a new row
+ <%$pre%>addRow();
+ }
+ if ( callback ) {
+ callback.apply(obj);
+ }
}
+}
- function <% $prefix %>possiblyAddRow(obj) {
- if ( <% $prefix %>rownum == rownum_of(obj) ) {
- <% $prefix %>addRow();
+function <%$pre%>set_rownum(obj, rownum) {
+ obj.rownum = rownum;
+ if ( obj.id ) {
+ obj.id = obj.id + rownum;
+ }
+ if ( obj.name ) {
+ obj.name = obj.name + rownum;
+ // also, in this case it's a form field that will be part of the record
+ // so set up an onchange handler
+ obj.onchange = <%$pre%>possiblyAddRow_factory(obj);
+ }
+ for (var i = 0; i < obj.children.length; i++) {
+ if ( obj.children[i] instanceof Node ) {
+ <%$pre%>set_rownum(obj.children[i], rownum);
}
}
+}
- function <% $prefix %>addRow() {
- var row = <% $prefix %>table.insertRow(-1);
- var cells = <% $prefix %>_blank.cells;
- for (i=0; i<cells.length; i++) {
- var node = row.appendChild(cells[i].cloneNode(true));
- var input = node.children[0];
- input.id = input.id + row.sectionRowIndex;
- input.name = input.name + row.sectionRowIndex;
+function <%$pre%>addRow(data) {
+ // duplicate the node
+ // warning: cloneNode doesn't clone event handlers that were set through
+ // the DOM
+ // if 'data' is an object, prepopulate the row's fields with the object's
+ // elements
+ // returns the rownum of the new row
+ var row = <%$pre%>template.cloneNode(true);
+ <%$pre%>tbody.appendChild(row);
+ var this_rownum = <%$pre%>next_rownum;
+ <%$pre%>set_rownum(row, this_rownum);
+ if(data instanceof Array) {
+ for (i = 0; i < data.length && i < <%$pre%>fieldorder.length; i++) {
+ var el = document.getElementsByName(<%$pre%>fieldorder[i] + this_rownum)[0];
+ if (el) {
+ el.value = data[i];
+ }
+ }
+ } else if (data instanceof Object) {
+ for (var field in data) {
+ var el = document.getElementsByName(field + this_rownum)[0];
+ if (el) {
+ el.value = data[field];
+% # doesn't work for checkbox
+ }
}
- <% $prefix %>rownum++;
+ } // else nothing
+ <%$pre%>next_rownum++;
+ return this_rownum;
+}
+
+function <%$pre%>deleteRow(rownum) {
+ if ( rownum == <%$pre%>tbody.lastChild.rownum ) {
+ // if this is the last row, spawn another one after it
+ <%$pre%>addRow();
}
+ var r = document.getElementById('<%$pre%>row' + rownum);
+ <%$pre%>tbody.removeChild(r);
+}
- function deleteRow(obj) {
- if(<% $prefix %>rownum == rownum_of(obj)) {
- <% $prefix %>addRow();
- }
- <% $prefix %>table.deleteRow(rownum_of(obj));
- <% $prefix %>rownum--;
- return(false);
+function <%$pre%>init() {
+ <%$pre%>template = document.getElementById(<% $template_row |js_string%>);
+ <%$pre%>tbody = document.getElementById('<%$pre%>autotable');
+ <%$pre%>next_rownum = <%$pre%>template.sectionRowIndex;
+ // detach the template row
+ var table = <%$pre%>template.parentNode;
+ table.removeChild(<%$pre%>template);
+ // give it an id
+ <%$pre%>template.id = <%$pre |js_string%> + 'row';
+ // and a magic identifier so we know it's been submitted
+ var magic = document.createElement('INPUT');
+ magic.setAttribute('type', 'hidden');
+ magic.setAttribute('name', '<%$pre%>magic');
+ magic.value = '1';
+ // and a delete button
+%# should this be enclosed in an actual <button> for aesthetics?
+ var delete_button = document.createElement('IMG');
+ delete_button.id = 'delete_button';
+ delete_button.src = '<%$fsurl%>images/cross.png';
+ delete_button.alt = 'X';
+ // use an inline string for this so that it will be cloned properly
+ delete_button.setAttribute('onclick', "<%$pre%>deleteRow(this.rownum);");
+ var delete_cell = document.createElement('TD');
+ delete_cell.appendChild(delete_button);
+ delete_cell.appendChild(magic); // it has to go somewhere
+ <%$pre%>template.appendChild(delete_cell);
+
+ // preload rows
+ var rows = <% to_json(\@rows) %>;
+ for (var i = 0; i < rows.length; i++) {
+ <%$pre%>addRow(rows[i]);
}
-</SCRIPT>
+ <%$pre%>addRow();
+}
+<%$pre%>init();
+</script>
<%init>
my %opt = @_;
-
-my @header = @{ $opt{'header'} };
-my @fields = @{ $opt{'fields'} };
-my @data = ();
-if($opt{'data'}) {
- @data = @{ $opt{'data'} };
-}
-elsif($opt{'records'}) {
- foreach my $rec (@{ $opt{'records'} }) {
- push @data, [ map { $rec->getfield($_) } @fields ];
+my $pre = '';
+$pre = $opt{'table'} . '_' if $opt{'table'};
+my $template_row = $opt{'template_row'}
+ or die "auto-table requires template_row\n"; # a DOM id
+
+# rows that we will preload, as hashrefs of name => value
+my @rows = @{ $opt{'data'} || [] };
+foreach (@rows) {
+ # allow an array of FS::Record objects to be passed
+ if ( blessed($_) and $_->isa('FS::Record') ) {
+ $_ = $_->hashref;
}
}
-# else @data = ();
-push @data, [ map {''} @fields ]; # make a blank row
-
-my $prefix = $opt{'prefix'};
-my @size = $opt{'size'} ? @{ $opt{'size'} } : (map {16} @fields);
-my @maxl = $opt{'maxl'} ? @{ $opt{'maxl'} } : @size;
-my @align = $opt{'align'} ? @{ $opt{'align'} } : (map {'right'} @fields);
-my @select = @{ $opt{'select'} || [] };
-foreach (0..scalar(@fields)-1) {
- $select[$_] ||= [];
-}
+my $fieldorder = $opt{'fieldorder'} || [];
</%init>
'Open invoices' => [ \%report_invoices_open, 'Open invoices' ],
'All invoices' => [ $fsurl. 'search/cust_bill.html?date', 'List all invoices' ],
'Advanced invoice reports' => [ $fsurl.'search/report_cust_bill.html', 'by agent, date range, etc.' ],
+ 'separator' => '',
+ 'Line items' => [ $fsurl. 'search/report_cust_bill_pkg.html', 'Individual line item detail' ],
;
tie my %report_discounts, 'Tie::IxHash',
}
tie my %report_packages, 'Tie::IxHash';
-if ( $curuser->access_right('Edit package definitions')
- || $curuser->access_right('Edit global package definitions')
- )
-{
- $report_packages{'Package definitions (by # active)'} = [ $fsurl.'browse/part_pkg.cgi?active=1', 'Package definitions by number of active packages' ];
- $report_packages{'separator'} = '';
-}
+$report_packages{'Package definitions (by # active)'} = [ $fsurl.'browse/part_pkg.cgi?active=1', 'Package definitions by number of active packages' ]
+ if $curuser->access_right('Edit package definitions')
+ || $curuser->access_right('Edit global package definitions');
+$report_packages{'Package Costs Report'} = [ $fsurl.'graph/report_cust_pkg_cost.html', 'Package setup and recurring costs graph' ]
+ if $curuser->access_right('Financial reports');
+$report_packages{'separator'} = ''
+ if keys %report_packages;
if ( $curuser->access_right('Financial reports') ) {
$report_packages{'Package churn'} = [ $fsurl.'graph/report_cust_pkg.html', 'Orders, suspensions and cancellations summary graph' ];
$report_packages{'separator2'} = '';
'Advanced ticket reports' => [ $fsurl.'rt/Search/Build.html?NewQuery=1', 'List tickets by any criteria' ],
;
+tie my %report_employees, 'Tie::IxHash',
+ 'Employee Commission Report' => [ $fsurl.'search/report_employee_commission.html', '' ],
+ 'Employee Audit Report' => [ $fsurl.'search/report_employee_audit.html', 'Employee audit report' ],
+;
+
tie my %report_bill_event, 'Tie::IxHash',
'All billing events' => [ $fsurl.'search/report_cust_event.html', 'All billing events for a date range' ],
'Billing event errors' => [ $fsurl.'search/report_cust_event.html?failed=1', 'Failed credit cards, processor or printer problems, etc.' ],
$report_payments{'Deleted Payments / Payment history table'} = [ $fsurl.'search/report_h_cust_pay.html', 'Deleted payments / payment history table' ]
if $conf->exists('payment-history-report');
+tie my %report_credits, 'Tie::IxHash',
+ 'Credit Report' => [ $fsurl.'search/report_cust_credit.html', 'Credit report (by employee and/or date range)' ],
+ 'Credit application detail' => [ $fsurl.'search/report_cust_credit_bill_pkg.html', 'Line item application detail' ],
+ 'Unapplied Credits' => [ $fsurl.'search/report_cust_credit.html?unapplied=1', 'Unapplied credit report (by type and/or date range)' ],
+;
+
+tie my %report_refunds, 'Tie::IxHash',
+ 'Refund Report' => [ $fsurl.'search/report_cust_refund.html', 'Refund report (by type and/or date range)' ],
+ 'Unapplied Refunds' => [ $fsurl.'search/report_cust_refund.html?unapplied=1', 'Unapplied refund report (by type and/or date range)' ],
+;
+
+tie my %report_sales, 'Tie::IxHash',
+ 'Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time.html', 'Sales, credits and receipts summary graph' ],
+ 'Daily Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time_daily.html', 'Sales, credits and receipts (broken down by day) summary graph' ],
+ 'Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg.html', 'Sales report and graph (by agent, package class and/or date range)' ],
+ 'Rated Call Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg_detail.html', 'Sales report and graph (by agent, package class, usage class and/or date range)' ],
+ 'Sales With Advertising Source' => [ $fsurl.'search/report_cust_bill_pkg_referral.html' ],
+;
+
tie my %report_financial, 'Tie::IxHash';
-if($curuser->access_right('Financial reports')) {
+if( $curuser->access_right('Financial reports') ) {
%report_financial = (
- 'Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time.html', 'Sales, credits and receipts summary graph' ],
- 'Daily Sales, Credits and Receipts' => [ $fsurl.'graph/report_money_time_daily.html', 'Sales, credits and receipts (broken down by day) summary graph' ],
- 'Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg.html', 'Sales report and graph (by agent, package class and/or date range)' ],
- 'Rated Call Sales Report' => [ $fsurl.'graph/report_cust_bill_pkg_detail.html', 'Sales report and graph (by agent, package class, usage class and/or date range)' ],
- 'Sales With Advertising Source' => [ $fsurl.'search/report_cust_bill_pkg_referral.html' ],
- 'Employee Commission Report' => [ $fsurl.'search/report_employee_commission.html', '' ],
- 'Credit Report' => [ $fsurl.'search/report_cust_credit.html', 'Credit report (by employee and/or date range)' ],
- 'Unapplied Credits' => [ $fsurl.'search/report_cust_credit.html?unapplied=1', 'Unapplied credit report (by type and/or date range)' ],
- 'Refund Report' => [ $fsurl.'search/report_cust_refund.html', 'Refund report (by type and/or date range)' ],
- 'Unapplied Refunds' => [ $fsurl.'search/report_cust_refund.html?unapplied=1', 'Unapplied refund report (by type and/or date range)' ],
- 'Package Costs Report' => [ $fsurl.'graph/report_cust_pkg_cost.html', 'Package setup and recurring costs graph' ],
- 'Employee Audit Report' => [ $fsurl.'search/report_employee_audit.html', 'Employee audit report' ],
+ 'Sales' => [ \%report_sales, 'Sales reports', ],
+ 'Credits' => [ \%report_credits, 'Credit reports', ],
+ 'Refunds' => [ \%report_refunds, 'Refund reports', ],
);
$report_financial{'A/R Aging'} = [ $fsurl.'search/report_receivables.html', 'Accounts Receivable Aging report' ];
$report_financial{'Prepaid Income'} = [ $fsurl.'search/report_prepaid_income.html', 'Prepaid income (unearned revenue) report' ];
} # else $report_financial contains nothing.
+tie my %report_logs, 'Tie::IxHash';
+ $report_logs{'System log'} = [ $fsurl.'search/log.html', 'View system events and debugging information.' ],
+ if $curuser->access_right('View system logs')
+ || $curuser->access_right('Configuration');
+ $report_logs{'Outgoing messages'} = [ $fsurl.'search/cust_msg.html', 'View outgoing message log' ]
+ if $curuser->access_right('View email logs')
+ || $curuser->access_right('Configuration');
+
tie my %report_menu, 'Tie::IxHash';
-$report_menu{'Prospects'} = [ \%report_prospects, 'Prospect reports' ]
+$report_menu{'Prospects'} = [ \%report_prospects, 'Prospect reports' ]
if $curuser->access_right('List prospects');
-$report_menu{'Quotations'} = [ \%report_quotations, 'Quotation reports' ]
+$report_menu{'Quotations'} = [ \%report_quotations, 'Quotation reports' ]
if $curuser->access_right('List quotations');
-$report_menu{'Customers'} = [ \%report_customers, 'Customer reports' ]
+$report_menu{'Customers'} = [ \%report_customers, 'Customer reports' ]
if $curuser->access_right('List customers');
-$report_menu{'Invoices'} = [ \%report_invoices, 'Invoice reports' ]
+$report_menu{'Invoices'} = [ \%report_invoices, 'Invoice reports' ]
if $curuser->access_right('List invoices');
-$report_menu{'Discounts'} = [ \%report_discounts, 'Discount reports' ]
+$report_menu{'Discounts'} = [ \%report_discounts, 'Discount reports' ]
if $curuser->access_right('Financial reports');
-$report_menu{'Payments'} = [ \%report_payments, 'Payment reports' ]
+$report_menu{'Payments'} = [ \%report_payments, 'Payment reports' ]
if $curuser->access_right('Financial reports');
-$report_menu{'Packages'} = [ \%report_packages, 'Package reports' ]
+$report_menu{'Packages'} = [ \%report_packages, 'Package reports' ]
if $curuser->access_right('List packages');
-$report_menu{'Services'} = [ \%report_services, 'Services reports' ]
+$report_menu{'Services'} = [ \%report_services, 'Services reports' ]
if $curuser->access_right('List services');
-$report_menu{'Inventory'} = [ \%report_inventory, 'Inventory reports' ]
+$report_menu{'Inventory'} = [ \%report_inventory, 'Inventory reports' ]
if $curuser->access_right('Configuration'); #XXX List inventory?
-$report_menu{'Usage'} = [ \%report_rating, 'Usage reports' ]
+$report_menu{'Usage'} = [ \%report_rating, 'Usage reports' ]
if $curuser->access_right('List rating data');
-$report_menu{'Tickets'} = [ \%report_ticketing, 'Ticket reports' ]
+$report_menu{'Tickets'} = [ \%report_ticketing, 'Ticket reports' ]
if $conf->config('ticket_system')
;#&& FS::TicketSystem->access_right(\%session, 'Something');
+$report_menu{'Employees'} = [ \%report_employees, 'Employee reports' ]
+ if $curuser->access_right('Financial reports');
$report_menu{'Billing events'} = [ \%report_bill_event, 'Billing events' ]
if $curuser->access_right('Billing event reports');
-$report_menu{'Financial'} = [ \%report_financial, 'Financial reports' ]
+$report_menu{'Financial'} = [ \%report_financial, 'Financial reports' ]
if $curuser->access_right('Financial reports')
or $curuser->access_right('Receivables report');
-$report_menu{'SQL Query'} = [ $fsurl.'search/report_sql.html', 'SQL Query' ]
+$report_menu{'Logs'} = [ \%report_logs, 'System and email logs' ]
+ if (keys %report_logs); # empty if the user has no rights to it
+$report_menu{'SQL Query'} = [ $fsurl.'search/report_sql.html', 'SQL Query']
if $curuser->access_right('Raw SQL');
tie my %tools_importing, 'Tie::IxHash',
if $curuser->access_right('Time queue');
$tools_menu{'Attachments'} = [ $fsurl.'browse/cust_attachment.html', 'View customer attachments' ]
if !$conf->config('disable_cust_attachment') and $curuser->access_right('View attachments') and $curuser->access_right('Browse attachments');
-$tools_menu{'Outgoing messages'} = [ $fsurl.'search/cust_msg.html', 'View outgoing message log' ] #shouldn't this be in the reports menu?
- if $curuser->access_right('View email logs');
$tools_menu{'Importing'} = [ \%tools_importing, 'Import tools' ]
if $curuser->access_right('Import');
$tools_menu{'Exporting'} = [ \%tools_exporting, 'Export tools' ]
<A NOTYET="<%$fsurl%>search/svc_Smarter.html" STYLE="color: #cccccc; font-size:11px"><% mt('Advanced') |h %></A>
<INPUT TYPE="submit" VALUE="<% mt('Search services') |h %>" CLASS="fsblackbutton" onMouseOver="this.className='fsblackbuttonselected'; return true;" onMouseOut="this.className='fsblackbutton'; return true;" STYLE="font-size:11px">
</FORM>
- <% $menu_position eq 'left' ? '<BR>' : '' %>
+ <% $menu_position eq 'left' ? '<BR>' : '' |n %>
% }
<A HREF="<%$fsurl%>search/report_prospect_main.html" CLASS="fslink" STYLE="font-size: 11px">Adv</A>
<INPUT TYPE="submit" VALUE="Search prospects" CLASS="fsblackbutton" onMouseOver="this.className='fsblackbuttonselected'; return true;" onMouseOut="this.className='fsblackbutton'; return true;" STYLE="font-size:11px;padding-left:1px;padding-right:1px">
</FORM>
- <% $menu_position eq 'left' ? '<BR>' : '' %>
+ <% $menu_position eq 'left' ? '<BR>' : '' |n %>
% }
<A HREF="<% FS::TicketSystem->baseurl %>Search/Build.html?NewQuery=1" CLASS="fslink" STYLE="font-size:11px"><% mt('Advanced') |h %></A>
<INPUT TYPE="submit" VALUE="<% mt('Search tickets') |h %>" CLASS="fsblackbutton" onMouseOver="this.className='fsblackbuttonselected'; return true;" onMouseOut="this.className='fsblackbutton'; return true;" STYLE="font-size:11px">
</FORM>
- <% $menu_position eq 'left' ? '<BR>' : '' %>
+ <% $menu_position eq 'left' ? '<BR>' : '' |n %>
% }
% if ( $export->option('restrict_selection') eq 'non-tollfree'
% || !$export->option('restrict_selection') ) {
<TABLE>
-
<TR>
+
+% if ( $export->get_dids_npa_select ) {
+
<TD VALIGN="top">
<% include('/elements/select-state.html',
'prefix' => 'phonenum_', #$field.'_',
%>
<BR><FONT SIZE="-1">State</FONT>
</TD>
+
+ <TD VALIGN="top">
+ <% include('/elements/select-areacode.html',
+ 'state_prefix' => 'phonenum_', #$field.'_',
+ 'svcpart' => $svcpart,
+ 'empty' => 'Select area code',
+ )
+ %>
+ <BR><FONT SIZE="-1">Area code</FONT>
+ </TD>
+
+ <TD VALIGN="top">
+ <% include('/elements/select-exchange.html',
+ 'svcpart' => $svcpart,
+ 'empty' => 'Select exchange',
+ )
+ %>
+ <BR><FONT SIZE="-1">City / Exchange</FONT>
+ </TD>
+
+% } else {
+
<TD VALIGN="top">
- <% include('/elements/select-areacode.html',
- 'state_prefix' => 'phonenum_', #$field.'_',
- 'svcpart' => $svcpart,
- 'empty' => 'Select area code',
- )
- %>
- <BR><FONT SIZE="-1">Area code</FONT>
- </TD>
- <TD VALIGN="top">
- <% include('/elements/select-exchange.html',
- 'svcpart' => $svcpart,
- 'empty' => 'Select exchange',
+ <% include('/elements/select.html',
+ 'field' => 'phonenum_state',
+ 'id' => 'phonenum_state',
+ 'options' => [ '', @{ $export->get_dids } ],
+ 'labels' => { '' => 'Select province' },
+ 'onchange' => 'phonenum_state_changed(this);',
)
%>
- <BR><FONT SIZE="-1">City / Exchange</FONT>
+ <BR><FONT SIZE="-1">Province</FONT>
</TD>
+
+ <TD VALIGN="top">
+ <% include('/elements/select-region.html',
+ 'state_prefix' => 'phonenum_', #$field.'_',
+ 'svcpart' => $svcpart,
+ 'empty' => 'Select region',
+ )
+ %>
+ <BR><FONT SIZE="-1">Region</FONT>
+ </TD>
+
+% }
+
<TD VALIGN="top">
<% include('/elements/select-phonenum.html',
'svcpart' => $svcpart,
'empty' => 'Select phone number',
'bulknum' => $bulknum,
'multiple' => $multiple,
+ 'region' => ! $export->get_dids_npa_select,
)
%>
<BR><FONT SIZE="-1">Phone number</FONT>
</TD>
- </TR>
+ </TR>
</TABLE>
% }
-% if ( $export->option('restrict_selection') eq 'tollfree'
-% || !$export->option('restrict_selection') ) {
+% if ( ( $export->option('restrict_selection') eq 'tollfree'
+% || !$export->option('restrict_selection')
+% )
+% and $export->get_dids_can_tollfree
+% ) {
<font size="-1">Toll-free</font>
<% include('/elements/select-phonenum.html',
'svcpart' => $svcpart,
--- /dev/null
+<& /elements/header-popup.html &>
+<DIV STYLE="visibility: hidden; position: absolute" ID="measurebox"></DIV>
+<TABLE WIDTH="100%">
+<TR>
+ <TD WIDTH="30%" ALIGN="right">Module:</TD>
+ <TD><SELECT ID="select_module"></SELECT></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Object:</TD>
+ <TD><INPUT TYPE="text" NAME="path" ID="input_path" WIDTH="100%"></TD>
+</TR>
+<TR>
+ <TD COLSPAN=2>
+ <SELECT STYLE="width:100%" SIZE=12 ID="select_path"></SELECT>
+ </TD>
+</TR>
+<TR>
+ <TH ALIGN="center" COLSPAN=2 ID="mib_objectID"></TH>
+</TR>
+<TR>
+ <TD ALIGN="right">Module: </TD><TD ID="mib_moduleID"></TD>
+</TR>
+<TR>
+ <TD ALIGN="right">Data type: </TD><TD ID="mib_type"></TD>
+</TR>
+<TR>
+ <TH COLSPAN=2>
+ <BUTTON ID="submit_button" onclick="submit()" DISABLED=1>Continue</BUTTON>
+ </TH>
+</TR>
+</TABLE>
+<& /elements/xmlhttp.html,
+ url => $p.'misc/xmlhttp-mib-browse.html',
+ subs => [qw( search get_module_list )],
+&>
+<SCRIPT TYPE="text/javascript">
+
+var selected_mib;
+
+function show_info(state) {
+ document.getElementById('mib_objectID').style.display =
+ document.getElementById('mib_moduleID').style.display =
+ document.getElementById('mib_type').style.display =
+ state ? '' : 'none';
+}
+
+function clear_list() {
+ var select_path = document.getElementById('select_path');
+ select_path.options.length = 0;
+}
+
+var measurebox = document.getElementById('measurebox');
+function add_item(value) {
+ var select_path = document.getElementById('select_path');
+ var input_path = document.getElementById('input_path');
+ var opt = document.createElement('option');
+ var v = value;
+ if ( v.match(/-$/) ) {
+ opt.className = 'leaf';
+ v = v.substring(0, v.length - 1);
+ }
+ var optvalue = v; // may not be the name we display
+ // shorten these if they don't fit in the box
+ if ( v.length > 30 ) { // unless they're already really short
+ measurebox.innerHTML = v;
+ while ( measurebox.clientWidth > select_path.clientWidth - 10
+ && v.match(/^\..*\./) ) {
+ v = v.replace(/^\.[^\.]+/, '');
+ measurebox.innerHTML = v;
+ }
+ if ( optvalue != v ) {
+ v = '...' + v;
+ }
+ }
+ opt.value = optvalue;
+ opt.text = v;
+ opt.selected = (input_path.value == v);
+ select_path.add(opt, null);
+}
+
+var timerID = 0;
+
+function populate(json_result) {
+ var result = JSON.parse(json_result);
+ clear_list();
+ for (var x in result['choices']) {
+ opt = document.createElement('option');
+ add_item(result['choices'][x]);
+ }
+ if ( result['objectID'] ) {
+ selected_mib = result;
+ show_info(true);
+ // show details on the selected node
+ document.getElementById('mib_objectID').innerHTML = result.objectID;
+ document.getElementById('mib_moduleID').innerHTML = result.moduleID;
+ document.getElementById('mib_type').innerHTML = result.type;
+ document.getElementById('submit_button').disabled = !result.type;
+ } else {
+ selected_mib = undefined;
+ show_info(false);
+ }
+}
+
+function populate_modules(json_result) {
+ var result = JSON.parse(json_result);
+ var select_module = document.getElementById('select_module');
+ var opt = document.createElement('option');
+ opt.value = 'ANY';
+ opt.text = '(any)';
+ select_module.add(opt, null);
+ for (var x in result['modules']) {
+ opt = document.createElement('option');
+ opt.value = opt.text = result['modules'][x];
+ select_module.add(opt, null);
+ }
+}
+
+function dispatch_search() {
+ // called from the interval timer
+ var search_string = document.getElementById('select_module').value + ':' +
+ document.getElementById('input_path').value;
+
+ search(search_string, populate);
+}
+
+function delayed_search() {
+ // onkeyup handler for the text input
+ // 500ms after the user stops typing, send the search request
+ if (timerID != 0) {
+ clearTimeout(timerID);
+ }
+ timerID = setTimeout(dispatch_search, 500);
+}
+
+function handle_choose_object() {
+ // onchange handler for the selector
+ // when the user picks an option, set the text input to that, and then
+ // search for it as though it was entered
+ var input_path = document.getElementById('input_path');
+ input_path.value = this.value;
+ dispatch_search();
+}
+
+function handle_choose_module() {
+ input_path.value = ''; // just to avoid confusion
+ delayed_search();
+}
+
+function submit() {
+% if ( $callback ) {
+ <% $callback %>;
+ parent.nd(1); // close popup
+% } else {
+ alert(document.getElementById('input_path').value);
+% }
+}
+
+var input_path = document.getElementById('input_path');
+input_path.onkeyup = delayed_search;
+var select_path = document.getElementById('select_path');
+select_path.onchange = handle_choose_object;
+var select_module = document.getElementById('select_module');
+select_module.onchange = handle_choose_module;
+% if ( $cgi->param('curr_value') ) {
+input_path.value = <% $cgi->param('curr_value') |js_string %>;
+% }
+dispatch_search();
+get_module_list('', populate_modules);
+
+</SCRIPT>
+<& /elements/footer.html &>
+<%init>
+my $callback = 'alert("(no callback defined)" + selected_mib.stringify)';
+$cgi->param('callback') =~ /^(\w+)$/;
+if ( $1 ) {
+ # construct the JS function call expresssion
+ $callback = 'window.parent.' . $1 . '(selected_mib';
+ foreach ($cgi->param('arg')) {
+ # pass-through arguments
+ /^(\w+)$/ or next;
+ $callback .= ",'$1'";
+ }
+ $callback .= ')';
+}
+
+</%init>
what.options[length] = optionName;
}
- function <% $opt{'prefix'} %>exchange_changed(what, callback) {
+ function <% $opt{'prefix'} %><% $previous %>_changed(what, callback) {
what.form.<% $opt{'prefix'} %>phonenum.disabled = 'disabled';
what.form.<% $opt{'prefix'} %>phonenum.style.display = 'none';
var phonenumerror = document.getElementById('<% $opt{'prefix'} %>phonenumerror');
phonenumerror.style.display = 'none';
- exchange = what.options[what.selectedIndex].value;
+ var thing = "<% $previous eq 'region' ? '_REGION ' : '' %>" + what.options[what.selectedIndex].value;
function <% $opt{'prefix'} %>update_phonenums(phonenums) {
}
// go get the new phonenums
- <% $opt{'prefix'} %>get_phonenums( exchange, <% $opt{'svcpart'} %>, <% $opt{'prefix'} %>update_phonenums );
+ <% $opt{'prefix'} %>get_phonenums( thing, <% $opt{'svcpart'} %>, <% $opt{'prefix'} %>update_phonenums );
}
% unless ( $opt{'tollfree'} ) {
<DIV ID="phonenumwait" STYLE="display:none"><IMG SRC="<%$fsurl%>images/wait-orange.gif"> <B>Finding phone numbers</B></DIV>
-<DIV ID="phonenumerror" STYLE="display:none"><IMG SRC="<%$fsurl%>images/cross.png"> <B>Select a different city/exchange</B></DIV>
+<DIV ID="phonenumerror" STYLE="display:none"><IMG SRC="<%$fsurl%>images/cross.png"> <B>Select a different <% $opt{'region'} ? 'region' : 'city/exchange' %></B></DIV>
% }
<SELECT <% $opt{multiple} ? 'MULTIPLE SIZE=25' : '' %>
$opt{disabled} = 'disabled' unless exists $opt{disabled};
+my $previous = $opt{'region'} ? 'region' : 'exchange';
+
</%init>
--- /dev/null
+<% include('/elements/xmlhttp.html',
+ 'url' => $p.'misc/regions.cgi',
+ 'subs' => [ $opt{'prefix'}. 'get_regions' ],
+ )
+%>
+
+<SCRIPT TYPE="text/javascript">
+
+ function opt(what,value,text) {
+ var optionName = new Option(text, value, false, false);
+ var length = what.length;
+ what.options[length] = optionName;
+ }
+
+ function <% $opt{'state_prefix'} %>state_changed(what, callback) {
+
+ what.form.<% $opt{'prefix'} %>region.disabled = 'disabled';
+ what.form.<% $opt{'prefix'} %>region.style.display = 'none';
+ var regionwait = document.getElementById('<% $opt{'prefix'} %>regionwait');
+ regionwait.style.display = '';
+ var regionerror = document.getElementById('<% $opt{'prefix'} %>regionerror');
+ regionerror.style.display = 'none';
+
+ what.form.<% $opt{'prefix'} %>phonenum.disabled = 'disabled';
+
+ state = what.options[what.selectedIndex].value;
+
+ function <% $opt{'prefix'} %>update_regions(regions) {
+
+ // blank the current region
+ for ( var i = what.form.<% $opt{'prefix'} %>region.length; i >= 0; i-- )
+ what.form.<% $opt{'prefix'} %>region.options[i] = null;
+ // blank the current phonenum too
+ for ( var i = what.form.<% $opt{'prefix'} %>phonenum.length; i >= 0; i-- )
+ what.form.<% $opt{'prefix'} %>phonenum.options[i] = null;
+ if ( what.form.<% $opt{'prefix'} %>phonenum.type != 'select-multiple' ) {
+ opt(what.form.<% $opt{'prefix'} %>phonenum, '', 'Select phone number');
+ }
+
+% if ($opt{empty}) {
+ opt(what.form.<% $opt{'prefix'} %>region, '', '<% $opt{empty} %>');
+% }
+
+ // add the new regions
+ var regionArray = eval('(' + regions + ')' );
+ for ( var s = 0; s < regionArray.length; s++ ) {
+ var regionLabel = regionArray[s];
+ if ( regionLabel == "" )
+ regionLabel = '(n/a)';
+ opt(what.form.<% $opt{'prefix'} %>region, regionArray[s], regionLabel);
+ }
+
+ regionwait.style.display = 'none';
+ if ( regionArray.length >= 1 ) {
+ what.form.<% $opt{'prefix'} %>region.disabled = '';
+ what.form.<% $opt{'prefix'} %>region.style.display = '';
+ } else {
+ var regionerror = document.getElementById('<% $opt{'prefix'} %>regionerror');
+ regionerror.style.display = '';
+ }
+
+ //run the callback
+ if ( callback != null )
+ callback();
+ }
+
+ // go get the new regions
+ <% $opt{'prefix'} %>get_regions( state, <% $opt{'svcpart'} %>, <% $opt{'prefix'} %>update_regions );
+
+ }
+
+</SCRIPT>
+
+<DIV ID="<% $opt{'prefix'} %>regionwait" STYLE="display:none"><IMG SRC="<%$fsurl%>images/wait-orange.gif"> <B>Finding regions</B></DIV>
+
+<DIV ID="<% $opt{'prefix'} %>regionerror" STYLE="display:none"><IMG SRC="<%$fsurl%>images/cross.png"> <B>Select a different state</B></DIV>
+
+<SELECT NAME="<% $opt{'prefix'} %>region" onChange="<% $opt{'prefix'} %>region_changed(this); <% $opt{'onchange'} %>" <% $opt{'disabled'} %>>
+ <OPTION VALUE="">Select region</OPTION>
+</SELECT>
+
+<%init>
+
+my %opt = @_;
+
+$opt{disabled} = 'disabled' unless exists $opt{disabled};
+
+</%init>
my $empty_value = $opt{'empty_value'} || '';
my @terms = ( emt('Payable upon receipt'),
- ( map "Net $_", 0, 3, 9, 10, 15, 20, 30, 45, 60, 90 ),
+ ( map "Net $_", 0, 3, 9, 10, 15, 18, 20, 30, 45, 60, 90 ),
);
my @pre_options = $opt{pre_options} ? @{ $opt{pre_options} } : ();
+function status_message(text, caption) {
+ text = '<P STYLE="position:absolute; top:50%; margin-top:-1em; width:100%; text-align:center"><B><FONT SIZE="+1">' + text + '</FONT></B></P>';
+ caption = caption || 'Please wait...';
+ overlib(text, WIDTH, 444, HEIGHT, 168, CAPTION, caption, STICKY, AUTOSTATUSCAP, CLOSECLICK, MIDX, 0, MIDY, 0);
+}
+
function form_address_info() {
var cf = document.<% $formname %>;
% if ( $conf->config('address_standardize_method') ) {
if ( changed ) {
- var startup_msg = '<P STYLE="position:absolute; top:50%; margin-top:-1em; width:100%; text-align:center"><B><FONT SIZE="+1">Verifying address...</FONT></B></P>';
- overlib(startup_msg, WIDTH, 444, HEIGHT, 168, CAPTION, 'Please wait...', STICKY, AUTOSTATUSCAP, CLOSECLICK, MIDX, 0, MIDY, 0);
+ status_message('Verifying address...');
address_standardize(JSON.stringify(address_info), confirm_standardize);
}
else {
replace_address(); // with the contents of returned['new']
- }
- else {
+ } else if ( returned['all_same'] ) {
+
+ // then all entered address fields are correct
+ // but we still need to set the lat/long fields and addr_clean
+ status_message('Verified');
+ replace_address();
+
+ } else {
var querystring = encodeURIComponent( JSON.stringify(returned) );
// confirmation popup: knows to call replace_address(),
);
</%doc>
-<% include( '/elements/rs_init_object.html' ) %>
+<& /elements/rs_init_object.html &>
+<& /elements/init_overlib.html &>
<SCRIPT TYPE="text/javascript">
% foreach my $func ( @{$opt{'subs'}} ) {
%
% my $furl = $url;
% $furl =~ s/\"/\\\\\"/; #javascript escape
-%
+%#"
%
} else {
var data = xmlhttp.responseText;
//alert('received response: ' + data);
- a[a.length-1](data);
if ( data.indexOf("<b>System error</b>") > -1 ) {
- var w;
- if ( w = window.open("about:blank") ) {
- w.document.write(data);
- } else {
- // popup blocking? should use an overlib popup instead
- alert("Error popup disabled; try disabling popup blocking to see");
- }
+ // trim this a little
+ var end = data.indexOf('<a href="#raw">') - 1;
+ data = data.substring(0, end);
+
+ overlib(data,
+ WIDTH, 480, MIDX, 0, MIDY, 0,
+ CAPTION, 'Error', STICKY, AUTOSTATUSCAP, DRAGGABLE,
+ CLOSECLICK, BGCOLOR, '#f00', CGCOLOR, '#f00'
+ );
+ //var w;
+ //if ( w = window.open("about:blank") ) {
+ // w.document.write(data);
+ //} else {
+ // // popup blocking? should use an overlib popup instead
+ // alert("Error popup disabled; try disabling popup blocking to see");
+ //}
+ } else {
+ // invoke the callback
+ a[a.length-1](data);
}
}
}
% $workbook->close();# or die "Error creating .xls file: $!";
%
% http_header('Content-Length' => length($output) );
-%
-<% $output %>
+% $m->print($output);
+%
% } elsif ( $cgi->param('_type') eq 'png' ) {
% # delete any items that shouldn't be on the graph
% if ( my $no_graph = $opt{'no_graph'} ) {
my %opts = ();
if ( $exchangestring eq 'tollfree' ) {
$opts{'tollfree'} = 1;
- }
- #elsif ( $exchangestring =~ /^([\w\s\:\,\(\)\-]+), ([A-Z][A-Z])$/ ) {
- elsif ( $exchangestring =~ /^(.+), ([A-Z][A-Z])$/ ) {
+ } elsif ( $exchangestring =~ /^_REGION (.*)$/ ) {
+ $opts{'region'} = $1;
+ #} elsif ( $exchangestring =~ /^([\w\s\:\,\(\)\-]+), ([A-Z][A-Z])$/ ) {
+ } elsif ( $exchangestring =~ /^(.+), ([A-Z][A-Z])$/ ) {
$opts{'ratecenter'} = $1;
$opts{'state'} = $2;
- }
- else {
+ } else {
$exchangestring =~ /\((\d{3})-(\d{3})-XXXX\)\s*$/i
or die "unparsable exchange: $exchangestring";
my( $areacode, $exchange ) = ( $1, $2 );
--- /dev/null
+<% objToJson(\@regions) %>
+<%init>
+
+my( $state, $svcpart ) = $cgi->param('arg');
+
+my $part_svc = qsearchs('part_svc', { 'svcpart'=>$svcpart } );
+die "unknown svcpart $svcpart" unless $part_svc;
+
+my @regions = ();
+if ( $state ) {
+
+ my @exports = $part_svc->part_export_did;
+ if ( scalar(@exports) > 1 ) {
+ die "more than one DID-providing export attached to svcpart $svcpart";
+ } elsif ( ! @exports ) {
+ die "no DID providing export attached to svcpart $svcpart";
+ }
+ my $export = $exports[0];
+
+ my $something = $export->get_dids('state'=>$state);
+
+ @regions = @{ $something };
+
+}
+
+</%init>
} else {
@prefixes = ('bill_', 'ship_');
}
+my $all_same = 1;
foreach my $pre ( @prefixes ) {
my $location = {
foreach ( keys(%$cache) ) {
$new{$pre.$_} = $cache->get($_);
}
+
+ foreach ( qw(address1 address2 city state zip country) ) {
+ $all_same = 0 if ( $new{$pre.$_} ne $old{$pre.$_} );
+ last if !$all_same;
+ }
}
-my $return = { old => \%old, new => \%new };
+my $return = { old => \%old, new => \%new, all_same => $all_same };
warn "result:\n".encode_json($return) if $DEBUG;
</%init>
--- /dev/null
+<% to_json($return) %>
+<%init>
+
+my $curuser = $FS::CurrentUser::CurrentUser;
+die "access denied" unless $curuser->access_right('Post credit');
+
+my $DEBUG = 0;
+
+my $conf = new FS::Conf;
+
+my $sub = $cgi->param('sub');
+
+my $return = {};
+
+if ( $sub eq 'calculate_taxes' ) {
+
+ {
+
+ my %arg = $cgi->param('arg');
+ $return = \%arg;
+ warn join('', map "$_: $arg{$_}\n", keys %arg )
+ if $DEBUG;
+
+ #some false laziness w/cust_credit::credit_lineitems
+
+ my $cust_main = qsearchs({
+ 'table' => 'cust_main',
+ 'hashref' => { 'custnum' => $arg{custnum} },
+ 'extra_sql' => ' AND '. $curuser->agentnums_sql,
+ }) or die 'unknown customer';
+
+ my @billpkgnums = split(',', $arg{billpkgnums});
+ my @setuprecurs = split(',', $arg{setuprecurs});
+ my @amounts = split(',', $arg{amounts});
+
+ my @cust_bill_pkg = ();
+ my $taxlisthash = {};
+ while ( @billpkgnums ) {
+ my $billpkgnum = shift @billpkgnums;
+ my $setuprecur = shift @setuprecurs;
+ my $amount = shift @amounts;
+
+ my $cust_bill_pkg = qsearchs({
+ 'table' => 'cust_bill_pkg',
+ 'hashref' => { 'billpkgnum' => $billpkgnum },
+ 'addl_from' => 'LEFT JOIN cust_bill USING (invnum)',
+ 'extra_sql' => 'AND custnum = '. $cust_main->custnum,
+ }) or die "unknown billpkgnum $billpkgnum";
+
+ #shouldn't be passed# next if $cust_bill_pkg->pkgnum == 0;
+
+ if ( $setuprecur eq 'setup' ) {
+ $cust_bill_pkg->setup($amount);
+ $cust_bill_pkg->recur(0);
+ $cust_bill_pkg->unitrecur(0);
+ $cust_bill_pkg->type('');
+ } else {
+ $cust_bill_pkg->recur($amount);
+ $cust_bill_pkg->setup(0);
+ $cust_bill_pkg->unitsetup(0);
+ }
+
+ push @cust_bill_pkg, $cust_bill_pkg;
+
+ my $part_pkg = $cust_bill_pkg->part_pkg;
+ $cust_main->_handle_taxes( $part_pkg,
+ $taxlisthash,
+ $cust_bill_pkg,
+ $cust_bill_pkg->cust_pkg,
+ $cust_bill_pkg->cust_bill->_date,
+ $cust_bill_pkg->cust_pkg->pkgpart,
+ );
+
+ }
+
+ if ( @cust_bill_pkg ) {
+
+ my $listref_or_error =
+ $cust_main->calculate_taxes( \@cust_bill_pkg, $taxlisthash, $cust_bill_pkg[0]->cust_bill->_date );
+
+ unless ( ref( $listref_or_error ) ) {
+ $return->{error} = $listref_or_error;
+ last;
+ }
+
+ my @taxlines = ();
+ my $taxtotal = 0;
+ $return->{taxlines} = \@taxlines;
+ foreach my $taxline ( @$listref_or_error ) {
+ my $amount = $taxline->setup;
+ my $desc = $taxline->desc;
+ foreach my $location ( @{$taxline->cust_bill_pkg_tax_location}, @{$taxline->cust_bill_pkg_tax_rate_location} ) {
+ my $taxlocnum = $location->locationnum || '';
+ my $taxratelocnum = $location->taxratelocationnum || '';
+ $location->cust_bill_pkg_desc($taxline->desc); #ugh @ that kludge
+ $taxtotal += $location->amount;
+ push @taxlines,
+ #[ $location->desc, $taxline->setup, $taxlocnum, $taxratelocnum ];
+ [ $location->desc, $location->amount, $taxlocnum, $taxratelocnum ];
+ $amount -= $location->amount;
+ }
+ if ($amount > 0) {
+ $taxtotal += $amount;
+ push @taxlines,
+ [ $taxline->itemdesc. ' (default)', sprintf('%.2f', $amount), '', '' ];
+ }
+ }
+
+ $return->{taxlines} = \@taxlines;
+ $return->{taxtotal} = sprintf('%.2f', $taxtotal);
+
+ } else {
+
+ $return->{taxlines} = [];
+ $return->{taxtotal} = '0.00';
+
+ }
+
+ }
+
+}
+
+</%init>
--- /dev/null
+%#<% Data::Format::HTML->new->format($index{by_path}) %>
+% my $json = "JSON"->new->canonical;
+<% $json->encode($result) %>
+<%init>
+#<%once> #enable me in production
+use SNMP;
+SNMP::initMib();
+my $mib = \%SNMP::MIB;
+
+# make an index of the leaf nodes
+my %index = (
+ by_objectID => {}, # {.1.3.6.1.2.1.1.1}
+ by_fullname => {}, # {iso.org.dod.internet.mgmt.mib-2.system.sysDescr}
+ by_path => {}, # {iso}{org}{dod}{internet}{mgmt}{mib-2}{system}{sysDescr}
+ module => {}, #{SNMPv2-MIB}{by_path}{iso}{org}...
+ #{SNMPv2-MIB}{by_fullname}{iso.org...}
+);
+
+my %name_of_oid = (); # '.1.3.6.1' => 'iso.org.dod.internet'
+
+# build up path names
+my $fullname;
+$fullname = sub {
+ my $oid = shift;
+ return $name_of_oid{$oid} if exists $name_of_oid{$oid};
+
+ my $object = $mib->{$oid};
+ my $myname = '.' . $object->{label};
+ # cut off the last element and recurse
+ $oid =~ /^(\.[\d\.]+)?(\.\d+)$/;
+ if ( length($1) ) {
+ $myname = $fullname->($1) . $myname;
+ }
+ return $name_of_oid{$oid} = $myname
+};
+
+my @oids = keys(%$mib); # dotted numeric OIDs
+foreach my $oid (@oids) {
+ my $object = {};
+ %$object = %{ $mib->{$oid} }; # untie it
+ # and remove references
+ delete $object->{parent};
+ delete $object->{children};
+ delete $object->{nextNode};
+ $index{by_objectID}{$oid} = $object;
+ my $myname = $fullname->($oid);
+ $object->{fullname} = $myname;
+ $index{by_fullname}{$myname} = $object;
+ my $moduleID = $object->{moduleID};
+ $index{module}{$moduleID} ||= { by_fullname => {}, by_path => {} };
+ $index{module}{$moduleID}{by_fullname}{$myname} = $object;
+}
+my @names = sort {$a cmp $b} keys %{ $index{by_fullname} };
+foreach my $myname (@names) {
+ my $obj = $index{by_fullname}{$myname};
+ my $moduleID = $obj->{moduleID};
+ my @parts = split('\.', $myname);
+ shift @parts; # always starts with an empty string
+ for ($index{by_path}, $index{module}{$moduleID}{by_path}) {
+ my $subindex = $_;
+ for my $this_part (@parts) {
+ $subindex = $subindex->{$this_part} ||= {};
+ }
+ # $subindex now = $index{by_path}{foo}{bar}{baz}.
+ # set {''} = the object with that name.
+ # and set object $index{by_path}{foo}{bar}{baz}{''} =
+ # the object named .foo.bar.baz
+ $subindex->{''} = $obj;
+ }
+}
+
+#</%once>
+#<%init>
+# no ACL for this
+my $sub = $cgi->param('sub');
+my $result = {};
+if ( $sub eq 'search' ) {
+ warn "search: ".$cgi->param('arg')."\n";
+ my ($module, $string) = split(':', $cgi->param('arg'), 2);
+ my $idx; # the branch of the index to use for this search
+ if ( $module eq 'ANY' ) {
+ $idx = \%index;
+ } elsif (exists($index{module}{$module}) ) {
+ $idx = $index{module}{$module};
+ } else {
+ warn "unknown MIB moduleID: $module\n";
+ $idx = {}; # will return nothing, because you've somehow sent a bad moduleID
+ }
+ if ( exists($index{by_fullname}{$string}) ) {
+ warn "exact match\n";
+ # don't make this module-selective--if the path matches an existing
+ # object, return that object
+ %$result = %{ $index{by_fullname}{$string} }; # put the object info in $result
+ #warn Dumper $result;
+ }
+ my @choices; # menu options to return
+ if ( $string =~ /^[\.\d]+$/ ) {
+ # then this is a numeric path
+ # ignore the module filter, and return everything starting with $string
+ if ( $string =~ /^\./ ) {
+ @choices = grep /^\Q$string\E/, keys %{$index{by_objectID}};
+ } else {
+ # or everything containing it
+ @choices = grep /\Q$string\E/, keys %{$index{by_objectID}};
+ }
+ @choices = map { $index{by_objectID}{$_}->{fullname} } @choices;
+ } elsif ( $string eq '' or $string =~ /^\./ ) {
+ # then this is an absolute path
+ my @parts = split('\.', $string);
+ shift @parts;
+ my $subindex = $idx->{by_path};
+ my $path = '';
+ @choices = keys %$subindex;
+ # walk all the specified path parts
+ foreach my $this_part (@parts) {
+ # stop before walking off the map
+ last if !exists($subindex->{$this_part});
+ $subindex = $subindex->{$this_part};
+ $path .= '.' . $this_part;
+ @choices = grep {$_} keys %$subindex;
+ }
+ # skip uninteresting nodes: those that aren't accessible nodes (have no
+ # data type), and have only one path forward
+ while ( scalar(@choices) == 1
+ and (!exists $subindex->{''} or $subindex->{''}->{type} eq '') ) {
+
+ $subindex = $subindex->{ $choices[0] };
+ $path .= '.' . $choices[0];
+ @choices = grep {$_} keys %$subindex;
+
+ }
+
+ # if we are on an existing node, and the entered path didn't exactly
+ # match another node, return the current node as the result
+ if (!keys %$result and exists($subindex->{''})) {
+ %$result = %{ $subindex->{''} };
+ }
+ # prepend the path up to this point
+ foreach (@choices) {
+ $_ = $path.'.'.$_;
+ # also label accessible nodes for the UI
+ if ( exists($subindex->{$_}{''}) and $subindex->{$_}{''}{'type'} ) {
+ $_ .= '-';
+ }
+ }
+ # also include one level above the originally requested path,
+ # for tree-like navigation
+ if ( $string =~ /^(.+)\.[^\.]+/ ) {
+ unshift @choices, $1;
+ }
+ } else {
+ # then this is a full-text search
+ warn "/$string/\n";
+ @choices = grep /\Q$string\E/i, keys(%{ $idx->{by_fullname} });
+ }
+ @choices = sort @choices;
+ $result->{choices} = \@choices;
+} elsif ( $sub eq 'get_module_list' ) {
+ $result = { modules => [ sort keys(%{ $index{module} }) ] };
+}
+</%init>
'count_addl' => \@total_desc,
'header' => [
emt('Description'),
+ @post_desc_header,
@peritem_desc,
emt('Invoice'),
emt('Date'),
+ emt('Paid'),
+ emt('Credited'),
FS::UI::Web::cust_header(),
],
'fields' => [
? $_[0]->get('pkg') # possibly use override.pkg
: $_[0]->get('itemdesc') # but i think this correct
},
+ @post_desc,
#strikethrough or "N/A ($amount)" or something these when
# they're not applicable to pkg_tax search
@peritem_sub,
'invnum',
sub { time2str('%b %d %Y', shift->_date ) },
+ sub { sprintf($money_char.'%.2f', shift->get('pay_amount')) },
+ sub { sprintf($money_char.'%.2f', shift->get('credit_amount')) },
\&FS::UI::Web::cust_fields,
],
'sort_fields' => [
'',
+ @post_desc_null,
@peritem,
'invnum',
'_date',
+ #'pay_amount',
+ #'credit_amount',
],
'links' => [
#'',
'',
+ @post_desc_null,
@peritem_null,
$ilink,
$ilink,
+ $pay_link,
+ $credit_link,
( map { $_ ne 'Cust. Status' ? $clink : '' }
FS::UI::Web::cust_header()
),
],
#'align' => 'rlrrrc'.FS::UI::Web::cust_aligns(),
'align' => 'l'.
+ $post_desc_align.
$peritem_align.
- 'rc'.
+ 'rcrr'.
FS::UI::Web::cust_aligns(),
'color' => [
#'',
'',
+ @post_desc_null,
@peritem_null,
'',
'',
+ '',
+ '',
FS::UI::Web::cust_colors(),
],
'style' => [
#'',
'',
+ @post_desc_null,
@peritem_null,
'',
'',
+ '',
+ '',
FS::UI::Web::cust_styles(),
],
&>
<%doc>
-Output parameters:
+Output control parameters:
- distribute: Boolean. If true, recurring fees will be "prorated" for the
portion of the package date range (sdate-edate) that falls within the date
range of the report. Line items will be limited to those for which this
portion is > 0. This disables filtering on invoice date.
-- use_usage: Separate usage (cust_bill_pkg_detail records) from
+- usage: Separate usage (cust_bill_pkg_detail records) from
recurring charges. If set to "usage", will show usage instead of
recurring charges. If set to "recurring", will deduct usage and only
show the flat rate charge. If not passed, the "recurring charge" column
my @select = ( 'cust_bill_pkg.*', 'cust_bill._date' );
my @total = ( 'COUNT(*)', 'SUM(cust_bill_pkg.setup + cust_bill_pkg.recur)');
my @total_desc = ( '%d line items', $money_char.'%.2f total' ); # sprintf strings
+
my @peritem = ( 'setup', 'recur' );
my @peritem_desc = ( 'Setup charge', 'Recurring charge' );
-my ($join_cust, $join_pkg ) = ('', '');
-my $use_usage;
+
+my @post_desc_header = ();
+my @post_desc = ();
+my @post_desc_null = ();
+my $post_desc_align = '';
+if ( $conf->exists('enable_taxclasses') ) {
+ push @post_desc_header, 'Tax class';
+ push @post_desc, 'taxclass';
+ push @post_desc_null, '';
+ $post_desc_align .= 'l';
+ push @select, 'part_pkg.taxclass'; # or should this use override?
+}
# valid in both the tax and non-tax cases
-$join_cust =
+my $join_cust =
" LEFT JOIN cust_bill USING (invnum)
LEFT JOIN cust_main USING (custnum)
";
push @where, "cust_main.refnum = $1";
}
-# the non-tax case
-if ( $cgi->param('nottax') ) {
-
- push @where, 'cust_bill_pkg.pkgnum > 0';
+# custnum
+if ( $cgi->param('custnum') =~ /^(\d+)$/ ) {
+ push @where, "cust_main.custnum = $1";
+}
- # then we want the package and its definition
- $join_pkg =
+# we want the package and its definition if available
+my $join_pkg =
' LEFT JOIN cust_pkg USING (pkgnum)
LEFT JOIN part_pkg USING (pkgpart)';
- my $part_pkg = 'part_pkg';
- if ( $cgi->param('use_override') ) {
- # still need the real part_pkg for tax applicability,
- # so alias this one
- $join_pkg .= " LEFT JOIN part_pkg AS override ON (
- COALESCE(cust_bill_pkg.pkgpart_override, cust_pkg.pkgpart, 0) = part_pkg.pkgpart
- )";
- $part_pkg = 'override';
- }
- push @select, 'part_pkg.pkg'; # or should this use override?
+my $part_pkg = 'part_pkg';
+if ( $cgi->param('use_override') ) {
+ # still need the real part_pkg for tax applicability,
+ # so alias this one
+ $join_pkg .= " LEFT JOIN part_pkg AS override ON (
+ COALESCE(cust_bill_pkg.pkgpart_override, cust_pkg.pkgpart, 0) = part_pkg.pkgpart
+ )";
+ $part_pkg = 'override';
+}
+push @select, 'part_pkg.pkg'; # or should this use override?
+
+# the non-tax case
+if ( $cgi->param('nottax') ) {
+
+ push @where, 'cust_bill_pkg.pkgnum > 0';
my @tax_where; # will go into a subquery
my @exempt_where; # will also go into a subquery
}
# recur/usage separation
- $use_usage = $cgi->param('usage');
- if ( $use_usage eq 'recurring' ) {
+ if ( $cgi->param('usage') eq 'recurring' ) {
my $recur_no_usage = FS::cust_bill_pkg->charged_sql('', '', no_usage => 1);
push @select, "($recur_no_usage) AS recur_no_usage";
$total[1] = "SUM(cust_bill_pkg.setup + $recur_no_usage)";
$total_desc[1] .= ' (excluding usage)';
- } elsif ( $use_usage eq 'usage' ) {
+ } elsif ( $cgi->param('usage') eq 'usage' ) {
my $usage = FS::cust_bill_pkg->usage_sql();
push @select, "($usage) AS _usage";
} # nottax / istax
+
+#total payments
+my $pay_sub = "SELECT SUM(cust_bill_pay_pkg.amount) AS pay_amount,
+ billpkgnum
+ FROM cust_bill_pay_pkg
+ GROUP BY billpkgnum";
+$join_pkg .= " LEFT JOIN ($pay_sub) AS item_pay USING (billpkgnum)";
+push @select, 'item_pay.pay_amount';
+
+
# credit
if ( $cgi->param('credit') ) {
push @peritem_desc, 'Credited', 'By', 'Reason';
push @total, 'SUM(credit_amount)';
push @total_desc, "$money_char%.2f credited";
-} # if credit
+
+} else {
+
+ #still want a credit total column
+
+ my $credit_sub = "SELECT SUM(cust_credit_bill_pkg.amount) AS credit_amount,
+ billpkgnum
+ FROM cust_credit_bill_pkg
+ GROUP BY billpkgnum";
+ $join_pkg .= " LEFT JOIN ($credit_sub) AS item_credit USING (billpkgnum)";
+
+ push @select, 'item_credit.credit_amount';
+
+}
push @select, 'cust_main.custnum', FS::UI::Web::cust_sql_fields();
my $ilink = [ "${p}view/cust_bill.cgi?", 'invnum' ];
my $clink = [ "${p}view/cust_main.cgi?", 'custnum' ];
+my $pay_link = ''; #[, 'billpkgnum', ];
+my $credit_link = [ "${p}search/cust_credit_bill_pkg.html?billpkgnum=", 'billpkgnum', ];
+
warn "\n\nQUERY:\n".Dumper($query)."\n\nCOUNT_QUERY:\n$count_query\n\n"
if $cgi->param('debug');
</%init>
<% include( 'elements/search.html',
- 'title' => 'Tax credits', #well, actually application of
- 'name' => 'tax credits', # credit to line item
- 'query' => $query,
- 'count_query' => $count_query,
- 'count_addl' => [ $money_char. '%.2f total', ],
- 'header' => [
+ 'title' => 'Credit application detail', #to line item
+ 'name_singular' => 'credit application',
+ 'query' => $query,
+ 'count_query' => $count_query,
+ 'count_addl' => [ $money_char. '%.2f total', ],
+ 'header' => [
#'#',
'Amount',
# line item
'Description',
+ @post_desc_header,
#invoice
'Invoice',
'Date',
FS::UI::Web::cust_header(),
- ],
- 'fields' => [
+ ],
+ 'fields' => [
#'creditbillpkgnum',
sub { sprintf($money_char.'%.2f', shift->amount ) },
? $_[0]->get('pkg') # possibly use override.pkg
: $_[0]->get('itemdesc') # but i think this correct
},
+ @post_desc,
'invnum',
sub { time2str('%b %d %Y', shift->_date ) },
\&FS::UI::Web::cust_fields,
- ],
- 'sort_fields' => [
+ ],
+ 'sort_fields' => [
'amount',
'cust_credit_date',
'', #'otaker',
'', #reason
'', #line item description
+ @post_desc_null,
'invnum',
'_date',
#cust fields
- ],
- 'links' => [
+ ],
+ 'links' => [
'',
'',
'',
'',
'',
+ @post_desc_null,
$ilink,
$ilink,
( map { $_ ne 'Cust. Status' ? $clink : '' }
FS::UI::Web::cust_header()
),
- ],
- 'align' => 'rrlllrr'.FS::UI::Web::cust_aligns(),
- 'color' => [
+ ],
+ 'align' => 'rrlll'.
+ $post_desc_align.
+ 'rr'.
+ FS::UI::Web::cust_aligns(),
+ 'color' => [
'',
'',
'',
'',
'',
+ @post_desc_null,
'',
'',
FS::UI::Web::cust_colors(),
],
- 'style' => [
+ 'style' => [
'',
'',
'',
'',
'',
+ @post_desc_null,
'',
'',
FS::UI::Web::cust_styles(),
- ],
+ ],
)
%>
<%init>
#LOTS of false laziness below w/cust_bill_pkg.cgi
+# and a little w/cust_credit.html
die "access denied"
unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
my @where = ( $agentnums_sql );
+if ( $cgi->param('usernum') =~ /^(\d+)$/ ) {
+ push @where, "cust_credit.usernum = $1";
+}
+
my($beginning, $ending) = FS::UI::Web::parse_beginning_ending($cgi);
push @where, "cust_bill._date >= $beginning",
"cust_bill._date <= $ending";
+my($cr_begin, $cr_end) = FS::UI::Web::parse_beginning_ending($cgi, 'credit');
+push @where, "cust_credit._date >= $cr_begin",
+ "cust_credit._date <= $cr_end";
+
+#credit amount? seems more what is expected than the applied amount
+my @lt_gt = FS::UI::Web::parse_lt_gt($cgi, 'amount' );
+s/amount/cust_credit.amount/g foreach (@lt_gt);
+push @where, @lt_gt;
+
if ( $cgi->param('agentnum') =~ /^(\d+)$/ ) {
push @where, "cust_main.agentnum = $1";
}
+if ( $cgi->param('billpkgnum') =~ /^(\d+)$/ ) {
+ push @where, "billpkgnum = $1";
+}
+
#classnum
# not specified: all classes
# 0: empty class
push @where, $cust_exempt;
}
-my $count_query = "SELECT COUNT(DISTINCT billpkgnum),
+my $count_query = "SELECT COUNT(DISTINCT creditbillpkgnum),
SUM(cust_credit_bill_pkg.amount)";
my $join_cust =
LEFT JOIN cust_credit USING ( crednum ) ';
$count_query .= " FROM cust_credit_bill_pkg
- $join_pkg
$join_cust_bill_pkg
+ $join_pkg
$join_credit
$join_cust
$where";
push @select, 'cust_main.custnum',
FS::UI::Web::cust_sql_fields();
+my @post_desc_header = ();
+my @post_desc = ();
+my @post_desc_null = ();
+my $post_desc_align = '';
+if ( $conf->exists('enable_taxclasses') ) {
+ push @post_desc_header, 'Tax class';
+ push @post_desc, 'taxclass';
+ push @post_desc_null, '';
+ $post_desc_align .= 'l';
+ push @select, 'part_pkg.taxclass'; # or should this use override?
+}
+
my $query = {
'table' => 'cust_credit_bill_pkg',
- 'addl_from' => "$join_pkg
- $join_cust_bill_pkg
+ 'addl_from' => "$join_cust_bill_pkg
+ $join_pkg
$join_credit
$join_cust",
'hashref' => {},
<%init>
die "access denied"
- unless $curuser->access_right('Summarize packages');
+ unless $FS::CurrentUser::CurrentUser->access_right('Summarize packages');
</%init>
http_header('Content-Disposition' => qq!attachment;filename="$filename"!);
my $output = '';
- use IO::String;
- my $XLS = IO::String->new($output);;
+ my $XLS = IO::String->new($output);
my $workbook = $format->{class}->new($XLS)
or die "Error opening .xls file: $!";
$r++;
} #$row
$workbook->close;
+
+ http_header('Content-Length' => length($output));
+ $m->print($output);
</%perl>
-<% $output %>
-% } else {
+% } else {
<& /elements/header.html, $title &>
% my $myself = $cgi->self_url;
<P ALIGN="right" CLASS="noprint">
% my $style = '';
% $style .= " rowspan=".$cell->{rowspan} if $cell->{rowspan} > 1;
% $style .= " colspan=".$cell->{colspan} if $cell->{colspan} > 1;
- <<%$td%><%$style%>><% $cell->{value} %></<%$td%>>
+ <<%$td%><%$style%>><% $cell->{value} |h %></<%$td%>>
% }
</tr>
% }
%
% my $links = $opt{'links'} ? [ @{$opt{'links'}} ] : '';
% my $onclicks = $opt{'link_onclicks'} ? [ @{$opt{'link_onclicks'}} ] : [];
+% my $tooltips = $opt{'tooltips'} ? [ @{$opt{'tooltips'}} ] : [];
% my $aligns = $opt{'align'} ? [ @{$opt{'align'}} ] : '';
% my $colors = $opt{'color'} ? [ @{$opt{'color'}} ] : [];
% my $sizes = $opt{'size'} ? [ @{$opt{'size'}} ] : [];
% if ( $links ) {
% my $link = shift @$links;
% my $onclick = shift @$onclicks;
+% my $tooltip = shift @$tooltips;
%
% if ( ! $opt{'agent_virt'}
% || ( $null_link && ! $row->agentnum )
% if ref($onclick) eq 'CODE';
% $onclick = qq( onClick="$onclick") if $onclick;
%
+% $tooltip = &{$tooltip}($row)
+% if ref($tooltip) eq 'CODE';
+% $tooltip = qq! id="a$id" !.
+% qq! onmouseover="return overlib(!.
+% $m->interp->apply_escapes($tooltip, 'h', 'js_string').
+% qq!, FGCLASS, 'tooltip', REF, 'a$id', !.
+% qq!REFC, 'LL', REFP, 'UL')"! if $tooltip;
+%
% if ( $link ) {
% my( $url, $method ) = @{$link};
% if ( ref($method) eq 'CODE' ) {
% } else {
% $a = $url. $row->$method();
% }
-% $a = qq(<A HREF="$a"$onclick>);
+% $a = qq(<A HREF="$a"$onclick$tooltip>);
% }
% elsif ( $onclick ) {
% $a = qq(<A HREF="javascript:void(0);"$onclick>);
% }
+% elsif ( $tooltip ) {
+% $a = qq(<A $tooltip>);
+% }
+% $id++;
+
% }
%
% }
my $count_arrayref = $count_sth->fetchrow_arrayref;
my $total = $count_arrayref->[0];
+my $id = 0;
</%init>
-<% $data %>
<%init>
my %args = @_;
$workbook->close();# or die "Error creating .xls file: $!";
http_header('Content-Length' => length($data) );
+$m->print($data);
</%init>
%
% } elsif ( $type =~ /\.xls$/ ) {
%
-<% include('search-xls.html', header=>$header, rows=>$rows, opt=>\%opt ) %>
+<& 'search-xls.html', header=>$header, rows=>$rows, opt=>\%opt &>\
+% # prevent the caller from polluting our output stream
+% $m->abort;
%
% } elsif ( $type eq 'xml' ) {
%
--- /dev/null
+<& elements/search.html,
+ 'title' => 'System Log',
+ 'name_singular' => 'event',
+ 'html_init' => include('.head'),
+ 'query' => $query,
+ 'count_query' => $count_query,
+ 'header' => [ #'#', # lognum, probably not useful
+ 'Date',
+ 'Level',
+ 'Context',
+ 'Applies To',
+ 'Message',
+ ],
+ 'fields' => [ #'lognum',
+ $date_sub,
+ $level_sub,
+ $context_sub,
+ $object_sub,
+ $message_sub,
+ ],
+ 'sort_fields' => [
+ '_date',
+ 'level',
+ '',
+ 'tablename,tablenum',
+ 'message',
+ ],
+ 'links' => [
+ '', #date
+ '', #level
+ '', #context
+ $object_link_sub,
+ '', #message
+ ],
+ 'tooltips' => [
+ '', #date
+ '', #level
+ $tt_sub,
+ '', #object
+ $tt_sub,
+ ],
+ 'color' => [
+ $color_sub,
+ $color_sub,
+ '',
+ '',
+ '',
+ ],
+ # aligns
+ 'download_label' => 'Download this log',
+&>\
+<%def .head>
+<STYLE type="text/css">
+a:link {text-decoration: none}
+a:visited {text-decoration: none}
+.tooltip {
+ background-color: #ffffff;
+ font-size: 100%;
+ font-weight: bold;
+}
+</STYLE>
+<FORM ACTION="<%$p%>search/log.html" METHOD="GET">
+<TABLE CELLSPACING="10">
+<TR>
+ <TD>From
+ <& /elements/input-date-field.html, {
+ name => 'beginning',
+ value => $cgi->param('beginning'),
+ } &>
+ </TD>
+ <TD>To
+ <& /elements/input-date-field.html, {
+ name => 'ending',
+ value => $cgi->param('ending') || '',
+ noinit => 1,
+ } &>
+ </TD>
+</TR>
+<TR>
+ <TD>Level
+ <& /elements/select.html,
+ field => 'min_level',
+ options => [ 0..7 ],
+ labels => { map {$_ => $FS::Log::LEVELS[$_]} 0..7 },
+ curr_value => $cgi->param('min_level'),
+ &>
+ to
+ <& /elements/select.html,
+ field => 'max_level',
+ options => [ 0..7 ],
+ labels => { map {$_ => $FS::Log::LEVELS[$_]} 0..7 },
+ curr_value => $cgi->param('max_level'),
+ &>
+ </TD>
+ <TD>
+ Context
+ <& /elements/select.html,
+ field => 'context',
+ options => \@contexts,
+ labels => { map {$_, $_} @contexts },
+ curr_value => ($cgi->param('context') || ''),
+ &>
+ </TD>
+</TR>
+<TR>
+ <TD COLSPAN=2>
+ Containing text
+ <& /elements/input-text.html,
+ field => 'message',
+ size => 30,
+ size => 30,
+ curr_value => ($cgi->param('message') || ''),
+ &>
+ <DIV STYLE="display:inline; float:right">
+ <INPUT TYPE="submit" VALUE="Refresh">
+ </DIV>
+ </TD>
+</TR>
+</TABLE>
+</%def>
+<%once>
+my $date_sub = sub { time2str('%Y-%m-%d %T', $_[0]->_date) };
+
+my $level_sub = sub { $FS::Log::LEVELS[$_[0]->level] };
+
+my $context_sub = sub {
+ my $log = shift;
+ ($log->context)[-1] . (scalar($log->context) > 1 ? '...' : '') ;
+ # XXX find a way to make this use less space (dropdown?)
+};
+
+my $tt_sub = sub {
+ my $log = shift;
+ my @context = $log->context;
+ # don't create a tooltip if there's only one context entry and the
+ # message isn't cut off
+ return '' if @context == 1 and length($log->message) <= 60;
+ my $html = '<DIV CLASS="tooltip">'.(shift @context).'</DIV>';
+ my $pre = '↳';
+ foreach (@context, $log->message) {
+ $html .= "<DIV>$pre$_</DIV>";
+ $pre = ' '.$pre;
+ }
+ $html;
+};
+
+my $object_sub = sub {
+ my $log = shift;
+ return '' unless $log->tablename;
+ # this is a sysadmin log; anyone reading it should be able to understand
+ # 'cust_main #2319' with no trouble.
+ $log->tablename . ' #' . $log->tablenum;
+};
+
+my $message_sub = sub {
+ my $log = shift;
+ my $message = $log->message;
+ if ( length($message) > 60 ) { # pretty arbitrary
+ $message = substr($message, 0, 57) . '...';
+ }
+ $message;
+};
+
+my $object_link_sub = sub {
+ my $log = shift;
+ my $table = $log->tablename or return;
+ # sigh
+ if ( grep {$_ eq $table} (qw( cust_bill cust_main cust_pkg cust_svc ))
+ or $table =~ /^svc_/ )
+ {
+
+ return [ $fsurl.'view/'.$table.'.cgi?'. $log->tablenum ];
+
+ } elsif ( grep {$_ eq $table} (qw( cust_msg cust_pay cust_pay_void
+ cust_refund cust_statement )) )
+ {
+
+ return [ $fsurl.'view/'.$table.'.html?', $log->tablenum ];
+
+ } else { # you're on your own
+
+ return '';
+
+ }
+};
+
+my @colors = (
+ '404040', #debug
+ '0000aa', #info
+ '00aa00', #notice
+ 'aa0066', #warning
+ '000000', #error
+ 'aa0000', #critical
+ 'ff0000', #alert
+ 'ff0000', #emergency
+);
+
+my $color_sub = sub { $colors[ $_[0]->level ]; };
+
+my @contexts = ('', sort FS::log_context->contexts);
+</%once>
+<%init>
+my $curuser = $FS::CurrentUser::CurrentUser;
+die "access denied"
+ unless $curuser->access_right([ 'View system logs', 'Configuration' ]);
+
+$cgi->param('min_level', 0) unless defined($cgi->param('min_level'));
+$cgi->param('max_level', 7) unless defined($cgi->param('max_level'));
+
+my %search = ();
+$search{'date'} = [ FS::UI::Web::parse_beginning_ending($cgi) ];
+$search{'level'} = [ $cgi->param('min_level'), $cgi->param('max_level') ];
+foreach my $param (qw(agentnum context tablename tablenum custnum message)) {
+ if ( $cgi->param($param) ) {
+ $search{$param} = $cgi->param($param);
+ }
+}
+my $query = FS::log->search(\%search); # validates everything
+my $count_query = delete $query->{'count_query'};
+
+</%init>
--- /dev/null
+<& /elements/header.html, mt('Line item report') &>
+
+<FORM ACTION="cust_bill_pkg.cgi" METHOD="GET">
+<!--<INPUT TYPE="hidden" NAME="magic" VALUE="_date">-->
+
+<TABLE BGCOLOR="#cccccc" CELLSPACING=0
+
+<& /elements/tr-select-agent.html,
+ curr_value => scalar( $cgi->param('agentnum') ),
+ #label => emt('Line items for agent: '),
+ disable_empty => 0,
+&>
+
+<& /elements/tr-select-cust_main-status.html,
+ label => emt('Customer status'),
+&>
+
+<!-- customer
+<& /elements/tr-select-cust_class.html,
+ 'label' => emt('Class'),
+ 'multiple' => 1,
+ 'pre_options' => [ '' => emt('(none)') ],
+ 'all_selected' => 1,
+&>
+-->
+
+<& /elements/tr-input-beginning_ending.html &>
+
+<!-- needs support in cust_bill_pkg.cgi
+<& /elements/tr-input-lessthan_greaterthan.html,
+ label => emt('Amount'),
+ field => 'amount',
+&>
+-->
+
+<!-- customer payment method i guess
+ <& /elements/tr-select-payby.html,
+ label => emt('Payment method:'),
+ payby_type => 'cust',
+ multiple => 1,
+ all_selected => 1,
+ &>
+-->
+
+<TR>
+ <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="nottax" VALUE="Y" onClick="nottax_changed(this)" onChange="nottax_change(thid)"></TD>
+ <TD><% mt('Omit taxes') |h %></TD>
+</TD>
+
+<TR>
+ <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="istax" VALUE="Y" onClick="istax_changed(this)" onChange="istax_change(thid)"></TD>
+ <TD><% mt('Taxes only') |h %></TD>
+</TD>
+
+<!--
+<TR>
+ <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="credit" VALUE="Y"></TD>
+ <TD><% mt("Credit (what's this do?)") |h %></TD>
+</TD>
+-->
+
+</TABLE>
+
+<SCRIPT TYPE="text/javascript">
+ function nottax_changed (what) {
+ if (what.checked && what.form.istax.checked) {
+ what.form.istax.checked = false;
+ }
+ }
+ function istax_changed (what) {
+ if (what.checked && what.form.nottax.checked) {
+ what.form.nottax.checked = false;
+ }
+ }
+</SCRIPT>
+
+<BR>
+<INPUT TYPE="submit" VALUE="<% mt('Get Report') |h %>">
+
+</FORM>
+
+<& /elements/footer.html &>
+<%init>
+
+#Financial reports?
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('List invoices');
+
+my $conf = new FS::Conf;
+
+#other available params (cust_bill_pkg.cgi):
+#
+#distribute = 1
+#
+#(when nottax)
+# use_override something about part_pkg
+# classnum package class
+# taxclass / taxclassNULL
+# exempt_cust
+# exempt_pkg
+# region (country:state:county:city:district)
+# taxable
+# out (of taxable region)
+# usage
+#(when istax)
+# locationtaxid (& district/city/ciounty/state)
+# out (of taxable region)
+# taxclassNULL
+# report_group (itemdesc)
+# itemdesc
+#
+#taxname/taxnameNULL cust_main_county
+#taxnum cust_main_county
+#credit (hmm need to look more at what this does)
+
+
+</%init>
+
--- /dev/null
+<& /elements/header.html, mt('Credit application report') &>
+
+<FORM ACTION="cust_credit_bill_pkg.html" METHOD="GET">
+<!--<INPUT TYPE="hidden" NAME="magic" VALUE="_date">-->
+
+<TABLE BGCOLOR="#cccccc" CELLSPACING=0
+
+<& /elements/tr-select-user.html,
+ 'label' => emt('Employee: '),
+ 'access_user' => \%access_user,
+&>
+
+<& /elements/tr-select-agent.html,
+ curr_value => scalar( $cgi->param('agentnum') ),
+ #label => emt('Line items for agent: '),
+ disable_empty => 0,
+&>
+
+<!--
+<& /elements/tr-select-cust_main-status.html,
+ label => emt('Customer status'),
+&>
+-->
+
+<!-- customer
+<& /elements/tr-select-cust_class.html,
+ 'label' => emt('Class'),
+ 'multiple' => 1,
+ 'pre_options' => [ '' => emt('(none)') ],
+ 'all_selected' => 1,
+&>
+-->
+
+<!-- some sort of label saying this is the credit date... -->
+<& /elements/tr-input-beginning_ending.html,
+ 'prefix' => 'credit',
+&>
+
+<& /elements/tr-input-lessthan_greaterthan.html,
+ label => emt('Amount'),
+ field => 'amount',
+&>
+
+<!-- customer payment method i guess
+ <& /elements/tr-select-payby.html,
+ label => emt('Payment method:'),
+ payby_type => 'cust',
+ multiple => 1,
+ all_selected => 1,
+ &>
+-->
+
+<!--
+<TR>
+ <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="nottax" VALUE="Y" onClick="nottax_changed(this)" onChange="nottax_change(thid)"></TD>
+ <TD><% mt('Omit taxes') |h %></TD>
+</TD>
+
+<TR>
+ <TD ALIGN="right"><INPUT TYPE="checkbox" NAME="istax" VALUE="Y" onClick="istax_changed(this)" onChange="istax_change(thid)"></TD>
+ <TD><% mt('Taxes only') |h %></TD>
+</TD>
+
+<SCRIPT TYPE="text/javascript">
+ function nottax_changed (what) {
+ if (what.checked && what.form.istax.checked) {
+ what.form.istax.checked = false;
+ }
+ }
+ function istax_changed (what) {
+ if (what.checked && what.form.nottax.checked) {
+ what.form.nottax.checked = false;
+ }
+ }
+</SCRIPT>
+-->
+
+</TABLE>
+
+<BR>
+<INPUT TYPE="submit" VALUE="<% mt('Get Report') |h %>">
+
+</FORM>
+
+<& /elements/footer.html &>
+<%init>
+
+#Financial reports?
+die "access denied"
+ unless $FS::CurrentUser::CurrentUser->access_right('Financial reports');
+
+#false laziness w/report_cust_credit.html
+my $sth = dbh->prepare("SELECT DISTINCT usernum FROM cust_credit")
+ or die dbh->errstr;
+$sth->execute or die $sth->errstr;
+my @usernum = map $_->[0], @{$sth->fetchall_arrayref};
+my %access_user =
+ map { $_ => qsearchs('access_user',{'usernum'=>$_})->username }
+ @usernum;
+
+my $conf = new FS::Conf;
+
+</%init>
+
-<% $data %>
<%init>
my $htmldoc = include('report_tax.cgi');
$workbook->close;
+http_header('Content-Length' => length($data));
+$m->print($data);
</%init>
'actionlabel' => emt('Enter credit'),
'width' => 616, #make room for reasons #540 default
&>
+ |
+ <& /elements/popup_link-cust_main.html,
+ 'label' => emt('Credit line items'),
+ #'action' => "${p}search/cust_bill_pkg.cgi?nottax=1;type=select",
+ 'action' => "${p}edit/credit-cust_bill_pkg.html",
+ 'cust_main' => $cust_main,
+ 'actionlabel' => emt('Credit line items'),
+ 'width' => 884, #763,
+ 'height' => 575,
+ &>
<BR>
% }
%}
<& /elements/footer.html &>
-<%once>
-use List::MoreUtils qw(uniq);
-</%once>
<%init>
my $curuser = $FS::CurrentUser::CurrentUser;
rt-shredder \
rt-test-dependencies \
rt-validator \
+ rt-validate-aliases \
standalone_httpd
#! /bin/sh
# From configure.ac Revision.
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for RT rt-4.0.7.
+# Generated by GNU Autoconf 2.68 for RT rt-4.0.8.
#
# Report bugs to <rt-bugs@bestpractical.com>.
#
# Identity of this package.
PACKAGE_NAME='RT'
PACKAGE_TARNAME='rt'
-PACKAGE_VERSION='rt-4.0.7'
-PACKAGE_STRING='RT rt-4.0.7'
+PACKAGE_VERSION='rt-4.0.8'
+PACKAGE_STRING='RT rt-4.0.8'
PACKAGE_BUGREPORT='rt-bugs@bestpractical.com'
PACKAGE_URL=''
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures RT rt-4.0.7 to adapt to many kinds of systems.
+\`configure' configures RT rt-4.0.8 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of RT rt-4.0.7:";;
+ short | recursive ) echo "Configuration of RT rt-4.0.8:";;
esac
cat <<\_ACEOF
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-RT configure rt-4.0.7
+RT configure rt-4.0.8
generated by GNU Autoconf 2.68
Copyright (C) 2010 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by RT $as_me rt-4.0.7, which was
+It was created by RT $as_me rt-4.0.8, which was
generated by GNU Autoconf 2.68. Invocation command line was
$ $0 $@
rt_version_minor=0
-rt_version_patch=7
+rt_version_patch=8
test "x$rt_version_major" = 'x' && rt_version_major=0
test "x$rt_version_minor" = 'x' && rt_version_minor=0
fi
-ac_config_files="$ac_config_files etc/upgrade/3.8-branded-queues-extension etc/upgrade/3.8-ical-extension etc/upgrade/split-out-cf-categories etc/upgrade/generate-rtaddressregexp etc/upgrade/upgrade-articles etc/upgrade/vulnerable-passwords sbin/rt-attributes-viewer sbin/rt-preferences-viewer sbin/rt-session-viewer sbin/rt-dump-metadata sbin/rt-setup-database sbin/rt-test-dependencies sbin/rt-email-digest sbin/rt-email-dashboards sbin/rt-clean-sessions sbin/rt-shredder sbin/rt-validator sbin/rt-email-group-admin sbin/rt-server sbin/rt-server.fcgi sbin/standalone_httpd sbin/rt-setup-fulltext-index sbin/rt-fulltext-indexer bin/rt-crontool bin/rt-mailgate bin/rt"
+ac_config_files="$ac_config_files etc/upgrade/3.8-branded-queues-extension etc/upgrade/3.8-ical-extension etc/upgrade/split-out-cf-categories etc/upgrade/generate-rtaddressregexp etc/upgrade/upgrade-articles etc/upgrade/vulnerable-passwords sbin/rt-attributes-viewer sbin/rt-preferences-viewer sbin/rt-session-viewer sbin/rt-dump-metadata sbin/rt-setup-database sbin/rt-test-dependencies sbin/rt-email-digest sbin/rt-email-dashboards sbin/rt-clean-sessions sbin/rt-shredder sbin/rt-validator sbin/rt-validate-aliases sbin/rt-email-group-admin sbin/rt-server sbin/rt-server.fcgi sbin/standalone_httpd sbin/rt-setup-fulltext-index sbin/rt-fulltext-indexer bin/rt-crontool bin/rt-mailgate bin/rt"
ac_config_files="$ac_config_files Makefile etc/RT_Config.pm lib/RT/Generated.pm t/data/configs/apache2.2+mod_perl.conf t/data/configs/apache2.2+fastcgi.conf"
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by RT $as_me rt-4.0.7, which was
+This file was extended by RT $as_me rt-4.0.8, which was
generated by GNU Autoconf 2.68. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-RT config.status rt-4.0.7
+RT config.status rt-4.0.8
configured by $0, generated by GNU Autoconf 2.68,
with options \\"\$ac_cs_config\\"
"sbin/rt-clean-sessions") CONFIG_FILES="$CONFIG_FILES sbin/rt-clean-sessions" ;;
"sbin/rt-shredder") CONFIG_FILES="$CONFIG_FILES sbin/rt-shredder" ;;
"sbin/rt-validator") CONFIG_FILES="$CONFIG_FILES sbin/rt-validator" ;;
+ "sbin/rt-validate-aliases") CONFIG_FILES="$CONFIG_FILES sbin/rt-validate-aliases" ;;
"sbin/rt-email-group-admin") CONFIG_FILES="$CONFIG_FILES sbin/rt-email-group-admin" ;;
"sbin/rt-server") CONFIG_FILES="$CONFIG_FILES sbin/rt-server" ;;
"sbin/rt-server.fcgi") CONFIG_FILES="$CONFIG_FILES sbin/rt-server.fcgi" ;;
;;
"sbin/rt-validator":F) chmod ug+x $ac_file
;;
+ "sbin/rt-validate-aliases":F) chmod ug+x $ac_file
+ ;;
"sbin/rt-email-group-admin":F) chmod ug+x $ac_file
;;
"sbin/rt-server":F) chmod ug+x $ac_file
sbin/rt-clean-sessions
sbin/rt-shredder
sbin/rt-validator
+ sbin/rt-validate-aliases
sbin/rt-email-group-admin
sbin/rt-server
sbin/rt-server.fcgi
+++ /dev/null
-# Single-process Apache testing with mod_perl, mod_fcgi, or mod_fastcgi
-#
-# Start this via:
-# apache2 -f `pwd`/devel/tools/apache.conf -DPERL -k start
-#
-# The full path to the configuration file is needed, or Apache assumes
-# it is under the ServerRoot. Since the deployment strategies differ
-# between RT 3 and 4, you must either supply -DRT3 if you are attempting
-# to deploy an rt3 instance. You must also supply one of -DPERL,
-# -DFASTCGI, or -DFCGID.
-#
-# The /opt/rt4/etc/apache_local.conf file should contain:
-# User chmrr
-# Group chmrr
-# Listen 8080
-# ...or the equivilent.
-#
-# Apache access and error logs will be written to /opt/rt4/var/log/.
-#
-<IfDefine !RT3>
-Include /opt/rt4/etc/apache_local.conf
-</IfDefine>
-<IfDefine RT3>
-Include /opt/rt3/etc/apache_local.conf
-</IfDefine>
-
-<IfModule mpm_prefork_module>
- StartServers 1
- MinSpareServers 1
- MaxSpareServers 1
- MaxClients 1
- MaxRequestsPerChild 0
-</IfModule>
-
-<IfModule mpm_worker_module>
- StartServers 1
- MinSpareThreads 1
- MaxSpareThreads 1
- ThreadLimit 1
- ThreadsPerChild 1
- MaxClients 1
- MaxRequestsPerChild 0
-</IfModule>
-
-ServerRoot /etc/apache2
-PidFile /opt/rt4/var/apache2.pid
-LockFile /opt/rt4/var/apache2.lock
-ServerAdmin root@localhost
-
-LoadModule authz_host_module /usr/lib/apache2/modules/mod_authz_host.so
-LoadModule env_module /usr/lib/apache2/modules/mod_env.so
-LoadModule alias_module /usr/lib/apache2/modules/mod_alias.so
-LoadModule mime_module /usr/lib/apache2/modules/mod_mime.so
-<IfDefine PERL>
- LoadModule perl_module /usr/lib/apache2/modules/mod_perl.so
-</IfDefine>
-<IfDefine FASTCGI>
- LoadModule fastcgi_module /usr/lib/apache2/modules/mod_fastcgi.so
-</IfDefine>
-<IfDefine FCGID>
- LoadModule fcgid_module /usr/lib/apache2/modules/mod_fcgid.so
-</IfDefine>
-
-ErrorLog "/opt/rt4/var/log/apache-error.log"
-TransferLog "/opt/rt4/var/log/apache-access.log"
-LogLevel debug
-
-<Directory />
- Options FollowSymLinks
- AllowOverride None
- Order deny,allow
- Deny from all
-</Directory>
-
-AddDefaultCharset UTF-8
-
-DocumentRoot /var/www
-<Directory /var/www>
- Order allow,deny
- Allow from all
-</Directory>
-
-Alias /NoAuth/images/ /opt/rt4/share/html/NoAuth/images/
-<Directory /opt/rt4/share/html/NoAuth/images>
- Order allow,deny
- Allow from all
-</Directory>
-
-<IfDefine !RT3>
-########## 4.0 mod_perl
-<IfDefine PERL>
- PerlSetEnv RT_SITE_CONFIG /opt/rt4/etc/RT_SiteConfig.pm
- <Location />
- Order allow,deny
- Allow from all
- SetHandler modperl
- PerlResponseHandler Plack::Handler::Apache2
- PerlSetVar psgi_app /opt/rt4/sbin/rt-server
- </Location>
- <Perl>
- use Plack::Handler::Apache2;
- Plack::Handler::Apache2->preload("/opt/rt4/sbin/rt-server");
- </Perl>
-</IfDefine>
-
-########## 4.0 mod_fastcgi
-<IfDefine FASTCGI>
- FastCgiIpcDir /opt/rt4/var
- FastCgiServer /opt/rt4/sbin/rt-server.fcgi -processes 1 -idle-timeout 300
- ScriptAlias / /opt/rt4/sbin/rt-server.fcgi/
- <Location />
- Order allow,deny
- Allow from all
- Options +ExecCGI
- AddHandler fastcgi-script fcgi
- </Location>
-</IfDefine>
-
-########## 4.0 mod_fcgid
-<IfDefine FCGID>
- FcgidProcessTableFile /opt/rt4/var/fcgid_shm
- FcgidIPCDir /opt/rt4/var
- ScriptAlias / /opt/rt4/sbin/rt-server.fcgi/
- <Location />
- Order allow,deny
- Allow from all
- Options +ExecCGI
- AddHandler fcgid-script fcgi
- </Location>
-</IfDefine>
-</IfDefine>
-
-
-<IfDefine RT3>
-########## 3.8 mod_perl
-<IfDefine PERL>
- PerlSetEnv RT_SITE_CONFIG /opt/rt3/etc/RT_SiteConfig.pm
- PerlRequire "/opt/rt3/bin/webmux.pl"
- <Location /NoAuth/images>
- SetHandler default
- </Location>
- <Location />
- SetHandler perl-script
- PerlResponseHandler RT::Mason
- </Location>
-</IfDefine>
-
-########## 3.8 mod_fastcgi
-<IfDefine FASTCGI>
- FastCgiIpcDir /opt/rt3/var
- FastCgiServer /opt/rt3/bin/mason_handler.fcgi -processes 1 -idle-timeout 300
- ScriptAlias / /opt/rt3/bin/mason_handler.fcgi/
- <Location />
- Order allow,deny
- Allow from all
- Options +ExecCGI
- AddHandler fastcgi-script fcgi
- </Location>
-</IfDefine>
-
-########## 3.8 mod_fcgid
-<IfDefine FCGID>
- FcgidProcessTableFile /opt/rt3/var/fcgid_shm
- FcgidIPCDir /opt/rt3/var
- ScriptAlias / /opt/rt3/bin/mason_handler.fcgi/
- <Location />
- Order allow,deny
- Allow from all
- Options +ExecCGI
- AddHandler fcgid-script fcgi
- </Location>
-</IfDefine>
-</IfDefine>
-UPGRADING FROM 2.x:
+=head1 UPGRADING FROM 2.x
-The core RT distribution does not contain the tool to upgrade RT from
-version 2.0; the tool, can be downloaded from CPAN at
+The core RT distribution does not contain the tool to upgrade RT from version
+2.0; the tool, can be downloaded from CPAN at
http://search.cpan.org/dist/RT-Extension-RT2toRT3/
Further instructions may be found in that distribution's README file.
-UPGRADING FROM 3.0.x - Changes:
+=head1 UPGRADING FROM 3.0.0 AND EARLIER
-= Installation =
+=head2 Installation
We recommend you move your existing /opt/rt3 tree completely out
of the way before installing the new version of RT, to make sure
that you don't inadvertently leave old files hanging around.
-= Rights changes =
+
+=head2 Rights changes
Now, if you want RT to automatically create new users upon ticket
submission, you MUST grant 'Everyone' the right to create tickets.
Granting this right only to "Unprivileged Users" is now insufficient.
-= Web server configuration
+
+=head2 Web server configuration
The configuration for RT's web interface has changed. Please refer to
docs/web_deployment.pod for instructions.
-UPGRADING FROM 3.2 and earlier - Changes:
+=head1 UPGRADING FROM 3.2.0 AND EARLIER
-= Rights changes =
+There have been a number of rights changes. Now, if you want any user to be
+able to access the Admin tools (a.k.a. the Configuration tab), you must grant
+that user the "ShowConfigTab" right. Making the user a privileged user is no
+longer sufficient.
-Now, if you want any user to be able to access the Admin tools (a.k.a.
-the Configuration tab), you must grant that user the "ShowConfigTab"
-right. Making the user a privileged user is no longer sufficient.
-
-"SuperUser" users are no longer automatically added to the list of users
-who can own tickets in a queue. You now need to explicitly give them the
+"SuperUser" users are no longer automatically added to the list of users who
+can own tickets in a queue. You now need to explicitly give them the
"OwnTicket" right.
-UPGRADING FROM 3.3.14 and earlier - Changes:
+=head1 UPGRADING FROM 3.3.14 AND EARLIER
The "ModifyObjectCustomFieldValues" right name was too long. It has been
changed to "ModifyCustomField"
-UPGRADING FROM 3.3.11 and earlier - Changes:
+=head1 UPGRADING FROM 3.3.11 AND EARLIER
-Custom Fields now have an additional right, "ModifyCustomField". This
-right governs whether a user can modify an object's custom field values
-for a particular custom field. This includes adding, deleting and
-changing values.
+Custom Fields now have an additional right, "ModifyCustomField". This right
+governs whether a user can modify an object's custom field values for a
+particular custom field. This includes adding, deleting and changing values.
-UPGRADING FROM 3.6.X and earlier - Changes:
+=head1 UPGRADING FROM 3.6.0 AND EARLIER
-As there are a large number of code changes, it is highly recommended
-that you install RT into a fresh directory, and then reinstall your
-customizations.
+As there are a large number of code changes, it is highly recommended that you
+install RT into a fresh directory, and then reinstall your customizations.
-The database schema has changed significantly for mysql 4.1 and above;
-please read UPGRADING.mysql for more details.
+The database schema has changed significantly for mysql 4.1 and above; please
+read UPGRADING.mysql for more details.
-The configuration format has been made stricter. All options MUST be set
-using the Set function; the historical "@XXX = (...) unless @XXX;" is no
-longer allowed.
+The configuration format has been made stricter. All options MUST be set using
+the Set function; the historical "@XXX = (...) unless @XXX;" is no longer
+allowed.
The RTx::Shredder extension has been integrated into core, and several
features have been added, so you MUST uninstall it before upgrading.
-A new interface for making links in text clickable, and doing other
-arbitrary text replacements, has been integrated into RT. You can read
-more in `perldoc docs/extending/clickable_links.pod`.
+A new interface for making links in text clickable, and doing other arbitrary
+text replacements, has been integrated into RT. You can read more in `perldoc
+docs/extending/clickable_links.pod`.
-A new feature has been added that allows users to forward
-messages. There is a new option in the config ($ForwardFromUser), new
-rights, and a new template.
+A new feature has been added that allows users to forward messages. There is a
+new option in the config ($ForwardFromUser), new rights, and a new template.
-New global templates have been added with "Error: " prefixed to the name
-to make it possible to configure error messages sent to users.
+New global templates have been added with "Error: " prefixed to the name to
+make it possible to configure error messages sent to users.
You can read about the new GnuPG integration in `perldoc
lib/RT/Crypt/GnuPG.pm`.
New scrip conditions 'On Close' and 'On Reopen' have been added.
-UPGRADING FROM 3.5.7 and earlier - Changes:
+=head1 UPGRADING FROM 3.5.7 AND EARLIER
Scrips are now prepared and committed in order alphanumerically by
-description. This means that you can prepend a number (00, 07, 15, 24)
-to the beginning of each scrip's description, and they will run in that
-order. Depending on your database, the old ordering may have been by
-scrip id number -- if that is the case, simply prepend the scrip id
-number to the beginning of its description.
+description. This means that you can prepend a number (00, 07, 15, 24) to the
+beginning of each scrip's description, and they will run in that order.
+Depending on your database, the old ordering may have been by scrip id number
+-- if that is the case, simply prepend the scrip id number to the beginning of
+its description.
-UPGRADING FROM 3.5.1 and earlier - Changes:
+=head1 UPGRADING FROM 3.5.1 AND EARLIER
The default for $RedistributeAutoGeneratedMessages has changed to
'privileged', to make out-of-the-box installations more resistant to
-mail loops. If you rely on the old default of redistributing to all
-watchers, you'll need to set it explicitly now.
+mail loops. If you rely on the old default of redistributing to all watchers,
+you'll need to set it explicitly now.
-UPGRADING FROM 3.8.8 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.8 AND EARLIER
-Previous versions of RT used a password hashing scheme which was too
-easy to reverse, which could allow attackers with read access to the RT
-database to possibly compromise users' passwords. Even if RT does no
-password authentication itself, it may still store these weak password
-hashes -- using ExternalAuth does not guarantee that you are not
-vulnerable! To upgrade stored passwords to a stronger hash, run:
+Previous versions of RT used a password hashing scheme which was too easy to
+reverse, which could allow attackers with read access to the RT database to
+possibly compromise users' passwords. Even if RT does no password
+authentication itself, it may still store these weak password hashes -- using
+ExternalAuth does not guarantee that you are not vulnerable! To upgrade
+stored passwords to a stronger hash, run:
perl etc/upgrade/vulnerable-passwords
-We have also proved that it's possible to delete a notable set of
-records from Transactions table without losing functionality. To delete
-these records, run the following script:
+We have also proved that it's possible to delete a notable set of records from
+Transactions table without losing functionality. To delete these records, run
+the following script:
perl -I /opt/rt4/local/lib -I /opt/rt4/lib etc/upgrade/shrink_transactions_table.pl
-If you chose not to run the shrink_cgm_table.pl script when you upgraded
-to 3.8, you should read more about it below and run it at this point.
+If you chose not to run the shrink_cgm_table.pl script when you upgraded to
+3.8, you should read more about it below and run it at this point.
-The default for $MessageBoxWrap is now SOFT and $MessageBoxWidth is now
-unset by default. This means the message box will expand to fill all
-the available width. $MessageBoxWrap is also overridable by the user
-now. These changes accommodate the new default two column layout for
-ticket create and update pages. You may turn this layout off by setting
-$UseSideBySideLayout to 0. To retain the original behavior, set
-$MessageBoxWrap to HARD and $MessageBoxWidth to 72.
+The default for $MessageBoxWrap is now SOFT and $MessageBoxWidth is now unset
+by default. This means the message box will expand to fill all the available
+width. $MessageBoxWrap is also overridable by the user now. These changes
+accommodate the new default two column layout for ticket create and update
+pages. You may turn this layout off by setting $UseSideBySideLayout to 0. To
+retain the original behavior, set $MessageBoxWrap to HARD and $MessageBoxWidth
+to 72.
-UPGRADING FROM 3.8.7 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.7 AND EARLIER
-RT's ChartFont option has been changed from a string to a hash which
-lets you specify per-language fonts. RT now comes with a better default
-font for charts, too. You should either update your 'ChartFont' option
-to match the new format, or consider trying the new default.
+RT's ChartFont option has been changed from a string to a hash which lets you
+specify per-language fonts. RT now comes with a better default font for
+charts, too. You should either update your 'ChartFont' option to match the
+new format, or consider trying the new default.
-RT now gives you more precise control over the order in which custom
-fields are displayed. This change requires some small changes to your
-currently saved custom field orders. RT will automatically clean up
-your existing custom fields when you run the standard database upgrade
-steps. After that cleanup, you should make sure that custom fields are
-ordered in a way that you and your users find pleasing.
+RT now gives you more precise control over the order in which custom fields
+are displayed. This change requires some small changes to your currently
+saved custom field orders. RT will automatically clean up your existing
+custom fields when you run the standard database upgrade steps. After that
+cleanup, you should make sure that custom fields are ordered in a way that you
+and your users find pleasing.
-UPGRADING FROM 3.8.6 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.6 AND EARLIER
-For MySQL and Oracle users:
-If you upgraded from a version of RT earlier than 3.7.81, you should
-already have a CachedGroupMembers3 index on your CachedGroupMembers
-table. If you did a clean install of RT somewhere in the 3.8 release
-series, you most likely don't have this index. You can add it manually
-with:
+For MySQL and Oracle users: if you upgraded from a version of RT earlier than
+3.7.81, you should already have a CachedGroupMembers3 index on your
+CachedGroupMembers table. If you did a clean install of RT somewhere in the
+3.8 release series, you most likely don't have this index. You can add it
+manually with:
CREATE INDEX CachedGroupMembers3 on CachedGroupMembers (MemberId, ImmediateParentId);
-UPGRADING FROM 3.8.5 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.5 AND EARLIER
You can now forward an entire Ticket history (in addition to specific
-transactions) but this requires a new Template called "Forward Ticket".
-This template will be added as part of the standard database upgrade
-step.
+transactions) but this requires a new Template called "Forward Ticket". This
+template will be added as part of the standard database upgrade step.
-Custom fields with categories can optionally be split out into
-hierarchical custom fields. If you wish to convert your old
-category-based custom fields, run:
+Custom fields with categories can optionally be split out into hierarchical
+custom fields. If you wish to convert your old category-based custom fields,
+run:
perl etc/upgrade/split-out-cf-categories
-It will prompt you for each custom field with categories that it finds,
-and the name of the custom field to create to store the categories.
+It will prompt you for each custom field with categories that it finds, and
+the name of the custom field to create to store the categories.
-If you were using the LocalizedDateTime RT::Date formatter from custom
-code, and passing a DateFormat or TimeFormat argument, you need to
-switch from the strftime methods to the cldr methods; that is,
+If you were using the LocalizedDateTime RT::Date formatter from custom code,
+and passing a DateFormat or TimeFormat argument, you need to switch from the
+strftime methods to the cldr methods; that is,
'full_date_format' becomes 'date_format_full'.
You may also have done this from your RT_SiteConfig.pm, using:
+
Set($DateTimeFormat, {
Format => 'LocalizedDateTime',
DateFormat => 'medium_date_format',
);
+
Which would need to be changed to:
+
Set($DateTimeFormat, {
Format => 'LocalizedDateTime',
DateFormat => 'date_format_medium',
);
-UPGRADING FROM 3.8.3 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.3 AND EARLIER
Arguments to the NotifyGroup Scrip Action will be updated as part of the
standard database upgrade process.
-UPGRADING FROM 3.8.2 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.2 AND EARLIER
A new scrip condition, 'On Reject', has been added.
-UPGRADING FROM 3.8.1 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.1 AND EARLIER
-When using Oracle, $DatabaseName is now used as SID, so RT can connect
-without environment variables or tnsnames.ora file. Because of this
-change, your RT instance may loose its ability to connect to your DB; to
-resolve this, you will need to update RT's configuration and restart
-your web server. Example configuration:
+When using Oracle, $DatabaseName is now used as SID, so RT can connect without
+environment variables or tnsnames.ora file. Because of this change, your RT
+instance may loose its ability to connect to your DB; to resolve this, you
+will need to update RT's configuration and restart your web server. Example
+configuration:
Set($DatabaseType, 'Oracle');
Set($DatabaseHost, '192.168.0.1');
Approvals tab), you must grant that user the "ShowApprovalsTab" right.
-UPGRADING FROM 3.8.0 and earlier - Changes:
+=head1 UPGRADING FROM 3.8.0 AND EARLIER
-The TicketSQL syntax for bookmarked tickets has been changed.
-Specifically, the new phrasing is "id = '__Bookmarked__'", rather than
-the old "__Bookmarks__". The old form will remain, for backwards
-compatibility. The standard database upgrade process will only
-automatically change the global 'Bookmarked Tickets' search
+The TicketSQL syntax for bookmarked tickets has been changed. Specifically,
+the new phrasing is "id = '__Bookmarked__'", rather than the old
+"__Bookmarks__". The old form will remain, for backwards compatibility. The
+standard database upgrade process will only automatically change the
+global 'Bookmarked Tickets' search
-UPGRADING FROM 3.7.85 and earlier - Changes:
+=head1 UPGRADING FROM 3.7.85 AND EARLIER
-We have proved that it is possible to delete a large set of records from
-the CachedGroupMembers table without losing functionality; in fact,
-failing to do so may result in occasional problems where RT miscounts
-users, particularly in the chart functionality. To delete these records
-run the following script:
+We have proved that it is possible to delete a large set of records from the
+CachedGroupMembers table without losing functionality; in fact, failing to do
+so may result in occasional problems where RT miscounts users, particularly in
+the chart functionality. To delete these records run the following script:
perl -I /opt/rt4/local/lib -I /opt/rt4/lib etc/upgrade/shrink_cgm_table.pl
-After you run this, you will have significantly reduced the number of
-records in your CachedGroupMembers table, and may need to tell your
-database to refresh indexes/statistics. Please consult your DBA for
-specific instructions for your database.
+After you run this, you will have significantly reduced the number of records
+in your CachedGroupMembers table, and may need to tell your database to
+refresh indexes/statistics. Please consult your DBA for specific instructions
+for your database.
-UPGRADING FROM 3.7.81 and earlier - Changes:
+=head1 UPGRADING FROM 3.7.81 AND EARLIER
-RT::Extension::BrandedQueues has been integrated into core, and the
-handling of subject tags has changed as a consequence. You will need to
-modify any of your email templates which use the $rtname variable, in
-order to make them respect the per-queue subject tags. To edit your
-templates, log into RT as your administrative user, then click:
+RT::Extension::BrandedQueues has been integrated into core, and the handling
+of subject tags has changed as a consequence. You will need to modify any of
+your email templates which use the $rtname variable, in order to make them
+respect the per-queue subject tags. To edit your templates, log into RT as
+your administrative user, then click:
Configuration -> Global -> Templates -> Select -> <Some template name>
-The only template which ships with RT which needs updating is the
-"Autoreply" template, which includes this line:
+The only template which ships with RT which needs updating is the "Autoreply"
+template, which includes this line:
- "There is no need to reply to this message right now. Your ticket
- has been assigned an ID of [{$rtname} #{$Ticket->id()}]."
+ "There is no need to reply to this message right now. Your ticket has
+ been assigned an ID of [{$rtname} #{$Ticket->id()}]."
Change this line to read:
- "There is no need to reply to this message right now. Your ticket
- has been assigned an ID of { $Ticket->SubjectTag }."
+ "There is no need to reply to this message right now. Your ticket has
+ been assigned an ID of { $Ticket->SubjectTag }."
-If you were previously using RT::Extension::BrandedQueues, you MUST
-uninstall it before upgrading. In addition, you must run the
+If you were previously using RT::Extension::BrandedQueues, you MUST uninstall
+it before upgrading. In addition, you must run the
'etc/upgrade/3.8-branded-queues-extension' perl script. This will
convert the extension's configuration into the new format. Finally, in
templates where you were using the Tag method ($Ticket->QueueObj->Tag),
you will need to replace it with $Ticket->SubjectTag
-RT::Action::LinearEscalate extension has been integrated into core,
-so you MUST uninstall it before upgrading.
+RT::Action::LinearEscalate extension has been integrated into core, so you
+MUST uninstall it before upgrading.
-RT::Extension::iCal has been integrated into core, so you MUST uninstall
-it before upgrading. In addition, you must run etc/upgrade/3.8-ical-extension
+RT::Extension::iCal has been integrated into core, so you MUST uninstall it
+before upgrading. In addition, you must run etc/upgrade/3.8-ical-extension
script to convert old data.
-UPGRADING FROM 3.7.80 and earlier - Changes:
+=head1 UPGRADING FROM 3.7.80 AND EARLIER
-Added indexes to CachedGroupMembers for MySQL and Oracle.
-If you have previously installed RTx-Shredder, you may already
-have these indexes. You can see the indexes by looking at
-etc/upgrade/3.7.81/schema.*
+Added indexes to CachedGroupMembers for MySQL and Oracle. If you have
+previously installed RTx-Shredder, you may already have these indexes. You
+can see the indexes by looking at etc/upgrade/3.7.81/schema.*
These indexes may take a very long time to create.
-Common Issues
+=head1 UPGRADING FROM BEFORE 4.0.0
-RT now defaults to a database name of rt4 and an installation root of /opt/rt4.
+=head2 Common issues
-If you are upgrading, you will likely want to specify that your database
-is still named rt3 (or import a backup of your database as rt4 so that
-you can feel more confident making the upgrade).
+RT now defaults to a database name of rt4 and an installation root of
+/opt/rt4.
-You really shouldn't install RT4 into your RT3 source tree (/opt/rt3)
-and instead should be using make install to set up a clean environment.
-This will allow you to evaluate your local modifications and configuration
-changes as you migrate to 4.0.
+If you are upgrading, you will likely want to specify that your database is
+still named rt3 (or import a backup of your database as rt4 so that you can
+feel more confident making the upgrade).
+
+You really shouldn't install RT4 into your RT3 source tree (/opt/rt3) and
+instead should be using make install to set up a clean environment. This will
+allow you to evaluate your local modifications and configuration changes as
+you migrate to 4.0.
If you choose to force RT to install into /opt/rt3, or another existing RT 3.x
install location, you will encounter issues because we removed the _Overlay
-files (such as Ticket_Overlay.pm) and relocated other files. You will
-need to manually remove these files after the upgrade or RT will fail.
-After making a complete backup of your /opt/rt3 install, you might use a
-command like the following to remove the _Overlay files:
+files (such as Ticket_Overlay.pm) and relocated other files. You will need to
+manually remove these files after the upgrade or RT will fail. After making a
+complete backup of your /opt/rt3 install, you might use a command like the
+following to remove the _Overlay files:
find /opt/rt3/lib/ -type f -name '*_Overlay*' -delete
RT has also changed how web deployment works; you will need to review
-docs/web_deployment.pod for current instructions. The old
-`fastcgi_server`, `webmux.pl`, and `mason_handler.*` files will not
-work with RT 4.0, and should be removed to reduce confusion.
+docs/web_deployment.pod for current instructions. The old `fastcgi_server`,
+`webmux.pl`, and `mason_handler.*` files will not work with RT 4.0, and should
+be removed to reduce confusion.
+
+
+=head2 RT_SiteConfig.pm
+
+You will need to carefully review your local settings when moving from 3.8 to
+4.0.
-*******
-RT_SiteConfig.pm
+If you were adding your own custom statuses in earlier versions of RT, using
+ActiveStatus or InactiveStatus you will need to port these to use the new
+Lifecycles functionality. You can read more about it in RT_Config.pm. In
+most cases, you can do this by extending the default active and inactive
+lists.
-You will need to carefully review your local settings when moving from
-3.8 to 4.0.
-If you were adding your own custom statuses in earlier versions of RT,
-using ActiveStatus or InactiveStatus you will need to port these to use
-the new Lifecycles functionality. You can read more about it in
-RT_Config.pm. In most cases, you can do this by extending the default
-active and inactive lists.
+=head2 Upgrading sessions on MySQL
-*******
-Upgrading sessions on MySQL
+In 4.0.0rc2, RT began shipping an updated schema for the sesions table that
+specificies a character set as well as making the table InnoDB. As part of
+the upgrade process, your sessions table will be dropped and recreated with
+the new schema.
-In 4.0.0rc2, RT began shipping an updated schema for the sesions table
-that specificies a character set as well as making the table InnoDB. As
-part of the upgrade process, your sessions table will be dropped and
-recreated with the new schema.
-*******
-UPGRADING FROM RT 3.8.x and RTFM 2.1 or greater
+=head2 Upgrading from installs with RTFM
-RT4 now includes an Articles functionality, merged from RTFM.
-You should not install and enable the RT::FM plugin separately on RT 4.
-If you have existing data in RTFM, you can use the etc/upgrade/upgrade-articles
-script to upgrade that data.
+RT4 now includes an Articles functionality, merged from RTFM. You should not
+install and enable the RT::FM plugin separately on RT 4. If you have existing
+data in RTFM, you can use the etc/upgrade/upgrade-articles script to upgrade
+that data.
-When running normal upgrade scripts, RT will warn if it finds existing
-RTFM tables that contain data and point you to the upgrade-articles script.
+When running normal upgrade scripts, RT will warn if it finds existing RTFM
+tables that contain data and point you to the upgrade-articles script.
-This script should be run from your RT tarball. It will immediately
-begin populating your new RT4 tables with data from RTFM. If you have
-browsed in the RT4 UI and created new classes and articles, this script
-will fail spectacularly. Do *not* run this except on a fresh upgrade of
-RT.
+This script should be run from your RT tarball. It will immediately begin
+populating your new RT4 tables with data from RTFM. If you have browsed in
+the RT4 UI and created new classes and articles, this script will fail
+spectacularly. Do *not* run this except on a fresh upgrade of RT.
You can run this as
etc/upgrade/upgrade-articles
-It will ouput a lot of data about what it is changing. You should
-review this for errors.
+It will ouput a lot of data about what it is changing. You should review this
+for errors.
-If you are running RTFM 2.0 with a release of RT, there isn't currently an upgrade
-script that can port RTFM's internal CustomField and Transaction data to RT4.
+If you are running RTFM 2.0 with a release of RT, there isn't currently an
+upgrade script that can port RTFM's internal CustomField and Transaction data
+to RT4.
You must also remove RT::FM from your @Plugins line in RT_SiteConfig.pm.
-*******
-The deprecated classes RT::Action::Generic, RT::Condition::Generic and RT::Search::Generic
-have been removed, but you shouldn't have been using them anyway. You should have been using
-RT::Action, RT::Condition and RT::Search, respectively.
-* The "Rights Delegation" and "Personal Groups" features have been removed.
+=head2 Removals and updates
+
+The deprecated classes RT::Action::Generic, RT::Condition::Generic and
+RT::Search::Generic have been removed, but you shouldn't have been using them
+anyway. You should have been using RT::Action, RT::Condition and RT::Search,
+respectively.
+
+=over
+
+=item *
+
+The "Rights Delegation" and "Personal Groups" features have been removed.
-* Replace the following code in templates:
+=item *
+
+Replace the following code in templates:
[{$Ticket->QueueObj->SubjectTag || $rtname} #{$Ticket->id}]
{ $Ticket->SubjectTag }
-* Unique names are now enforced for user defined groups. New groups cannot be
- created with a duplicate name and existing groups cannot be renamed to an
- in-use name. The admin interface will warn about existing groups with
- duplicate names. Although the groups will still function, some parts of the
- interface (rights management, subgroup membership) may not work as expected
- with duplicate names. Running
+=item *
+
+Unique names are now enforced for user defined groups. New groups cannot be
+created with a duplicate name and existing groups cannot be renamed to an
+in-use name. The admin interface will warn about existing groups with
+duplicate names. Although the groups will still function, some parts of the
+interface (rights management, subgroup membership) may not work as expected
+with duplicate names. Running
/opt/rt4/sbin/rt-validator --check
- will report duplicate group names, and running it with --resolve will fix
- duplicates by appending the group id to the name.
+will report duplicate group names, and running it with --resolve will fix
+duplicates by appending the group id to the name.
+
+Nota Bene: As a result of differing indexes in the schema files, Postgres and
+SQLite RT databases have enforced group name uniqueness for many years at the
+database level.
+
+=back
- Nota Bene: As a result of differing indexes in the schema files, Postgres and
- SQLite RT databases have enforced group name uniqueness for many years at the
- database level.
-*******
-UPGRADING FROM 4.0.5 and earlier - Changes:
+=head1 UPGRADING FROM 4.0.5 AND EARLIER
+
+=head2 Schema updates
The fix for an attribute truncation bug on MySQL requires a small ALTER TABLE.
Be sure you run `make upgrade-database` to apply this change automatically.
The bug primarily manifested when uploading large logos in the theme editor on
-MySQL. Refer to etc/upgrade/4.0.6/schema.mysql for the actual ALTER TABLE that
-will be run.
+MySQL. Refer to etc/upgrade/4.0.6/schema.mysql for the actual ALTER TABLE
+that will be run.
+
+
+=head2 Query Builder
-*******
The web-based query builder now uses Queue limits to restrict the set of
displayed statuses and owners. As part of this change, the %cfqueues
-parameter was renamed to %Queues; if you have local modifications to any
-of the following Mason templates, this feature will not function
-correctly:
+parameter was renamed to %Queues; if you have local modifications to any of
+the following Mason templates, this feature will not function correctly:
share/html/Elements/SelectOwner
share/html/Elements/SelectStatus
-If you did not start by reading the README file, please start there;
-these steps do not list the full upgrading process, merely a part which
-is sometimes necessary.
+If you did not start by reading the README file, please start there; these
+steps do not list the full upgrading process, merely a part which is sometimes
+necessary.
This file applies if either:
- 1) You are upgrading RT from a version prior to 3.8.0, on any version
- of MySQL
-............. OR .............
- 2) You are migrating from MySQL 4.0 to MySQL 4.1 or above
+=over
+
+=item 1.
+
+You are upgrading RT from a version prior to 3.8.0, on any version
+of MySQL
+
+=item 2.
+
+You are migrating from MySQL 4.0 to MySQL 4.1 or above
+
+=back
If neither of the above cases apply, your should upgrade as per the
instructions in the README.
-These changes are necessary because MySQL 4.1 and greater changed some
-aspects of character set handling that may result in RT failures; this
-will manifest as multiple login requests, corrupted binary attachments,
-and corrupted image custom fields, among others. In order to resolve
-this issue, the upgrade process will need to modify the schema.
+These changes are necessary because MySQL 4.1 and greater changed some aspects
+of character set handling that may result in RT failures; this will manifest
+as multiple login requests, corrupted binary attachments, and corrupted image
+custom fields, among others. In order to resolve this issue, the upgrade
+process will need to modify the schema.
+
+=over
+
+=item 1.
+
+If you are moving the database and/or upgrading MySQL
+
+=over
+
+=item 1a.
+
+Dump the database; with MySQL 4.1 and greater be sure to pass the mysqldump
+command the --default-character-set=binary option. This is necessary because
+the data was originally encoded in Latin1.
+
+=item 1b.
+
+Configure the new MySQL to use Latin1 as the default character set everywhere,
+not UTF-8. This is necessary so the import in the next step assumes the data
+is Latin1.
+
+=item 1c.
+
+Import the dump made in step 1a into the new MySQL server, using the
+--default-character-set=binary option on restore. This will ensure that the
+data is imported as bytes, which will be interpreted as Latin1 thanks to step
+1b above.
+
+=item 1d.
+
+Test that your RT works as expected on this new database.
+
+=back
+
+=item 2.
+
+Backup RT's database using --default-character-set=binary Furthermore, test
+that you can restore from this backup.
+
+=item 3.
+
+Follow instructions in the README file to step 6b.
+
+=item 4.
+
+Apply changes described in the README's step 6b, but only up to version
+3.7.87.
+
+=item 5.
+
+Apply the RT 3.8 schema upgrades. Included in RT is the script
+etc/upgrade/upgrade-mysql-schema.pl that will generate the appropriate SQL
+queries:
+
+ perl etc/upgrade/upgrade-mysql-schema.pl db user pass > queries.sql
+
+If your mysql database is on a remote host, you can run the script like this
+instead:
+
+ perl etc/upgrade/upgrade-mysql-schema.pl db:host user pass > queries.sql
+
+=item 6.
+
+Check the sanity of the SQL queries in the queries.sql file yourself, or
+consult with your DBA.
+
+=item 7.
+
+Apply the queries. Note that this step can take a while; it may also require
+additional space on your hard drive comparable with size of your tables.
- 1) If you are moving the database and/or upgrading MySQL
- 1a) Dump the database; with MySQL 4.1 and greater be sure to pass
- the mysqldump command the --default-character-set=binary option.
- This is necessary because the data was originally encoded in
- Latin1.
+ mysql -u root -p rt3 < queries.sql
- 1b) Configure the new MySQL to use Latin1 as the default character
- set everywhere, not UTF-8. This is necessary so the import in
- the next step assumes the data is Latin1.
+NOTE that 'rt3' is the default name of the RT database, change it in the
+command above if your database is named differently.
- 1c) Import the dump made in step 1a into the new MySQL server, using
- the --default-character-set=binary option on restore. This will
- ensure that the data is imported as bytes, which will be
- interpreted as Latin1 thanks to step 1b above.
+This step should not produce any errors or warnings. If you see any, restore
+your database from the backup you made at step 1, and send a report to the
+rt-users@lists.bestpractical.com mailing list.
- 1d) Test that your RT works as expected on this new database.
+=item 8.
- 2) Backup RT's database using --default-character-set=binary
- Furthermore, test that you can restore from this backup.
+Re-run the `make upgrade-database` command from step 6b of the README,
+applying the rest of the upgrades, starting with 3.7.87, and follow the
+README's remaining steps.
- 3) Follow instructions in the README file to step 6b.
+=item 9.
- 4) Apply changes described in the README's step 6b, but only up to
- version 3.7.87.
+Test everything. The most important parts you have to test:
- 5) Apply the RT 3.8 schema upgrades. Included in RT is the script
- etc/upgrade/upgrade-mysql-schema.pl that will generate the
- appropriate SQL queries:
+=over
- perl etc/upgrade/upgrade-mysql-schema.pl db user pass > queries.sql
+=item *
- If your mysql database is on a remote host, you can run the script
- like this instead:
+binary attachments, like docs, PDFs, and images
- perl etc/upgrade/upgrade-mysql-schema.pl db:host user pass > queries.sql
+=item *
- 6) Check the sanity of the SQL queries in the queries.sql file
- yourself, or consult with your DBA.
+binary custom fields
- 7) Apply the queries. Note that this step can take a while; it may also
- require additional space on your hard drive comparable with size of
- your tables.
+=item *
- mysql -u root -p rt3 < queries.sql
+everything that may contain characters other than ASCII
- NOTE that 'rt3' is the default name of the RT database, change it in
- the command above if your database is named differently.
+=back
- This step should not produce any errors or warnings. If you see any,
- restore your database from the backup you made at step 1, and send a
- report to the rt-users@lists.bestpractical.com mailing list.
- 8) Re-run the `make upgrade-database` command from step 6b of the
- README, applying the rest of the upgrades, starting with 3.7.87, and
- follow the README's remaining steps.
+=item 10.
- 9) Test everything. The most important parts you have to test:
- * binary attachments, like docs, PDFs, and images
- * binary custom fields
- * everything that may contain characters other than ASCII
+If you were upgrading from MySQL 4.0, you may now, if you wish, reconfigure
+your newer MySQL instance to use UTF-8 as the default character set, as step 7
+above adjusted the character sets on all existing tables to contain UTF-8
+encoded data, rather than Latin1.
-10) If you were upgrading from MySQL 4.0, you may now, if you wish,
- reconfigure your newer MySQL instance to use UTF-8 as the default
- character set, as step 7 above adjusted the character sets on all
- existing tables to contain UTF-8 encoded data, rather than Latin1.
+=back
=item C<$MaxAttachmentSize>
C<$MaxAttachmentSize> sets the maximum size (in bytes) of attachments
-stored in the database.
+stored in the database. This setting is irrelevant unless one of
+$TruncateLongAttachments or $DropLongAttachments (below) are set.
=cut
=head1 Extra security
-=over 4
-
This is a list of extra security measures to enable that help keep your RT
safe. If you don't know what these mean, you should almost certainly leave the
defaults alone.
+=over 4
+
=item C<$DisallowExecuteCode>
If set to a true value, the C<ExecuteCode> right will be removed from
Set($RestrictLoginReferrer, 0);
-=item C<$ReferrerWhitelist>
+=item C<@ReferrerWhitelist>
This is a list of hostname:port combinations that RT will treat as being
part of RT's domain. This is particularly useful if you access RT as
Queues =>
q{'<a href="__WebPath__/Admin/Queues/Modify.html?id=__id__">__id__</a>/TITLE:#'}
.q{,'<a href="__WebPath__/Admin/Queues/Modify.html?id=__id__">__Name__</a>/TITLE:Name'}
- .q{,__Description__,__Address__,__Priority__,__DefaultDueIn__,'__Disabled__,__Lifecycle__},
+ .q{,__Description__,__Address__,__Priority__,__DefaultDueIn__,__Disabled__,__Lifecycle__},
Groups =>
q{'<a href="__WebPath__/Admin/Groups/Modify.html?id=__id__">__id__</a>/TITLE:#'}
This option has been deprecated. You can configure this site-wide
with L</Lifecycles> (see L</Labeling and defining actions>).
+=back
+
=cut
1;
if ( my $struct = eval { Storable::thaw( $argument ) } ) {
$new = $converter->( $struct );
} else {
- $new = join /, /, grep length, split /[^0-9]+/, $argument;
+ $new = join ", ", grep length, split /[^0-9]+/, $argument;
}
next if $new eq $argument;
sub Commit {
my $self = shift;
- $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail');
+ return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
+ unless RT->Config->Get('RecordOutgoingEmail');
+
+ $self->DeferDigestRecipients();
my $message = $self->TemplateObj->MIMEObj;
my $orig_message;
- if ( RT->Config->Get('RecordOutgoingEmail')
- && RT->Config->Get('GnuPG')->{'Enable'} )
- {
-
- # it's hacky, but we should know if we're going to crypt things
- my $attachment = $self->TransactionObj->Attachments->First;
-
- my %crypt;
- foreach my $argument (qw(Sign Encrypt)) {
- if ( $attachment
- && defined $attachment->GetHeader("X-RT-$argument") )
- {
- $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
- } else {
- $crypt{$argument} = $self->TicketObj->QueueObj->$argument();
- }
- }
- if ( $crypt{'Sign'} || $crypt{'Encrypt'} ) {
- $orig_message = $message->dup;
- }
- }
+ $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
+ Attachment => $self->TransactionObj->Attachments->First,
+ Ticket => $self->TicketObj,
+ );
my ($ret) = $self->SendMessage($message);
- if ( $ret > 0 && RT->Config->Get('RecordOutgoingEmail') ) {
- if ($orig_message) {
- $message->attach(
- Type => 'application/x-rt-original-message',
- Disposition => 'inline',
- Data => $orig_message->as_string,
- );
- }
- $self->RecordOutgoingMailTransaction($message);
- $self->RecordDeferredRecipients();
- }
-
+ return abs( $ret ) if $ret <= 0;
- return ( abs $ret );
+ if ($orig_message) {
+ $message->attach(
+ Type => 'application/x-rt-original-message',
+ Disposition => 'inline',
+ Data => $orig_message->as_string,
+ );
+ }
+ $self->RecordOutgoingMailTransaction($message);
+ $self->RecordDeferredRecipients();
+ return 1;
}
=head2 Prepare
}
}
- $obj->SetStatus(
- Status => $obj->QueueObj->Lifecycle->DefaultStatus('approved') || 'open',
- Force => 1,
- );
+ $obj->SetStatus( Status => $obj->FirstActiveStatus, Force => 1 )
+ if $obj->FirstActiveStatus;
}
my $passed = !$top->HasUnresolvedDependencies( Type => 'approval' );
$top->Correspond( MIMEObj => $template->MIMEObj );
if ($passed) {
+ my $new_status = $top->QueueObj->Lifecycle->DefaultStatus('approved') || 'open';
+ if ( $new_status ne $top->Status ) {
+ $top->SetStatus( $new_status );
+ }
+
$self->RunScripAction('Notify Owner', 'Approval Ready for Owner',
TicketObj => $top);
}
@_
);
- my $class = RT::Class->new($RT::SystemUser);
+ my $class = RT::Class->new( $self->CurrentUser );
$class->Load( $args{'Class'} );
unless ( $class->Id ) {
return ( 0, $self->loc('Invalid Class') );
my $newheader = '';
foreach my $line ($self->_SplitHeaders) {
- next if $line =~ /^\Q$tag\E:\s+(.*)$/is;
- $newheader .= "$line\n";
+ next if $line =~ /^\Q$tag\E:\s+/i;
+ $newheader .= "$line\n";
}
return $self->__Set( Field => 'Headers', Value => $newheader);
}
my $newheader = $self->__Value( 'Headers' );
while ( my ($tag, $value) = splice @_, 0, 2 ) {
- $value = '' unless defined $value;
- $value =~ s/\s+$//s;
- $value =~ s/\r+\n/\n /g;
+ $value = $self->_CanonicalizeHeaderValue($value);
$newheader .= "$tag: $value\n";
}
return $self->__Set( Field => 'Headers', Value => $newheader);
=cut
sub SetHeader {
- my $self = shift;
- my $tag = shift;
+ my $self = shift;
+ my $tag = shift;
+ my $value = $self->_CanonicalizeHeaderValue(shift);
+ my $replaced = 0;
my $newheader = '';
- foreach my $line ($self->_SplitHeaders) {
- if (defined $tag and $line =~ /^\Q$tag\E:\s+(.*)$/i) {
- $newheader .= "$tag: $_[0]\n";
- undef $tag;
+ foreach my $line ( $self->_SplitHeaders ) {
+ if ( $line =~ /^\Q$tag\E:\s+/i ) {
+ # replace first instance, skip all the rest
+ unless ($replaced) {
+ $newheader .= "$tag: $value\n";
+ $replaced = 1;
+ }
+ } else {
+ $newheader .= "$line\n";
}
- else {
- $newheader .= "$line\n";
- }
}
- $newheader .= "$tag: $_[0]\n" if defined $tag;
+ $newheader .= "$tag: $value\n" unless $replaced;
$self->__Set( Field => 'Headers', Value => $newheader);
}
+sub _CanonicalizeHeaderValue {
+ my $self = shift;
+ my $value = shift;
+
+ $value = '' unless defined $value;
+ $value =~ s/\s+$//s;
+ $value =~ s/\r*\n/\n /g;
+
+ return $value;
+}
+
=head2 SplitHeaders
Returns an array of this attachment object's headers, with one header
my $self = shift;
my $headers = (shift || $self->_Value('Headers'));
my @headers;
+ # XXX TODO: splitting on \n\w is _wrong_ as it treats \n[ as a valid
+ # continuation, which it isn't. The correct split pattern, per RFC 2822,
+ # is /\n(?=[^ \t]|\z)/. That is, only "\n " or "\n\t" is a valid
+ # continuation. Older values of X-RT-GnuPG-Status contain invalid
+ # continuations and rely on this bogus split pattern, however, so it is
+ # left as-is for now.
for (split(/\n(?=\w|\z)/,$headers)) {
push @headers, $_;
$RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
return ();
}
+
+ # Deal with "partitioned" PGP mail, which (contrary to common
+ # sense) unnecessarily applies a base64 transfer encoding to PGP
+ # mail (whose content is already base64-encoded).
+ if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
+ pipe( my ($read_decoded, $write_decoded) );
+ my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
+ if ($decoder) {
+ eval { $decoder->decode($io, $write_decoded) };
+ $io = $read_decoded;
+ }
+ }
+
while ( defined($_ = $io->getline) ) {
next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
my $type = $1? 'signed': 'encrypted';
}
if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
my $method = $args{'AddStatus'} ? 'add' : 'set';
+ # Let the header be modified so continuations are handled
+ my $modify = $status_on->head->modify;
+ $status_on->head->modify(1);
$status_on->head->$method(
'X-RT-GnuPG-Status' => $res[-1]->{'status'}
);
+ $status_on->head->modify($modify);
}
}
foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
}
if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
my $method = $args{'AddStatus'} ? 'add' : 'set';
+ # Let the header be modified so continuations are handled
+ my $modify = $status_on->head->modify;
+ $status_on->head->modify(1);
$status_on->head->$method(
'X-RT-GnuPG-Status' => $res[-1]->{'status'}
);
+ $status_on->head->modify($modify);
}
}
return @res;
eval {
local $SIG{'CHLD'} = 'DEFAULT';
my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
- my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email? (command_args => $email) : () ) };
+ my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email
+ ? (command_args => [ "--", $email])
+ : () ) };
close $handle{'stdin'};
waitpid $pid, 0;
};
my $pid = safe_run_child { $gnupg->wrap_call(
handles => $handles,
commands => ['--delete-secret-and-public-key'],
- command_args => [$key],
+ command_args => ["--", $key],
) };
close $handle{'stdin'};
while ( my $str = readline $handle{'status'} ) {
use warnings;
use strict;
-our $VERSION = '4.0.7';
+our $VERSION = '4.0.8';
@queues = @{ delete $item->{'Queue'} };
}
- my ( $return, $msg ) = $new_entry->Create(%$item);
- unless( $return ) {
- $RT::Logger->error( $msg );
- next;
- }
-
if ( $item->{'BasedOn'} ) {
- my $basedon = RT::CustomField->new($RT::SystemUser);
- my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'},
- LookupType => $new_entry->LookupType );
- if ($ok) {
- ($ok, $msg) = $new_entry->SetBasedOn( $basedon );
+ if ( $item->{'LookupType'} ) {
+ my $basedon = RT::CustomField->new($RT::SystemUser);
+ my ($ok, $msg ) = $basedon->LoadByCols( Name => $item->{'BasedOn'},
+ LookupType => $item->{'LookupType'} );
if ($ok) {
- $RT::Logger->debug("Added BasedOn $item->{BasedOn}: $msg");
+ $item->{'BasedOn'} = $basedon->Id;
} else {
- $RT::Logger->error("Failed to add basedOn $item->{BasedOn}: $msg");
+ $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF. Skipping BasedOn: $msg");
+ delete $item->{'BasedOn'};
}
} else {
- $RT::Logger->error("Unable to load $item->{BasedOn} as a $item->{LookupType} CF. Skipping BasedOn");
+ $RT::Logger->error("Unable to load CF $item->{BasedOn} because no LookupType was specified. Skipping BasedOn");
+ delete $item->{'BasedOn'};
}
+
+ }
+
+ my ( $return, $msg ) = $new_entry->Create(%$item);
+ unless( $return ) {
+ $RT::Logger->error( $msg );
+ next;
}
foreach my $value ( @{$values} ) {
=cut
+sub WillSignEncrypt {
+ my %args = @_;
+ my $attachment = delete $args{Attachment};
+ my $ticket = delete $args{Ticket};
+
+ if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
+ $args{Sign} = $args{Encrypt} = 0;
+ return wantarray ? %args : 0;
+ }
+
+ for my $argument ( qw(Sign Encrypt) ) {
+ next if defined $args{ $argument };
+
+ if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
+ $args{$argument} = $attachment->GetHeader("X-RT-$argument");
+ } elsif ( $ticket and $argument eq "Encrypt" ) {
+ $args{Encrypt} = $ticket->QueueObj->Encrypt();
+ } elsif ( $ticket and $argument eq "Sign" ) {
+ # Note that $queue->Sign is UI-only, and that all
+ # UI-generated messages explicitly set the X-RT-Crypt header
+ # to 0 or 1; thus this path is only taken for messages
+ # generated _not_ via the web UI.
+ $args{Sign} = $ticket->QueueObj->SignAuto();
+ }
+ }
+
+ return wantarray ? %args : ($args{Sign} || $args{Encrypt});
+}
+
sub SendEmail {
my (%args) = (
Entity => undef,
}
if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
- my %crypt;
-
- my $attachment;
- $attachment = $TransactionObj->Attachments->First
- if $TransactionObj;
-
- foreach my $argument ( qw(Sign Encrypt) ) {
- next if defined $args{ $argument };
-
- if ( $attachment && defined $attachment->GetHeader("X-RT-$argument") ) {
- $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
- } elsif ( $TicketObj ) {
- $crypt{$argument} = $TicketObj->QueueObj->$argument();
- }
- }
-
- my $res = SignEncrypt( %args, %crypt );
+ %args = WillSignEncrypt(
+ %args,
+ Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
+ Ticket => $TicketObj,
+ );
+ my $res = SignEncrypt( %args );
return $res unless $res > 0;
}
foreach my $p ( $args{'Message'}->parts_DFS ) {
$p->head->delete($_) for qw(
- X-RT-GnuPG-Status X-RT-Incoming-Encrypton
+ X-RT-GnuPG-Status X-RT-Incoming-Encryption
X-RT-Incoming-Signature X-RT-Privacy
+ X-RT-Sign X-RT-Encrypt
);
}
}
# Specially handle /index.html so that we get a nicer URL
elsif ( $m->request_comp->path eq '/index.html' ) {
- my $next = SetNextPage(RT->Config->Get('WebURL'));
+ my $next = SetNextPage($ARGS);
$m->comp('/NoAuth/Login.html', next => $next, actions => [$msg]);
$m->abort;
}
else {
- TangentForLogin(results => ($msg ? LoginError($msg) : undef));
+ TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef));
}
}
}
return $key;
}
-=head2 SetNextPage [PATH]
+=head2 SetNextPage ARGSRef [PATH]
Intuits and stashes the next page in the sesssion hash. If PATH is
specified, uses that instead of the value of L<IntuitNextPage()>. Returns
=cut
sub SetNextPage {
- my $next = shift || IntuitNextPage();
+ my $ARGS = shift;
+ my $next = $_[0] ? $_[0] : IntuitNextPage();
my $hash = Digest::MD5::md5_hex($next . $$ . rand(1024));
+ my $page = { url => $next };
+
+ # If an explicit URL was passed and we didn't IntuitNextPage, then
+ # IsPossibleCSRF below is almost certainly unrelated to the actual
+ # destination. Currently explicit next pages aren't used in RT, but the
+ # API is available.
+ if (not $_[0] and RT->Config->Get("RestrictReferrer")) {
+ # This isn't really CSRF, but the CSRF heuristics are useful for catching
+ # requests which may have unintended side-effects.
+ my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS);
+ if ($is_csrf) {
+ RT->Logger->notice(
+ "Marking original destination as having side-effects before redirecting for login.\n"
+ ."Request: $next\n"
+ ."Reason: " . HTML::Mason::Commands::loc($msg, @loc)
+ );
+ $page->{'HasSideEffects'} = [$msg, @loc];
+ }
+ }
- $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $next;
+ $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $page;
$HTML::Mason::Commands::session{'i'}++;
return $hash;
}
+=head2 FetchNextPage HASHKEY
+
+Returns the stashed next page hashref for the given hash.
+
+=cut
+
+sub FetchNextPage {
+ my $hash = shift || "";
+ return $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
+
+=head2 RemoveNextPage HASHKEY
+
+Removes the stashed next page for the given hash and returns it.
+
+=cut
+
+sub RemoveNextPage {
+ my $hash = shift || "";
+ return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
-=head2 TangentForLogin [HASH]
+=head2 TangentForLogin ARGSRef [HASH]
Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as
-the next page. Optionally takes a hash which is dumped into query params.
+the next page. Takes a hashref of request %ARGS as the first parameter.
+Optionally takes all other parameters as a hash which is dumped into query
+params.
=cut
sub TangentForLogin {
- my $hash = SetNextPage();
+ my $ARGS = shift;
+ my $hash = SetNextPage($ARGS);
my %query = (@_, next => $hash);
my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?';
$login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
=cut
sub TangentForLoginWithError {
- my $key = LoginError(HTML::Mason::Commands::loc(@_));
- TangentForLogin( results => $key );
+ my $ARGS = shift;
+ my $key = LoginError(HTML::Mason::Commands::loc(@_));
+ TangentForLogin( $ARGS, results => $key );
}
=head2 IntuitNextPage
$user =~ s/^\Q$NodeName\E\\//i;
}
- my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
+ my $next = RemoveNextPage($ARGS->{'next'});
+ $next = $next->{'url'} if ref $next;
InstantiateNewSession() unless _UserLoggedIn;
$HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
$HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user);
delete $HTML::Mason::Commands::session{'CurrentUser'};
if (RT->Config->Get('WebFallbackToInternalAuth')) {
- TangentForLoginWithError('Cannot create user: [_1]', $msg);
+ TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg);
} else {
$m->abort();
}
$user = $orig_user;
unless ( RT->Config->Get('WebFallbackToInternalAuth') ) {
- TangentForLoginWithError('You are not an authorized user');
+ TangentForLoginWithError($ARGS, 'You are not an authorized user');
}
}
} elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) {
unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) {
# XXX unreachable due to prior defaulting in HandleRequest (check c34d108)
- TangentForLoginWithError('You are not an authorized user');
+ TangentForLoginWithError($ARGS, 'You are not an authorized user');
}
} else {
# It's important to nab the next page from the session before we blow
# the session away
- my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
+ my $next = RemoveNextPage($ARGS->{'next'});
+ $next = $next->{'url'} if ref $next;
InstantiateNewSession();
$HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
'/m/tickets/search' => 1,
);
+# Components which are blacklisted from automatic, argument-based whitelisting.
+# These pages are not idempotent when called with just an id.
+our %is_blacklisted_component = (
+ # Takes only id and toggles bookmark state
+ '/Helpers/Toggle/TicketBookmark' => 1,
+);
+
sub IsCompCSRFWhitelisted {
my $comp = shift;
my $ARGS = shift;
delete $args{pass};
}
+ # Some pages aren't idempotent even with safe args like id; blacklist
+ # them from the automatic whitelisting below.
+ return 0 if $is_blacklisted_component{$comp};
+
# Eliminate arguments that do not indicate an effectful request.
# For example, "id" is acceptable because that is how RT retrieves a
# record.
# Calls abort, never gets here
}
+our @POTENTIAL_PAGE_ACTIONS = (
+ qr'/Ticket/Create.html' => "create a ticket", # loc
+ qr'/Ticket/' => "update a ticket", # loc
+ qr'/Admin/' => "modify RT's configuration", # loc
+ qr'/Approval/' => "update an approval", # loc
+ qr'/Articles/' => "update an article", # loc
+ qr'/Dashboards/' => "modify a dashboard", # loc
+ qr'/m/ticket/' => "update a ticket", # loc
+ qr'Prefs' => "modify your preferences", # loc
+ qr'/Search/' => "modify or access a search", # loc
+ qr'/SelfService/Create' => "create a ticket", # loc
+ qr'/SelfService/' => "update a ticket", # loc
+);
+
+sub PotentialPageAction {
+ my $page = shift;
+ my @potentials = @POTENTIAL_PAGE_ACTIONS;
+ while (my ($pattern, $result) = splice @potentials, 0, 2) {
+ return HTML::Mason::Commands::loc($result)
+ if $page =~ $pattern;
+ }
+ return "";
+}
+
package HTML::Mason::Commands;
use vars qw/$r $m %session/;
}
}
- foreach my $argument (qw(Encrypt Sign)) {
- $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 )
- if defined $ARGS{$argument};
+ for my $argument (qw(Encrypt Sign)) {
+ $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 );
}
my %create_args = (
sub path {
my $self = shift;
if (@_) {
- $self->{path} = shift;
- $self->{path} = URI->new_abs($self->{path}, $self->parent->path . "/")->as_string
- if defined $self->{path} and $self->parent and $self->parent->path;
- $self->{path} =~ s!///!/! if $self->{path};
+ if (defined($self->{path} = shift)) {
+ my $base = ($self->parent and $self->parent->path) ? $self->parent->path : "";
+ $base .= "/" unless $base =~ m{/$};
+ my $uri = URI->new_abs($self->{path}, $base);
+ $self->{path} = $uri->as_string;
+ }
}
return $self->{path};
}
if ( defined $path and length $path ) {
my $base_path = $HTML::Mason::Commands::r->path_info;
my $query = $HTML::Mason::Commands::m->cgi_object->query_string;
+ $base_path =~ s!/+!/!g;
$base_path .= "?$query" if defined $query and length $query;
$base_path =~ s/index\.html$//;
--- /dev/null
+use strict;
+use warnings;
+
+package RT::Pod::HTML;
+use base 'Pod::Simple::XHTML';
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+ $self->index(1);
+ $self->anchor_items(1);
+ return $self;
+}
+
+sub perldoc_url_prefix { "http://metacpan.org/module/" }
+
+sub html_header { '' }
+sub html_footer {
+ my $self = shift;
+ my $toc = "../" x ($self->batch_mode_current_level - 1);
+ return '<a href="./' . $toc . '">← Back to index</a>';
+}
+
+sub start_Verbatim { $_[0]{'scratch'} = "<pre>" }
+sub end_Verbatim { $_[0]{'scratch'} .= "</pre>"; $_[0]->emit; }
+
+sub _end_head {
+ my $self = shift;
+ $self->{scratch} = '<a href="#___top">' . $self->{scratch} . '</a>';
+ return $self->SUPER::_end_head(@_);
+}
+
+sub resolve_pod_page_link {
+ my $self = shift;
+ my ($name, $section) = @_;
+
+ # Only try to resolve local links if we're in batch mode and are linking
+ # outside the current document.
+ return $self->SUPER::resolve_pod_page_link(@_)
+ unless $self->batch_mode and $name;
+
+ $section = defined $section
+ ? '#' . $self->idify($section, 1)
+ : '';
+
+ my $local;
+ if ($name =~ /^RT::/) {
+ $local = join "/",
+ map { $self->encode_entities($_) }
+ split /::/, $name;
+ }
+ elsif ($name =~ /^rt-/) {
+ $local = $self->encode_entities($name);
+ }
+
+ if ($local) {
+ # Resolve links correctly by going up
+ my $depth = $self->batch_mode_current_level - 1;
+ return join "/",
+ ($depth ? ".." x $depth : ()),
+ "$local.html$section";
+ } else {
+ return $self->SUPER::resolve_pod_page_link(@_)
+ }
+}
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+package RT::Pod::HTMLBatch;
+use base 'Pod::Simple::HTMLBatch';
+
+use List::MoreUtils qw/all/;
+
+use RT::Pod::Search;
+use RT::Pod::HTML;
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+ $self->verbose(0);
+
+ # Per-page output options
+ $self->css_flurry(0); # No CSS
+ $self->javascript_flurry(0); # No JS
+ $self->no_contents_links(1); # No header/footer "Back to contents" links
+
+ # TOC options
+ $self->index(1); # Write a per-page TOC
+ $self->contents_file("index.html"); # Write a global TOC
+
+ $self->html_render_class('RT::Pod::HTML');
+ $self->search_class('RT::Pod::Search');
+
+ return $self;
+}
+
+sub classify {
+ my $self = shift;
+ my %info = (@_);
+
+ my $is_install_doc = sub {
+ my %page = @_;
+ local $_ = $page{name};
+ return 1 if /^(README|UPGRADING)/;
+ return 1 if $_ eq "RT_Config";
+ return 1 if $_ eq "web_deployment";
+ return 1 if $page{infile} =~ m{^configure(\.ac)?$};
+ return 0;
+ };
+
+ my $section = $info{infile} =~ m{/plugins/([^/]+)} ? "05 Extension: $1" :
+ $info{infile} =~ m{/local/} ? '04 Local Documenation' :
+ $is_install_doc->(%info) ? '00 Install and Upgrade '.
+ 'Documentation' :
+ $info{infile} =~ m{/(docs|etc)/} ? '01 User Documentation' :
+ $info{infile} =~ m{/bin/} ? '02 Utilities (bin)' :
+ $info{infile} =~ m{/sbin/} ? '03 Utilities (sbin)' :
+ $info{name} =~ /^RT::Action/ ? '08 Actions' :
+ $info{name} =~ /^RT::Condition/ ? '09 Conditions' :
+ $info{name} =~ /^RT(::|$)/ ? '07 Developer Documentation' :
+ $info{infile} =~ m{/devel/tools/} ? '20 Utilities (devel/tools)' :
+ '06 Miscellaneous' ;
+
+ if ($info{infile} =~ m{/(docs|etc)/}) {
+ $info{name} =~ s/_/ /g;
+ $info{name} = join "/", map { ucfirst } split /::/, $info{name};
+ }
+
+ return ($info{name}, $section);
+}
+
+sub write_contents_file {
+ my ($self, $to) = @_;
+ return unless $self->contents_file;
+
+ my $file = join "/", $to, $self->contents_file;
+ open my $index, ">", $file
+ or warn "Unable to open index file '$file': $!\n", return;
+
+ my $pages = $self->_contents;
+ return unless @$pages;
+
+ # Classify
+ my %toc;
+ for my $page (@$pages) {
+ my ($name, $infile, $outfile, $pieces) = @$page;
+
+ my ($title, $section) = $self->classify(
+ name => $name,
+ infile => $infile,
+ );
+
+ (my $path = $outfile) =~ s{^\Q$to\E/?}{};
+
+ push @{ $toc{$section} }, {
+ name => $title,
+ path => $path,
+ };
+ }
+
+ # Write out index
+ print $index "<dl class='superindex'>\n";
+
+ for my $key (sort keys %toc) {
+ next unless @{ $toc{$key} };
+
+ (my $section = $key) =~ s/^\d+ //;
+ print $index "<dt>", esc($section), "</dt>\n";
+ print $index "<dd>\n";
+
+ my @sorted = sort {
+ my @names = map { $_->{name} } $a, $b;
+
+ # Sort just the upgrading docs descending within everything else
+ @names = reverse @names
+ if all { /^UPGRADING-/ } @names;
+
+ $names[0] cmp $names[1]
+ } @{ $toc{$key} };
+
+ for my $page (@sorted) {
+ print $index " <a href='", esc($page->{path}), "'>",
+ esc($page->{name}),
+ "</a><br>\n";
+ }
+ print $index "</dd>\n";
+ }
+ print $index '</dl>';
+
+ close $index;
+}
+
+sub esc {
+ Pod::Simple::HTMLBatch::esc(@_);
+}
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+package RT::Pod::Search;
+use base 'Pod::Simple::Search';
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+ $self->laborious(1) # Find scripts too
+ ->limit_re(qr/(?<!\.in)$/) # Filter out .in files
+ ->inc(0); # Don't look in @INC
+ return $self;
+}
+
+1;
FinalPriority => 0,
DefaultDueIn => 0,
Sign => undef,
+ SignAuto => undef,
Encrypt => undef,
_RecordTransaction => 1,
@_
}
$RT::Handle->Commit;
- if ( defined $args{'Sign'} ) {
- my ($status, $msg) = $self->SetSign( $args{'Sign'} );
- $RT::Logger->error("Couldn't set attribute 'Sign': $msg")
- unless $status;
- }
- if ( defined $args{'Encrypt'} ) {
- my ($status, $msg) = $self->SetEncrypt( $args{'Encrypt'} );
- $RT::Logger->error("Couldn't set attribute 'Encrypt': $msg")
+ for my $attr (qw/Sign SignAuto Encrypt/) {
+ next unless defined $args{$attr};
+ my $set = "Set" . $attr;
+ my ($status, $msg) = $self->$set( $args{$attr} );
+ $RT::Logger->error("Couldn't set attribute '$attr': $msg")
unless $status;
}
return ($status, $self->loc('Signing disabled'));
}
+sub SignAuto {
+ my $self = shift;
+ my $value = shift;
+
+ return undef unless $self->CurrentUserHasRight('SeeQueue');
+ my $attr = $self->FirstAttribute('SignAuto') or return 0;
+ return $attr->Content;
+}
+
+sub SetSignAuto {
+ my $self = shift;
+ my $value = shift;
+
+ return ( 0, $self->loc('Permission Denied') )
+ unless $self->CurrentUserHasRight('AdminQueue');
+
+ my ($status, $msg) = $self->SetAttribute(
+ Name => 'SignAuto',
+ Description => 'Sign auto-generated outgoing messages',
+ Content => $value,
+ );
+ return ($status, $msg) unless $status;
+ return ($status, $self->loc('Signing enabled')) if $value;
+ return ($status, $self->loc('Signing disabled'));
+}
+
sub Encrypt {
my $self = shift;
my $value = shift;
}
+=head1 LockForUpdate
+In a database transaction, gains an exclusive lock on the row, to
+prevent race conditions. On SQLite, this is a "RESERVED" lock on the
+entire database.
+=cut
+
+sub LockForUpdate {
+ my $self = shift;
+
+ my $pk = $self->_PrimaryKey;
+ my $id = @_ ? $_[0] : $self->$pk;
+ $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
+ if (RT->Config->Get('DatabaseType') eq "SQLite") {
+ # SQLite does DB-level locking, upgrading the transaction to
+ # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op
+ # UPDATE to force the upgade.
+ return RT->DatabaseHandle->dbh->do(
+ "UPDATE " .$self->Table.
+ " SET $pk = $pk WHERE 1 = 0");
+ } else {
+ return $self->_LoadFromSQL(
+ "SELECT * FROM ".$self->Table
+ ." WHERE $pk = ? FOR UPDATE",
+ $id,
+ );
+ }
+}
=head2 _NewTransaction PARAMHASH
@_
);
+ my $in_txn = RT->DatabaseHandle->TransactionDepth;
+ RT->DatabaseHandle->BeginTransaction unless $in_txn;
+
+ $self->LockForUpdate;
+
my $old_ref = $args{'OldReference'};
my $new_ref = $args{'NewReference'};
my $ref_type = $args{'ReferenceType'};
if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
}
+
+ RT->DatabaseHandle->Commit unless $in_txn;
+
return ( $transaction, $msg, $trans );
}
# Unfold all headers
$self->{'MIMEObj'}->head->unfold;
+ $self->{'MIMEObj'}->head->modify(1);
return ( 1, $self->loc("Template parsed") );
}
$args{'NoteType'} = 'Comment';
+ $RT::Handle->BeginTransaction();
if ($args{'DryRun'}) {
- $RT::Handle->BeginTransaction();
$args{'CommitScrips'} = 0;
}
my @results = $self->_RecordNote(%args);
if ($args{'DryRun'}) {
$RT::Handle->Rollback();
+ } else {
+ $RT::Handle->Commit();
}
return(@results);
or ( $self->CurrentUserHasRight('ModifyTicket') ) ) {
return ( 0, $self->loc("Permission Denied"), undef );
}
+ $args{'NoteType'} = 'Correspond';
- $args{'NoteType'} = 'Correspond';
+ $RT::Handle->BeginTransaction();
if ($args{'DryRun'}) {
- $RT::Handle->BeginTransaction();
$args{'CommitScrips'} = 0;
}
if ($args{'DryRun'}) {
$RT::Handle->Rollback();
+ } else {
+ $RT::Handle->Commit();
}
return (@results);
AuthSystem => { public => 1, admin => 1 },
Gecos => { public => 1, admin => 1 },
PGPKey => { public => 1, admin => 1 },
+ PrivateKey => { admin => 1 },
}
}
VALUE => 'deleted'
);
+ # On newer DBIx::SearchBuilder's, indicate that making the query DISTINCT
+ # is unnecessary because the joins won't produce duplicates. This
+ # drastically improves performance when fetching attachments.
+ $res->{joins_are_distinct} = 1;
+
return goto_specific(
suffix => $type,
error => "Don't know how to find $type attachments",
VALUE => 'deleted'
);
+ # On newer DBIx::SearchBuilder's, indicate that making the query DISTINCT
+ # is unnecessary because the joins won't produce duplicates. This
+ # drastically improves performance when fetching attachments.
+ $res->{joins_are_distinct} = 1;
+
return goto_specific(
suffix => $type,
error => "Don't know how to find $type attachments",
'with-DASHBOARDS',
'with-USERLOGO',
'with-SSL-MAILGATE',
+ 'with-HTML-DOC',
'download=s',
'repository=s',
'with-DASHBOARDS' => 1,
'with-USERLOGO' => 1,
'with-SSL-MAILGATE' => @RT_SSL_MAILGATE@,
+ 'with-HTML-DOC' => @RT_DEVEL_MODE@,
);
$args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;
Convert::Color
.
+$deps{'HTML-DOC'} = [ text_to_hash( <<'.') ];
+Pod::Simple 3.17
+HTML::Entities
+.
+
my %AVOID = (
'DBD::Oracle' => [qw(1.23)],
'Email::Address' => [qw(1.893 1.894)],
--- /dev/null
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+use Text::ParseWords qw//;
+use Getopt::Long;
+
+BEGIN { # BEGIN RT CMD BOILERPLATE
+ require File::Spec;
+ require Cwd;
+ my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+my ($PREFIX, $URL, $HOST) = ("");
+GetOptions(
+ "prefix|p=s" => \$PREFIX,
+ "url|u=s" => \$URL,
+ "host|h=s" => \$HOST,
+);
+
+unless (@ARGV) {
+ @ARGV = grep {-f} ("/etc/aliases",
+ "/etc/mail/aliases",
+ "/etc/postfix/aliases");
+ die "Can't determine aliases file to parse!"
+ unless @ARGV;
+}
+
+my %aliases = parse_lines();
+unless (%aliases) {
+ warn "No mailgate aliases found in @ARGV";
+ exit;
+}
+
+my %seen;
+my $global_mailgate;
+for my $address (sort keys %aliases) {
+ my ($mailgate, $opts, $extra) = @{$aliases{$address}};
+ my %opts = %{$opts};
+
+ next if $opts{url} and $URL and $opts{url} !~ /\Q$URL\E/;
+
+ if ($mailgate !~ /^\|/) {
+ warn "Missing the leading | on alias $address\n";
+ $mailgate = "|$mailgate";
+ }
+ if (($global_mailgate ||= $mailgate) ne $mailgate) {
+ warn "Unexpected mailgate for alias $address -- expected $global_mailgate, got $mailgate\n";
+ }
+
+ if (not defined $opts{action}) {
+ warn "Missing --action parameter for alias $address\n";
+ } elsif ($opts{action} !~ /^(correspond|comment)$/) {
+ warn "Invalid --action parameter for alias $address: $opts{action}\n"
+ }
+
+ my $queue = RT::Queue->new( RT->SystemUser );
+ if (not defined $opts{queue}) {
+ warn "Missing --queue parameter for alias $address\n";
+ } else {
+ $queue->Load( $opts{queue} );
+ if (not $queue->id) {
+ warn "Invalid --queue parameter for alias $address: $opts{queue}\n";
+ } elsif ($queue->Disabled) {
+ warn "Disabled --queue given for alias $address: $opts{queue}\n";
+ }
+ }
+
+ if (not defined $opts{url}) {
+ warn "Missing --url parameter for alias $address\n";
+ } #XXX: Test connectivity and/or https certs?
+
+ if ($queue->id and $opts{action} =~ /^(correspond|comment)$/) {
+ push @{$seen{lc $queue->Name}{$opts{action}}}, $address;
+ }
+
+ warn "Unknown extra arguments for alias $address: @{$extra}\n"
+ if @{$extra};
+}
+
+# Check the global settings
+my %global;
+for my $action (qw/correspond comment/) {
+ my $setting = ucfirst($action) . "Address";
+ my $value = RT->Config->Get($setting);
+ if (not defined $value) {
+ warn "$setting is not set!\n";
+ next;
+ }
+ my ($local,$host) = lc($value) =~ /(.*?)\@(.*)/;
+ next if $HOST and $host !~ /\Q$HOST\E/;
+ $local = "$PREFIX$local" unless exists $aliases{$local};
+
+ $global{$setting} = $local;
+ if (not exists $aliases{$local}) {
+ warn "$setting $value does not exist in aliases!\n"
+ } elsif ($aliases{$local}[1]{action} ne $action) {
+ warn "$setting $value is a $aliases{$local}[1]{action} in aliases!"
+ }
+}
+warn "CorrespondAddress and CommentAddress are the same!\n"
+ if RT->Config->Get("CorrespondAddress") eq RT->Config->Get("CommentAddress");
+
+
+# Go through the queues, one at a time
+my $queues = RT::Queues->new( RT->SystemUser );
+$queues->UnLimit;
+while (my $q = $queues->Next) {
+ my $qname = $q->Name;
+ for my $action (qw/correspond comment/) {
+ my $setting = ucfirst($action) . "Address";
+ my $value = $q->$setting;
+
+ if (not $value) {
+ my @other = grep {$_ ne $global{$setting}} @{$seen{lc $q->Name}{$action} || []};
+ warn "CorrespondAddress not set on $qname, but in aliases as "
+ .join(" and ", @other) . "\n" if @other;
+ next;
+ }
+
+ if ($action eq "comment" and $q->CorrespondAddress
+ and $q->CorrespondAddress eq $q->CommentAddress) {
+ warn "CorrespondAddress and CommentAddress are set the same on $qname\n";
+ next;
+ }
+
+ my ($local, $host) = lc($value) =~ /(.*?)\@(.*)/;
+ next if $HOST and $host !~ /\Q$HOST\E/;
+ $local = "$PREFIX$local" unless exists $aliases{$local};
+
+ my @other = @{$seen{lc $q->Name}{$action} || []};
+ if (not exists $aliases{$local}) {
+ if (@other) {
+ warn "$setting $value on $qname does not exist in aliases -- typo'd as "
+ .join(" or ", @other) . "?\n";
+ } else {
+ warn "$setting $value on $qname does not exist in aliases!\n"
+ }
+ next;
+ }
+
+ my %opt = %{$aliases{$local}[1]};
+ if ($opt{action} ne $action) {
+ warn "$setting address $value on $qname is a $opt{action} in aliases!\n"
+ }
+ if (lc $opt{queue} ne lc $q->Name and $action ne "comment") {
+ warn "$setting address $value on $qname points to queue $opt{queue} in aliases!\n";
+ }
+
+ @other = grep {$_ ne $local} @other;
+ warn "Extra aliases for queue $qname: ".join(",",@other)."\n"
+ if @other;
+ }
+}
+
+
+sub parse_lines {
+ local @ARGV = @ARGV;
+
+ my %aliases;
+ my $line = "";
+ for (<>) {
+ next unless /\S/;
+ next if /^#/;
+ chomp;
+ if (/^\s+/) {
+ $line .= $_;
+ } else {
+ add_line($line, \%aliases);
+ $line = $_;
+ }
+ }
+ add_line($line, \%aliases);
+
+ expand(\%aliases);
+ filter_mailgate(\%aliases);
+
+ return %aliases;
+}
+
+sub expand {
+ my ($data) = @_;
+
+ for (1..100) {
+ my $expanded = 0;
+ for my $address (sort keys %{$data}) {
+ my @new;
+ for my $part (@{$data->{$address}}) {
+ if (m!^[|/]! or not $data->{$part}) {
+ push @new, $part;
+ } else {
+ $expanded++;
+ push @new, @{$data->{$part}};
+ }
+ }
+ $data->{$address} = \@new;
+ }
+ return unless $expanded;
+ }
+ warn "Recursion limit exceeded -- cycle in aliases?\n";
+}
+
+sub filter_mailgate {
+ my ($data) = @_;
+
+ for my $address (sort keys %{$data}) {
+ my @parts = @{delete $data->{$address}};
+
+ my @pipes = grep {m!^\|?.*?/rt-mailgate\b!} @parts;
+ next unless @pipes;
+
+ my $pipe = shift @pipes;
+ warn "More than one rt-mailgate pipe for alias: $address\n"
+ if @pipes;
+
+ my @args = Text::ParseWords::shellwords($pipe);
+
+ # We allow "|/random-other-command /opt/rt4/bin/rt-mailgate ...",
+ # we just need to strip off enough
+ my $index = 0;
+ $index++ while $args[$index] !~ m!/rt-mailgate!;
+ my $mailgate = join(' ', splice(@args,0,$index+1));
+
+ my %opts;
+ local @ARGV = @args;
+ Getopt::Long::Configure( "pass_through" ); # Allow unknown options
+ my $ret = eval {
+ GetOptions( \%opts, "queue=s", "action=s", "url=s",
+ "jar=s", "debug", "extension=s",
+ "timeout=i", "verify-ssl!", "ca-file=s",
+ );
+ 1;
+ };
+ warn "Failed to parse options for $address: $@" unless $ret;
+ next unless %opts;
+
+ $data->{lc $address} = [$mailgate, \%opts, [@ARGV]];
+ }
+}
+
+sub add_line {
+ my ($line, $data) = @_;
+ return unless $line =~ /\S/;
+
+ my ($name, $parts) = parse_line($line);
+ return unless defined $name;
+
+ if (defined $data->{$name}) {
+ warn "Duplicate definition for alias $name\n";
+ return;
+ }
+
+ $data->{lc $name} = $parts;
+}
+
+sub parse_line {
+ my $re_name = qr/\S+/;
+ # Intentionally accept pipe-like aliases with a missing | -- we deal with them later
+ my $re_quoted_pipe = qr/"\|?[^\\"]*(?:\\[\\"][^\\"]*)*"/;
+ my $re_nonquoted_pipe = qr/\|[^\s,]+/;
+ my $re_pipe = qr/(?:$re_quoted_pipe|$re_nonquoted_pipe)/;
+ my $re_path = qr!/[^,\s]+!;
+ my $re_address = qr![^|/,\s][^,\s]*!;
+ my $re_value = qr/(?:$re_pipe|$re_path|$re_address)/;
+ my $re_values = qr/(?:$re_value(?:\s*,\s*$re_value)*)/;
+
+ my ($line) = @_;
+ if ($line =~ /^($re_name):\s*($re_values)/) {
+ my ($name, $all_parts) = ($1, $2);
+ my @parts;
+ while ($all_parts =~ s/^(?:\s*,\s*)?($re_value)//) {
+ my $part = $1;
+ if ($part =~ /^"/) {
+ $part =~ s/^"//; $part =~ s/"$//;
+ $part =~ s/\\(.)/$1/g;
+ }
+ push @parts, $part;
+ }
+ return $name, [@parts];
+ } else {
+ warn "Parse failure, line $. of $ARGV: $line\n";
+ return ();
+ }
+}
push @results, @warnings;
-unless ($Group->Disabled()) {
- $EnabledChecked ='checked="checked"';
-}
-
+$EnabledChecked = ( $Group->Disabled() ? '' : 'checked="checked"' );
</%INIT>
<td align="right"><input type="checkbox" class="checkbox" name="Encrypt" value="1" <% $QueueObj->Encrypt? 'checked="checked"': '' |n%> /></td>
<td><&|/l&>Encrypt by default</&></td>
</tr>
+<tr><td align="right"><input type="checkbox" class="checkbox" name="SignAuto" value="1" <% $QueueObj->SignAuto? 'checked="checked"': '' |n%> /></td>
+<td colspan="3"><&|/l_unsafe, "<b>","</b>","<i>","</i>"&>Sign all auto-generated mail. [_1]Caution[_2]: Enabling this option alters the signature from providing [_3]authentication[_4] to providing [_3]integrity[_4].</&></td></tr>
% }
<tr><td align="right"><input type="checkbox" class="checkbox" name="Enabled" value="1" <%$EnabledChecked|n%> /></td>
if ( $QueueObj->Id ) {
$title = loc('Configuration for queue [_1]', $QueueObj->Name );
my @attribs= qw(Description CorrespondAddress CommentAddress Name
- InitialPriority FinalPriority DefaultDueIn Sign Encrypt Lifecycle SubjectTag Disabled);
+ InitialPriority FinalPriority DefaultDueIn Sign SignAuto Encrypt Lifecycle SubjectTag Disabled);
# we're asking about enabled on the web page but really care about disabled
if ( $SetEnabled ) {
$Disabled = $ARGS{'Disabled'} = $Enabled? 0: 1;
$ARGS{$_} = 0 foreach grep !defined $ARGS{$_} || !length $ARGS{$_},
- qw(Sign Encrypt Disabled);
+ qw(Sign SignAuto Encrypt Disabled);
}
$m->callback(
<& /Widgets/Form/Select,
Name => 'PrivateKey',
Description => loc('Private Key'),
- Values => [ map $_->{'Key'}, @{ $keys_meta{'info'} } ],
+ Values => \@potential_keys,
CurrentValue => $UserObj->PrivateKey,
DefaultLabel => loc('No private key'),
&>
$id = $ARGS{'id'} = $UserObj->id;
my $email = $UserObj->EmailAddress;
-my %keys_meta = RT::Crypt::GnuPG::GetKeysForSigning( $email, 'force' );
+my %keys_meta = RT::Crypt::GnuPG::GetKeysForSigning( $email );
+my @potential_keys = map $_->{'Key'}, @{ $keys_meta{'info'} || [] };
$ARGS{'PrivateKey'} = $m->comp('/Widgets/Form/Select:Process',
Name => 'PrivateKey',
);
if ( $Update ) {
- my ($status, $msg) = $UserObj->SetPrivateKey( $ARGS{'PrivateKey'} );
- push @results, $msg;
+ if (not $ARGS{'PrivateKey'} or grep {$_ eq $ARGS{'PrivateKey'}} @potential_keys) {
+ if (($ARGS{'PrivateKey'}||'') ne ($UserObj->PrivateKey||'')) {
+ my ($status, $msg) = $UserObj->SetPrivateKey( $ARGS{'PrivateKey'} );
+ push @results, $msg;
+ }
+ } else {
+ push @results, loc("Invalid key [_1] for address '[_2]'", $ARGS{'PrivateKey'}, $email);
+ }
}
my $title = loc("[_1]'s GnuPG keys",$UserObj->Name);
% my $strong_start = "<strong>";
% my $strong_end = "</strong>";
-<p><&|/l_unsafe, $strong_start, $strong_end, $Reason &>RT has detected a possible [_1]cross-site request forgery[_2] for this request, because [_3]. This is possibly caused by a malicious attacker trying to perform actions against RT on your behalf. If you did not initiate this request, then you should alert your security team.</&></p>
+<p><&|/l_unsafe, $strong_start, $strong_end, $Reason, $action &>RT has detected a possible [_1]cross-site request forgery[_2] for this request, because [_3]. A malicious attacker may be trying to [_1][_4][_2] on your behalf. If you did not initiate this request, then you should alert your security team.</&></p>
% my $start = qq|<strong><a href="$url_with_token">|;
% my $end = qq|</a></strong>|;
-<p><&|/l_unsafe, $escaped_path, $start, $end &>If you really intended to visit [_1], then [_2]click here to resume your request[_3].</&></p>
+<p><&|/l_unsafe, $escaped_path, $action, $start, $end &>If you really intended to visit [_1] and [_2], then [_3]click here to resume your request[_4].</&></p>
<& /Elements/Footer, %ARGS &>
% $m->abort;
my $url_with_token = URI->new($OriginalURL);
$url_with_token->query_form([CSRF_Token => $Token]);
+
+my $action = RT::Interface::Web::PotentialPageAction($OriginalURL) || loc("perform actions");
</%INIT>
$QueueObj ||= $TicketObj->QueueObj
if $TicketObj;
- my $address = $self->{'SignUsing'};
- $address ||= ($self->{'UpdateType'} && $self->{'UpdateType'} eq "private")
+ my $private = $session{'CurrentUser'}->UserObj->PrivateKey || '';
+ my $queue = ($self->{'UpdateType'} && $self->{'UpdateType'} eq "private")
? ( $QueueObj->CommentAddress || RT->Config->Get('CommentAddress') )
: ( $QueueObj->CorrespondAddress || RT->Config->Get('CorrespondAddress') );
- unless ( RT::Crypt::GnuPG::DrySign( $address ) ) {
+ my $address = $self->{'SignUsing'} || $queue;
+ if ($address ne $private and $address ne $queue) {
+ push @{ $self->{'GnuPGCanNotSignAs'} ||= [] }, $address;
+ $checks_failure = 1;
+ } elsif ( not RT::Crypt::GnuPG::DrySign( $address ) ) {
push @{ $self->{'GnuPGCanNotSignAs'} ||= [] }, $address;
$checks_failure = 1;
} else {
<div id="login-box">
<&| /Widgets/TitleBox, title => loc('Login'), titleright => $RT::VERSION, hideable => 0 &>
+<& LoginRedirectWarning, %ARGS &>
+
% unless (RT->Config->Get('WebExternalAuth') and !RT->Config->Get('WebFallbackToInternalAuth')) {
<form id="login" name="login" method="post" action="<% RT->Config->Get('WebPath') %>/NoAuth/Login.html">
--- /dev/null
+<%args>
+$next => undef
+</%args>
+<%init>
+return unless $next;
+
+my $destination = RT::Interface::Web::FetchNextPage($next);
+return unless ref $destination and $destination->{'HasSideEffects'};
+
+my $consequence = RT::Interface::Web::PotentialPageAction($destination->{'url'}) || loc("perform actions");
+ $consequence = $m->interp->apply_escapes($consequence => "h");
+</%init>
+<div class="redirect-warning">
+ <p>
+ <&|/l&>After logging in you'll be sent to your original destination:</&>
+ <tt title="<% $destination->{'url'} %>"><% $destination->{'url'} %></tt>
+ <&|/l_unsafe, "<strong>$consequence</strong>" &>which may [_1] on your behalf.</&>
+ </p>
+ <p><&|/l&>If this is not what you expect, leave this page now without logging in.</&></p>
+</div>
#my $request_path = $HTML::Mason::Commands::r->path_info;
my $request_path = $m->request_comp->path;
+$request_path =~ s!/{2,}!/!g;
my $query_string = sub {
my %args = @_;
padding-left: 1em;
}
+.redirect-warning tt {
+ display: block;
+ margin: 0.5em 0 0.5em 1em;
+ white-space: nowrap;
+ overflow: hidden;
+ text-overflow: ellipsis;
+ width: 90%;
+}
my $start = Data::ICal::Entry::Event->new;
my $end = Data::ICal::Entry::Event->new;
$_->add_properties(
- url => RT->Config->Get('WebURL') . "?q=".$t->id,
+ url => RT->Config->Get('WebURL') . "Ticket/Display.html?id=".$t->id,
organizer => $t->OwnerObj->Name,
dtstamp => $now->iCal,
created => $t->CreatedObj->iCal,
$m->comp('/Elements/MakeClicky', content => \$f->{'Value'}, ticket => $ticket, %ARGS);
}
+$m->callback(
+ CallbackName => 'BeforeLocalization',
+ headers => \@headers,
+);
+
if ( $Localize ) {
$_->{'Tag'} = loc($_->{'Tag'}) foreach @headers;
}
}
use RT::Test::GnuPG
- tests => 41,
+ tests => 49,
actual_server => 1,
gnupg_options => {
passphrase => 'rt-test',
use String::ShellQuote 'shell_quote';
use IPC::Run3 'run3';
+use MIME::Base64;
my ($baseurl, $m) = RT::Test->started_ok;
ok(index($orig->Content, $buf) != -1, 'found original msg');
}
+
+# test that if it gets base64 transfer-encoded, we still get the content out
+$buf = encode_base64($buf);
+$mail = RT::Test->open_mailgate_ok($baseurl);
+print $mail <<"EOF";
+From: recipient\@example.com
+To: general\@$RT::rtname
+Content-transfer-encoding: base64
+Subject: Encrypted message for queue
+
+$buf
+EOF
+RT::Test->close_mailgate_ok($mail);
+
+{
+ my $tick = RT::Test->last_ticket;
+ is( $tick->Subject, 'Encrypted message for queue',
+ "Created the ticket"
+ );
+
+ my $txn = $tick->Transactions->First;
+ my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
+
+ is( $msg->GetHeader('X-RT-Incoming-Encryption'),
+ 'Success',
+ 'recorded incoming mail that is encrypted'
+ );
+ is( $msg->GetHeader('X-RT-Privacy'),
+ 'PGP',
+ 'recorded incoming mail that is encrypted'
+ );
+ like( $attach->Content, qr/orz/);
+
+ is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
+ ok(index($orig->Content, $buf) != -1, 'found original msg');
+}
+
+
# test for signed mail by other key
$buf = '';
'trust-model' => 'always',
};
use Test::Warn;
+use MIME::Head;
use RT::Action::SendEmail;
for my $mail (@mail) {
unlike $mail, qr/Some content/, "outgoing mail was encrypted";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
like $mail, qr/Some other content/, "outgoing mail was not encrypted";
like $mail, qr/-----BEGIN PGP SIGNATURE-----[\s\S]+-----END PGP SIGNATURE-----/, "data has some kind of signature";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
for my $mail (@mail) {
unlike $mail, qr/Some other content/, "outgoing mail was encrypted";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
for my $mail (@mail) {
like $mail, qr/Thought you had me figured out didya/, "outgoing mail was unencrypted";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
like($attachments[0]->Content, qr/$RT::rtname/, "RT's mail includes this instance's name");
}
+sub get_headers {
+ my $mail = shift;
+ open my $fh, "<", \$mail or die $!;
+ my $head = MIME::Head->read($fh);
+ return @{[
+ map {
+ my $hdr = "$_: " . $head->get($_);
+ chomp $hdr;
+ $hdr;
+ }
+ @_
+ ]};
+}
+
sub strip_headers
{
my $mail = shift;
my ($mail) = RT::Test->fetch_caught_mails;
like( $mail, qr!Subject: test forward!, 'Subject field' );
like( $mail, qr!To: rt-test, rt-to\@example.com!, 'To field' );
- like( $mail, qr!Cc: rt-cc\@example.com!, 'Cc field' );
+ like( $mail, qr!Cc: rt-cc\@example.com!i, 'Cc field' );
like( $mail, qr!This is a forward of ticket!, 'content' );
like( $mail, qr!this is an attachment!, 'att content' );
like( $mail, qr!$att_name!, 'att file name' );
my ($mail) = RT::Test->fetch_caught_mails;
like( $mail, qr!Subject: test forward!, 'Subject field' );
like( $mail, qr!To: rt-test, rt-to\@example.com!, 'To field' );
- like( $mail, qr!Cc: rt-cc\@example.com!, 'Cc field' );
- like( $mail, qr!Bcc: rt-bcc\@example.com!, 'Bcc field' );
+ like( $mail, qr!Cc: rt-cc\@example.com!i, 'Cc field' );
+ like( $mail, qr!Bcc: rt-bcc\@example.com!i, 'Bcc field' );
like( $mail, qr!This is a forward of transaction!, 'content' );
like( $mail, qr!$att_name!, 'att file name' );
like( $mail, qr!this is an attachment!, 'att content' );
projects / freeside.git / commitdiff