define variables for audit log mails and re-organize

also added an object() method to entries

diff --git a/site/cgi-bin/modules/BSE/TB/AuditEntry.pm b/site/cgi-bin/modules/BSE/TB/AuditEntry.pm
index 1589ef2d6488ba2d0e02f7e331c11831df187326..bd09543b0bf47036a561fe55b86f120efa9d03ef 100644 (file)
--- a/site/cgi-bin/modules/BSE/TB/AuditEntry.pm
+++ b/site/cgi-bin/modules/BSE/TB/AuditEntry.pm
@@ -2,7 +2,17 @@ package BSE::TB::AuditEntry;
 use strict;
 use base qw(Squirrel::Row);
 
-our $VERSION = "1.007";
+our $VERSION = "1.009";
+
+=head1 NAME
+
+BSE::TB::AuditEntry - an entry in the audit log.
+
+=head1 METHODS
+
+=over
+
+=cut
 
 sub columns {
   return qw/id 
@@ -26,12 +36,52 @@ sub table {
   "bse_audit_log";
 }
 
+=item when_at
+
+=item facility
+
+=item component
+
+=item module
+
+=item function
+
+=item level
+
+=item actor_type
+
+=item actor_id
+
+=item object_type
+
+=item object_id
+
+=item ip_address
+
+=item msg
+
+=item dump
+
+Simple accessors.
+
+=item level_name
+
+Retrieve the level as text.
+
+=cut
+
 sub level_name {
   my ($self) = @_;
 
   return BSE::TB::AuditLog->level_id_to_name($self->level);
 }
 
+=item actor_name
+
+Retrieve description of the actor.
+
+=cut
+
 sub actor_name {
   my ($self) = @_;
 
@@ -70,6 +120,12 @@ sub actor_name {
   }
 }
 
+=item actor_link
+
+Retrieve a link to the actor.
+
+=cut
+
 sub actor_link {
   my ($self) = @_;
 
@@ -124,6 +180,12 @@ my %types =
    },
   );
 
+=item object_link
+
+Retrieve a link to the object.
+
+=cut
+
 sub object_link {
   my ($self) = @_;
 
@@ -149,6 +211,12 @@ sub object_link {
   }
 }
 
+=item object_name
+
+Retrieve a name for the object.
+
+=cut
+
 sub object_name {
   my ($self) = @_;
 
@@ -156,15 +224,11 @@ sub object_name {
     or return '(None)';
   my $entry = $types{$type};
   my $cfg = BSE::Cfg->single;
-  my $class = $entry ? $entry->{class} : $cfg->entry("type $type", "class");
   my $method = $cfg->entry("type $type", "method", "describe");
   my $format = $cfg->entry("type $type", "format",
                          ($entry && $entry->{format}) ? $entry->{format} : "");
-  my $obj;
-  if ($class
-      && eval "use $class; 1"
-      && ($obj = $class->getByPkey($self->object_id))
-      && $obj->can($method)) {
+  my $obj = $self->object;
+  if ($obj && $obj->can($method)) {
     return $obj->$method();
   }
   elsif ($format) {
@@ -175,4 +239,131 @@ sub object_name {
   }
 }
 
+=item object
+
+Attempts retrieve the object for the log entry.
+
+=cut
+
+sub object {
+  my ($self) = @_;
+
+  my $type = $self->object_type
+    or return;
+
+  my $entry = $types{$type};
+  my $cfg = BSE::Cfg->single;
+  my $class = $cfg->entry("type $type", "class", $entry->{class});
+  my $obj;
+  if ($class
+      && eval "use $class; 1"
+      && ($obj = $class->getByPkey($self->object_id))) {
+    return $obj;
+  }
+
+  return;
+}
+
+=item mail()
+
+=cut
+
+=item mail
+
+Used internally to mail audit log entries.
+
+Template tags are common static tags and:
+
+=over
+
+=item *
+
+C<< entry I<field> >> - object tag for the log entry.
+
+=back
+
+Template variable:
+
+=over
+
+=item *
+
+C<entry> - the log entry object.
+
+=item *
+
+C<to> - the recipients
+
+=back
+
+=cut
+
+my $mailing;
+
+sub mail {
+  my ($entry, $cfg) = @_;
+
+  $mailing
+    and return;
+
+  $cfg ||= BSE::Cfg->single;
+  my $section = "mail audit log";
+  my $to = $cfg->entry($section, "to", $cfg->entry("shop", "from"));
+  my ($facility, $component, $module, $function) =
+    map $entry->$_(), qw(facility component module function);
+  my @look =
+    (
+     [ $section, "$facility-$component" ],
+     [ $section, "$facility-$component-$module" ],
+     [ $section, "$facility-$component-$module-$function" ],
+    );
+  my $send = $cfg->entry($section, $entry->level_name, 0);
+  $send =~ /\@/ and $to = $send;
+  for my $choice (@look) {
+    $send = $cfg->entry(@$choice, $send);
+    $send =~ /\@/ and $to = $send;
+  }
+  if ($send) {
+    $mailing = 1;
+    eval {
+      require BSE::ComposeMail;
+      if ($to) {
+       require BSE::Util::Tags;
+       my $mailer = BSE::ComposeMail->new(cfg => $cfg);
+       my %acts =
+         (
+          BSE::Util::Tags->static(undef, $cfg),
+          entry => [ \&BSE::Util::Tags::tag_object, $entry ],
+         );
+       $mailer->send(to => $to,
+                     subject => "BSE System Event",
+                     template => "admin/log/mail",
+                     acts => \%acts,
+                     vars =>
+                     {
+                      to => $to,
+                      entry => $entry,
+                     });
+      }
+    };
+    $mailing = 0;
+  }
+}
+
+sub restricted_method {
+  my ($self, $name) = @_;
+
+  return $self->SUPER::restricted_method($name)
+    || $name =~ /^(?:mail)$/;
+}
+
 1;
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
+

diff --git a/site/cgi-bin/modules/BSE/TB/AuditLog.pm b/site/cgi-bin/modules/BSE/TB/AuditLog.pm
index 96e35e4d16ca01da9ed026263e629a50c61d4ab3..441117aa6133bd2c0bd52a7315db239b2774b4e8 100644 (file)
--- a/site/cgi-bin/modules/BSE/TB/AuditLog.pm
+++ b/site/cgi-bin/modules/BSE/TB/AuditLog.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA $VERSION);
 use BSE::TB::AuditEntry;
 use Scalar::Util qw(blessed);
 
-our $VERSION = "1.005";
+our $VERSION = "1.006";
 
 sub rowClass {
   return 'BSE::TB::AuditEntry';
@@ -15,6 +15,14 @@ sub rowClass {
 # stop us recursing into here from BSE::ComposeMail
 my $mailing = 0;
 
+=head1 NAME
+
+BSE::TB::AuditLog - audit log for BSE
+
+=head1 METHODS
+
+=over
+
 =item log
 
 Log a message to the audit log.
@@ -167,42 +175,7 @@ sub log {
 
   my $entry = $class->make(%entry);
 
-  if (!$mailing) {
-    my $section = "mail audit log";
-    my $to = $cfg->entry($section, "to", $cfg->entry("shop", "from"));
-    my @look =
-      (
-       [ $section, join("-", @entry{qw/facility component/}) ],
-       [ $section, join("-", @entry{qw/facility component module/}) ],
-       [ $section, join("-", @entry{qw/facility component module function/}) ],
-      );
-    my $send = $cfg->entry($section, $level_name, 0);
-    $send =~ /\@/ and $to = $send;
-    for my $choice (@look) {
-      $send = $cfg->entry(@$choice, $send);
-      $send =~ /\@/ and $to = $send;
-    }
-    if ($send) {
-      $mailing = 1;
-      eval {
-       require BSE::ComposeMail;
-       if ($to) {
-         require BSE::Util::Tags;
-         my $mailer = BSE::ComposeMail->new(cfg => $cfg);
-         my %acts =
-           (
-            BSE::Util::Tags->static(undef, $cfg),
-            entry => [ \&BSE::Util::Tags::tag_object, $entry ],
-           );
-         $mailer->send(to => $to,
-                       subject => "BSE System Event",
-                       template => "admin/log/mail",
-                       acts => \%acts);
-       }
-      };
-      $mailing = 0;
-    }
-  }
+  $entry->mail($entry, $cfg);
 
   keys %opts
     and $class->crash("Unknown parameters ", join(",", keys %opts), " to log()");
@@ -272,3 +245,11 @@ sub object_log {
 }
 
 1;
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut

diff --git a/t/data/known_pod_issues.txt b/t/data/known_pod_issues.txt
index d3b6795d5b7f1d11145ba5c1666e025b8e37b299..8daff64ff6a9eca18bd9dd45d107f40ffc1360e3 100644 (file)
--- a/t/data/known_pod_issues.txt
+++ b/t/data/known_pod_issues.txt
@@ -25,7 +25,6 @@ site/cgi-bin/modules/BSE/Shop/Util.pm =item without previous =over    1
 site/cgi-bin/modules/BSE/Sort.pm       =item without previous =over    1
 site/cgi-bin/modules/BSE/Sort.pm       Verbatim paragraph in NAME section      1
 site/cgi-bin/modules/BSE/TB/ArticleFile.pm     =item without previous =over    1
-site/cgi-bin/modules/BSE/TB/AuditLog.pm        =item without previous =over    1
 site/cgi-bin/modules/BSE/TB/Files.pm   =item without previous =over    1
 site/cgi-bin/modules/BSE/TB/Images.pm  =item without previous =over    1
 site/cgi-bin/modules/BSE/TB/Order.pm   =item without previous =over    1

diff --git a/t/t000load.t b/t/t000load.t
index 77fb8832691610896e738dd37f48e41173a522a8..89922966be5f5408eb79981348e639c0e4a44871 100644 (file)
--- a/t/t000load.t
+++ b/t/t000load.t
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-use Test::More tests => 32;
+use Test::More tests => 33;
 use_ok("BSE::Cfg");
 use_ok("Squirrel::Template");
 use_ok("BSE::Template");
@@ -9,6 +9,7 @@ use_ok("DevHelp::Date");
 use_ok("DevHelp::Formatter");
 use_ok("DevHelp::HTML");
 use_ok("BSE::Variables");
+use_ok("BSE::TB::AuditLog");
 use_ok("BSE::TB::Tag");
 use_ok("BSE::TB::Tags");
 use_ok("BSE::TB::TagCategory");