[freeside-commits] branch FREESIDE_2_3_BRANCH updated. 61f1dbf6a14999ac75ad76c7b2b6f706ed438c11
Mark Wells
mark at 420.am
Tue Dec 11 14:40:27 PST 2012
The branch, FREESIDE_2_3_BRANCH has been updated
via 61f1dbf6a14999ac75ad76c7b2b6f706ed438c11 (commit)
via fdf63fa70255936cd7e0bbbb7ad6500290cb5229 (commit)
via 4becc0cde48567eb36e2b699a9f6c3ddefff2031 (commit)
via 0889e865c95d649a42373b57401856ff2dc237d2 (commit)
from 40e84bc054e93ab85739867134a341d28cf748fa (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 61f1dbf6a14999ac75ad76c7b2b6f706ed438c11
Author: Mark Wells <mark at freeside.biz>
Date: Tue Dec 11 13:53:42 2012 -0800
system log, #18333
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
index 99a81c0..90718b2 100644
--- a/FS/FS/AccessRight.pm
+++ b/FS/FS/AccessRight.pm
@@ -276,6 +276,7 @@ tie my %rights, 'Tie::IxHash',
'Financial reports',
{ rightname=> 'List inventory', global=>1 },
{ rightname=>'View email logs', global=>1 },
+ { rightname=>'View system logs' },
'Download report data',
'Services: Accounts',
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index d4f10fd..145ea5c 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -727,6 +727,15 @@ my %payment_gateway_options = (
},
{
+ '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.',
diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm
index bdf7e78..46ef610 100644
--- a/FS/FS/Cron/bill.pm
+++ b/FS/FS/Cron/bill.pm
@@ -13,6 +13,8 @@ use FS::cust_main;
use FS::part_event;
use FS::part_event_condition;
+use FS::Log;
+
@ISA = qw( Exporter );
@EXPORT_OK = qw ( bill bill_where );
@@ -27,6 +29,9 @@ use FS::part_event_condition;
sub bill {
my %opt = @_;
+ my $log = FS::Log->new('Cron::bill');
+ $log->info('start');
+
my $check_freq = $opt{'check_freq'} || '1d';
my $debug = 0;
@@ -134,6 +139,7 @@ sub bill {
$cursor_dbh->commit or die $cursor_dbh->errstr;
+ $log->info('finish');
}
# freeside-daily %opt:
diff --git a/FS/FS/Cron/upload.pm b/FS/FS/Cron/upload.pm
index 1f21ee9..d00037a 100644
--- a/FS/FS/Cron/upload.pm
+++ b/FS/FS/Cron/upload.pm
@@ -9,6 +9,7 @@ use FS::Record qw( qsearch qsearchs );
use FS::Conf;
use FS::queue;
use FS::agent;
+use FS::Log;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common;
@@ -30,6 +31,8 @@ $me = '[FS::Cron::upload]';
sub upload {
my %opt = @_;
+ my $log = FS::Log->new('Cron::upload');
+ $log->info('start');
my $debug = 0;
$debug = 1 if $opt{'v'};
@@ -113,7 +116,10 @@ sub upload {
} #!if cust_bill-ftp_spool
# if there's nothing to do, don't hold up the rest of the process
- return '' if !@tasks;
+ if (!@tasks) {
+ $log->info('finish (nothing to upload)');
+ return '';
+ }
# wait for any ongoing billing jobs to complete
if ($opt{m}) {
@@ -159,17 +165,21 @@ sub upload {
}
}
+ $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 $dir = '%%%FREESIDE_EXPORT%%%/export.'. $FS::UID::datasrc. '/cust_bill';
my $agentnum = $opt{agentnum} || '';
+ $log->debug('start', agentnum => $agentnum);
+
my $url = $opt{url} or die "no url for agent $agentnum\n";
$url =~ s/^\s+//; $url =~ s/\s+$//;
@@ -206,6 +216,8 @@ sub spool_upload {
{
warn "$me neither $dir/agentnum$agentnum-header.csv nor ".
"$dir/agentnum$agentnum-detail.csv found\n" if $DEBUG;
+ $log->debug("finish (neither agentnum$agentnum-header.csv nor ".
+ "agentnum$agentnum-detail.csv found)");
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return;
}
@@ -271,6 +283,7 @@ sub spool_upload {
my $file = $opt{agentnum} ? "agentnum$opt{agentnum}" : 'spool'; #.csv
unless ( -f "$dir/$file.csv" ) {
warn "$me $dir/$file.csv not found\n" if $DEBUG;
+ $log->debug("finish ($dir/$file.csv not found)");
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return;
}
@@ -297,6 +310,8 @@ sub spool_upload {
die "malformed FTP URL $url\n";
}
} #opt{format}
+
+ $log->debug('finish', agentnum => $agentnum);
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
diff --git a/FS/FS/Log.pm b/FS/FS/Log.pm
new file mode 100644
index 0000000..b11630b
--- /dev/null
+++ b/FS/FS/Log.pm
@@ -0,0 +1,103 @@
+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;
diff --git a/FS/FS/Log/Output.pm b/FS/FS/Log/Output.pm
new file mode 100644
index 0000000..18d7f1b
--- /dev/null
+++ b/FS/FS/Log/Output.pm
@@ -0,0 +1,50 @@
+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;
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index 724b85b..8058b5f 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -56,6 +56,7 @@ if ( -e $addl_handler_use_file ) {
#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;
@@ -311,6 +312,8 @@ if ( -e $addl_handler_use_file ) {
use FS::tower;
use FS::tower_sector;
use FS::agent_pkg_class;
+ use FS::log;
+ use FS::log_context;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 9a744ef..03a6c27 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -191,6 +191,7 @@ sub dbdef_dist {
foreach my $table (
grep { ! /^clientapi_session/
&& ! /^h_/
+ && ! /^log(_context)?$/
&& ! $tables_hashref_torrus->{$_}
}
$dbdef->tables
@@ -3660,6 +3661,32 @@ sub tables_hashref {
'index' => [ [ 'upgrade' ] ],
},
+ '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
diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm
index ef51fdb..ca0f8e5 100644
--- a/FS/FS/cust_main/Billing.pm
+++ b/FS/FS/cust_main/Billing.pm
@@ -21,6 +21,7 @@ use FS::cust_bill_pkg_tax_rate_location;
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
@@ -104,6 +105,9 @@ options of those methods are also available.
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
@@ -168,6 +172,7 @@ sub bill_and_collect {
}
}
$job->update_statustext('100,finished') if $job;
+ $log->debug('finish', object => $self, agentnum => $self->agentnum);
'';
diff --git a/FS/FS/log.pm b/FS/FS/log.pm
new file mode 100644
index 0000000..a4ad214
--- /dev/null
+++ b/FS/FS/log.pm
@@ -0,0 +1,354 @@
+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;
+
diff --git a/FS/FS/log_context.pm b/FS/FS/log_context.pm
new file mode 100644
index 0000000..372bdaa
--- /dev/null
+++ b/FS/FS/log_context.pm
@@ -0,0 +1,145 @@
+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;
+
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 0524808..68d3a29 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -635,3 +635,7 @@ t/upgrade_journal.t
FS/Trace.pm
FS/agent_pkg_class.pm
t/agent_pkg_class.t
+FS/log.pm
+t/log.t
+FS/log_context.pm
+t/log_context.t
diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily
index 0efe2ad..5a063bf 100755
--- a/FS/bin/freeside-daily
+++ b/FS/bin/freeside-daily
@@ -4,6 +4,7 @@ use strict;
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);
@@ -11,6 +12,8 @@ getopts("p:a:d:vl:sy:nmrkg:o", \%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);
@@ -69,6 +72,8 @@ unlink <${deldir}.CGItemp*>;
use FS::Cron::backup qw(backup);
backup();
+$log->info('finish');
+
###
# subroutines
###
diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued
index f136c39..2fd8025 100644
--- a/FS/bin/freeside-queued
+++ b/FS/bin/freeside-queued
@@ -11,6 +11,7 @@ use FS::Conf;
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;
@@ -45,6 +46,7 @@ while ( $@ ) {
}
}
+my $log = FS::Log->new('queue');
logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc );
warn "completing daemonization (detaching))\n" if $DEBUG;
@@ -135,6 +137,8 @@ while (1) {
foreach my $job ( @jobs ) {
+ $log->debug('locking queue job', object => $job);
+
my %hash = $job->hash;
$hash{'status'} = 'locked';
my $ljob = new FS::queue ( \%hash );
@@ -205,6 +209,8 @@ while (1) {
}
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 ( $@ ) {
diff --git a/FS/t/log.t b/FS/t/log.t
new file mode 100644
index 0000000..42c604b
--- /dev/null
+++ b/FS/t/log.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::log;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/log_context.t b/FS/t/log_context.t
new file mode 100644
index 0000000..57c3b34
--- /dev/null
+++ b/FS/t/log_context.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::log_context;
+$loaded=1;
+print "ok 1\n";
diff --git a/httemplate/elements/menu.html b/httemplate/elements/menu.html
index 93b2fbe..e6fdb57 100644
--- a/httemplate/elements/menu.html
+++ b/httemplate/elements/menu.html
@@ -340,6 +340,14 @@ if($curuser->access_right('Financial reports')) {
} # 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' ]
if $curuser->access_right('List prospects');
@@ -367,6 +375,8 @@ $report_menu{'Billing events'} = [ \%report_bill_event, 'Billing events' ]
$report_menu{'Financial'} = [ \%report_financial, 'Financial reports' ]
if $curuser->access_right('Financial reports')
or $curuser->access_right('Receivables report');
+$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');
@@ -424,9 +434,6 @@ $tools_menu{'Time Queue'} = [ $fsurl.'search/report_timeworked.html', 'View pen
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')
- || $curuser->access_right('Configuration');
$tools_menu{'Importing'} = [ \%tools_importing, 'Import tools' ]
if $curuser->access_right('Import');
$tools_menu{'Exporting'} = [ \%tools_exporting, 'Export tools' ]
diff --git a/httemplate/search/elements/search-html.html b/httemplate/search/elements/search-html.html
index 2e36919..a239aaf 100644
--- a/httemplate/search/elements/search-html.html
+++ b/httemplate/search/elements/search-html.html
@@ -259,6 +259,7 @@
%
% 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'}} ] : [];
@@ -354,6 +355,7 @@
% if ( $links ) {
% my $link = shift @$links;
% my $onclick = shift @$onclicks;
+% my $tooltip = shift @$tooltips;
%
% if ( ! $opt{'agent_virt'}
% || ( $null_link && ! $row->agentnum )
@@ -368,6 +370,14 @@
% 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' ) {
@@ -375,11 +385,16 @@
% } 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++;
+
% }
%
% }
@@ -493,4 +508,5 @@ $count_sth->execute
my $count_arrayref = $count_sth->fetchrow_arrayref;
my $total = $count_arrayref->[0];
+my $id = 0;
</%init>
diff --git a/httemplate/search/log.html b/httemplate/search/log.html
new file mode 100644
index 0000000..d1bfb6c
--- /dev/null
+++ b/httemplate/search/log.html
@@ -0,0 +1,221 @@
+<& 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>
commit fdf63fa70255936cd7e0bbbb7ad6500290cb5229
Author: Mark Wells <mark at freeside.biz>
Date: Tue Dec 11 13:51:23 2012 -0800
auto-create package classes in ipifony download, #18333
diff --git a/FS/bin/freeside-ipifony-download b/FS/bin/freeside-ipifony-download
index ac9f764..e893326 100755
--- a/FS/bin/freeside-ipifony-download
+++ b/FS/bin/freeside-ipifony-download
@@ -12,7 +12,7 @@ use FS::Conf;
use Text::CSV;
my %opt;
-getopts('va:P:', \%opt);
+getopts('va:P:C:', \%opt);
#$Net::SFTP::Foreign::debug = -1;
sub HELP_MESSAGE { '
@@ -21,6 +21,7 @@ sub HELP_MESSAGE { '
[ -v ]
[ -a archivedir ]
[ -P port ]
+ [ -C category ]
freesideuser sftpuser at hostname[:path]
' }
@@ -49,6 +50,16 @@ if ( $opt{a} ) {
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?
@@ -149,8 +160,23 @@ FILE: foreach my $filename (@$files) {
if (my $classname = $hash{classname}) {
if (!exists($classnum_of{$classname}) ) {
# then look it up
- my $pkg_class = qsearch('pkg_class', { classname => $classname });
- $classnum_of{$classname} = $pkg_class ? $pkg_class->classnum : '';
+ 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};
}
commit 4becc0cde48567eb36e2b699a9f6c3ddefff2031
Author: Mark Wells <mark at freeside.biz>
Date: Tue Dec 11 13:50:44 2012 -0800
cleanup
diff --git a/bin/generate-table-module b/bin/generate-table-module
index e7fc992..77b5a15 100755
--- a/bin/generate-table-module
+++ b/bin/generate-table-module
@@ -95,8 +95,6 @@ close TEST;
# add them to MANIFEST
###
-system('cvs edit FS/MANIFEST');
-
open(MANIFEST,">>FS/MANIFEST") or die $!;
print MANIFEST "FS/$table.pm\n",
"t/$table.t\n";
commit 0889e865c95d649a42373b57401856ff2dc237d2
Author: Mark Wells <mark at freeside.biz>
Date: Tue Dec 11 13:50:34 2012 -0800
cleanup
diff --git a/httemplate/view/part_event-targets.html b/httemplate/view/part_event-targets.html
index 10b5e98..415aa84 100644
--- a/httemplate/view/part_event-targets.html
+++ b/httemplate/view/part_event-targets.html
@@ -65,9 +65,6 @@ When event is run on <& /elements/input-date-field.html, {
%}
<& /elements/footer.html &>
-<%once>
-use List::MoreUtils qw(uniq);
-</%once>
<%init>
my $curuser = $FS::CurrentUser::CurrentUser;
-----------------------------------------------------------------------
Summary of changes:
FS/FS/AccessRight.pm | 1 +
FS/FS/Conf.pm | 9 +
FS/FS/Cron/bill.pm | 6 +
FS/FS/Cron/upload.pm | 17 ++-
FS/FS/Log.pm | 103 ++++++++
FS/FS/Log/Output.pm | 50 ++++
FS/FS/Mason.pm | 3 +
FS/FS/Schema.pm | 27 ++
FS/FS/cust_main/Billing.pm | 5 +
FS/FS/log.pm | 354 +++++++++++++++++++++++++++
FS/FS/{contact_phone.pm => log_context.pm} | 82 ++++---
FS/MANIFEST | 4 +
FS/bin/freeside-daily | 5 +
FS/bin/freeside-ipifony-download | 32 +++-
FS/bin/freeside-queued | 6 +
FS/t/{UID.t => log.t} | 2 +-
FS/t/{AccessRight.t => log_context.t} | 2 +-
bin/generate-table-module | 2 -
httemplate/elements/menu.html | 13 +-
httemplate/search/elements/search-html.html | 18 ++-
httemplate/search/log.html | 221 +++++++++++++++++
httemplate/view/part_event-targets.html | 3 -
22 files changed, 910 insertions(+), 55 deletions(-)
create mode 100644 FS/FS/Log.pm
create mode 100644 FS/FS/Log/Output.pm
create mode 100644 FS/FS/log.pm
copy FS/FS/{contact_phone.pm => log_context.pm} (60%)
copy FS/t/{UID.t => log.t} (88%)
copy FS/t/{AccessRight.t => log_context.t} (82%)
create mode 100644 httemplate/search/log.html
More information about the freeside-commits
mailing list