[freeside-commits] branch master updated. 913bd0405d6eb0db41b9944dfd42eb1f97d18ca9
Mark Wells
mark at 420.am
Tue Dec 11 14:40:29 PST 2012
The branch, master has been updated
via 913bd0405d6eb0db41b9944dfd42eb1f97d18ca9 (commit)
via bda74e13569c8531e77e8dcd01d9da9038f3c4d0 (commit)
via 1bd0489531c022fbe198a0023cf3cf01861d0817 (commit)
from 5c7291f9b5ff6f1e529c530db6ff56135ef7055a (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 913bd0405d6eb0db41b9944dfd42eb1f97d18ca9
Author: Mark Wells <mark at freeside.biz>
Date: Tue Dec 11 14:38:07 2012 -0800
system log, #18333
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
index b38c267..66624e1 100644
--- a/FS/FS/AccessRight.pm
+++ b/FS/FS/AccessRight.pm
@@ -277,6 +277,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 0aafd25..d11916f 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -749,6 +749,15 @@ sub reason_type_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 a9df376..6e110e8 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 ccf8e1a..628c680 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 FS::Misc qw( send_email ); #for bridgestone
use FS::upload_target;
use LWP::UserAgent;
@@ -33,6 +34,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'};
@@ -96,7 +99,10 @@ sub upload {
} # foreach @agents
# 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}) {
@@ -142,11 +148,13 @@ 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;
@@ -166,6 +174,7 @@ sub spool_upload {
my $dbh = dbh;
my $agentnum = $opt{agentnum};
+ $log->debug('start', agentnum => $agentnum);
my $agent;
if ( $agentnum ) {
@@ -184,6 +193,8 @@ sub spool_upload {
{
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;
}
@@ -263,6 +274,7 @@ sub spool_upload {
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;
}
@@ -451,6 +463,8 @@ sub spool_upload {
} #opt{handling}
+ $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 4b1f800..2bc1596 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;
@@ -329,6 +330,8 @@ if ( -e $addl_handler_use_file ) {
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 ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 9eb59a0..172ac82 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
@@ -3972,6 +3973,32 @@ sub tables_hashref {
'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
diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm
index 11247a2..3dc8f9c 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 9c444be..f954fe8 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -675,3 +675,7 @@ FS/svc_export_machine.pm
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
diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily
index 8e8ae4f..65e3ebd 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);
@@ -74,6 +77,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 bfbc179..66e8bf6 100644
--- a/httemplate/elements/menu.html
+++ b/httemplate/elements/menu.html
@@ -346,6 +346,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');
@@ -375,6 +383,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');
@@ -440,8 +450,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');
$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 5c8001f..7ccf356 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'}} ] : [];
@@ -360,6 +361,7 @@
% if ( $links ) {
% my $link = shift @$links;
% my $onclick = shift @$onclicks;
+% my $tooltip = shift @$tooltips;
%
% if ( ! $opt{'agent_virt'}
% || ( $null_link && ! $row->agentnum )
@@ -374,6 +376,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' ) {
@@ -381,11 +391,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++;
+
% }
%
% }
@@ -499,4 +514,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 bda74e13569c8531e77e8dcd01d9da9038f3c4d0
Author: Mark Wells <mark at freeside.biz>
Date: Tue Dec 11 13:56:48 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 100644
--- 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 1bd0489531c022fbe198a0023cf3cf01861d0817
Author: Mark Wells <mark at freeside.biz>
Date: Tue Dec 11 13:55:53 2012 -0800
cleanup
diff --git a/httemplate/view/part_event-targets.html b/httemplate/view/part_event-targets.html
index 2029fd4..e8b1266 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 | 16 ++-
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 +-
httemplate/elements/menu.html | 12 +-
httemplate/search/elements/search-html.html | 18 ++-
httemplate/search/log.html | 221 +++++++++++++++++
httemplate/view/part_event-targets.html | 3 -
21 files changed, 909 insertions(+), 52 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