site/cgi-bin/modules/BSE/ThumbLow.pm
site/cgi-bin/modules/BSE/UI/API.pm
site/cgi-bin/modules/BSE/UI/Background.pm
+site/cgi-bin/modules/BSE/UI/AdminAudit.pm
site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
site/cgi-bin/modules/BSE/UI/AdminModules.pm
site/cgi-bin/modules/BSE/UI/AdminMessages.pm
site/templates/admin/interestemail.tmpl
site/templates/admin/include/audithead.tmpl
site/templates/admin/include/auditentry.tmpl
+site/templates/admin/log/entry.tmpl
+site/templates/admin/log/log.tmpl
site/templates/admin/logon.tmpl
site/templates/admin/memberupdate/import.tmpl
site/templates/admin/memberupdate/preview.tmpl
-#!/usr/bin/perl -w
-# -d:ptkdb
+#!/usr/bin/perl -w -d:ptkdb
BEGIN { $ENV{DISPLAY} = '192.168.32.54:0.0' }
use strict;
use FindBin;
default=shop
[nadmin controllers]
-shop=BSE::UI::AdminShop
+shopadmin=BSE::UI::AdminShop
modules=BSE::UI::AdminModules
+log=BSE::UI::AdminAudit
[includes]
00install=bse-install.cfg
use DevHelp::Date qw(dh_parse_date dh_parse_sql_date);
use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
-our $VERSION = "1.002";
+our $VERSION = "1.003";
=head1 NAME
sub can_reparent_to {
my ($self, $article, $newparent, $parent_editor, $articles, $rmsg) = @_;
- $DB::single = 1;
-
my @child_types = $parent_editor->child_types;
if (!grep $_ eq ref $self, @child_types) {
my ($child_type) = (ref $self) =~ /(\w+)$/;
"&{}" => sub { my $self = $_[0]; return sub { $self->_old_msg(@_) } },
"bool" => sub { 1 };
-our $VERSION = "1.001";
+our $VERSION = "1.002";
my $single;
return $msg;
}
- $DB::single = 1;
$msgid = "bse/$self->{section}/$msgid";
my $text = $self->text(undef, $msgid, \@parms);
$text and return $text;
# automatically generated
-our $hash = "f2ae748b177e9cba9d24aa9a23f676cd";
+our $hash = "889015368dfce7d41ab585f4eb8c75da";
our %versions =
(
"BSE::Dynamic::Catalog" => "1.000",
"BSE::Dynamic::Product" => "1.000",
"BSE::Dynamic::Seminar" => "1.000",
- "BSE::Edit::Article" => "1.002",
+ "BSE::Edit::Article" => "1.003",
"BSE::Edit::Base" => "1.000",
"BSE::Edit::Catalog" => "1.001",
"BSE::Edit::Product" => "1.001",
"BSE::Mail" => "1.000",
"BSE::Mail::SMTP" => "1.000",
"BSE::Mail::Sendmail" => "1.000",
- "BSE::Message" => "1.001",
+ "BSE::Message" => "1.002",
"BSE::MessageScanner" => "1.000",
"BSE::NLFilter::SQL" => "1.000",
"BSE::NotifyFiles" => "1.000",
"BSE::Password::CryptSHA256" => "1.000",
"BSE::Password::Plain" => "1.000",
"BSE::Passwords" => "1.000",
- "BSE::PayPal" => "1.000",
+ "BSE::PayPal" => "1.001",
"BSE::Permissions" => "1.000",
"BSE::ProductImportXLS" => "1.000",
"BSE::Report" => "1.000",
"BSE::TB::AdminPerms" => "1.000",
"BSE::TB::AdminUIState" => "1.000",
"BSE::TB::AdminUIStates" => "1.000",
- "BSE::TB::AdminUser" => "1.000",
+ "BSE::TB::AdminUser" => "1.001",
"BSE::TB::AdminUsers" => "1.000",
- "BSE::TB::ArticleFile" => "1.001",
+ "BSE::TB::ArticleFile" => "1.002",
"BSE::TB::ArticleFileMeta" => "1.000",
"BSE::TB::ArticleFileMetas" => "1.000",
"BSE::TB::ArticleFiles" => "1.000",
- "BSE::TB::AuditEntry" => "1.000",
+ "BSE::TB::AuditEntry" => "1.001",
"BSE::TB::AuditLog" => "1.000",
"BSE::TB::BackgroundTask" => "1.000",
"BSE::TB::BackgroundTasks" => "1.000",
"BSE::Thumb::Imager::RandomCrop" => "1.000",
"BSE::ThumbLow" => "1.000",
"BSE::UI::API" => "1.000",
+ "BSE::UI::AdminAudit" => "1.000",
"BSE::UI::AdminDispatch" => "1.000",
"BSE::UI::AdminMessages" => "1.000",
"BSE::UI::AdminModules" => "1.001",
"OtherParents" => "1.000",
"Product" => "1.000",
"Products" => "1.000",
- "SiteUser" => "1.001",
+ "SiteUser" => "1.002",
"SiteUsers" => "1.000",
"Squirrel::GPG" => "1.000",
"Squirrel::PGP5" => "1.000",
"Squirrel::PGP6" => "1.000",
- "Squirrel::Row" => "1.000",
- "Squirrel::Table" => "1.000",
+ "Squirrel::Row" => "1.001",
+ "Squirrel::Table" => "1.001",
"Squirrel::Template" => "1.000",
"Util" => "1.000",
);
use BSE::Shop::Util qw(:payment);
use Carp qw(confess);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
use constant DEF_TEST_WS_URL => "https://api-3t.sandbox.paypal.com/nvp";
use constant DEF_TEST_REFRESH_URL => "https://www.sandbox.paypal.com/webscr";
}
my %info;
- $DB::single = 1;
if (_do_express_checkout_payment
($cfg, $rmsg, $order, scalar($req->siteuser), $token, $payerid, \%info)) {
$order->set_paypal_tran_id($info{TRANSACTIONID});
use strict;
use base qw(BSE::TB::AdminBase);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub columns {
return ($_[0]->SUPER::columns,
return BSE::Passwords->check_password_hash($self->password, $self->password_type, $password, \$error);
}
+sub link {
+ my ($self) = @_;
+
+ return BSE::Cfg->single->admin_url(adminusers => { a_showuser => 1, userid => $self->id });
+}
+
1;
@ISA = qw/Squirrel::Row/;
use Carp 'confess';
-our $VERSION = "1.001";
+our $VERSION = "1.002";
sub columns {
return qw/id articleId displayName filename sizeInBytes description
my ($self) = @_;
require BSE::TB::ArticleFileMetas;
- return map $_->{name}, BSE::TB::ArticleFileMetas->getColumnsBy
+ return BSE::TB::ArticleFileMetas->getColumnBy
(
- [ "name" ],
- file_id => $self->id,
+ "name",
+ [ file_id => $self->id ],
);
}
return BSE::TB::ArticleFileMetas->getColumnsBy
(
\@cols,
- file_id => $self->id,
+ [ file_id => $self->id ],
);
}
use strict;
use base qw(Squirrel::Row);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub columns {
return qw/id
}
}
+sub actor_link {
+ my ($self) = @_;
+
+ my $type = $self->actor_type;
+ if ($type eq "A") {
+ require BSE::TB::AdminUsers;
+ my $admin = BSE::TB::AdminUsers->getByPkey($self->actor_id);
+ if ($admin) {
+ return $admin->link;
+ }
+ else {
+ return "";
+ }
+ }
+ elsif ($type eq "M") {
+ require SiteUsers;
+ my $user = SiteUsers->getByPkey($self->actor_id);
+ if ($user) {
+ return $user->link;
+ }
+ else {
+ return "";
+ }
+ }
+ else {
+ return "";
+ }
+}
+
+my %types =
+ (
+ "BSE::TB::Order" =>
+ {
+ target => "shopadmin",
+ action => "order_detail",
+ format => "Order %d",
+ },
+ );
+
+sub object_link {
+ my ($self) = @_;
+
+ my $type = $self->object_type;
+ my $entry = $types{$type};
+ if ($entry) {
+ BSE::Cfg->single->admin_url($entry->{target},
+ { id => $self->object_id,
+ $entry->{action} => 1 });
+ }
+ else {
+ return "";
+ }
+}
+
+sub object_name {
+ my ($self) = @_;
+
+ my $type = $self->object_type;
+ my $entry = $types{$type};
+ if ($entry) {
+ return sprintf $entry->{format}, $self->object_id;
+ }
+ elsif ($type) {
+ return $type . ": " . $self->object_id;
+ }
+ else {
+ return '(None)';
+ }
+}
+
1;
--- /dev/null
+package BSE::UI::AdminAudit;
+use strict;
+use base "BSE::UI::AdminDispatch";
+use BSE::TB::AuditLog;
+use BSE::Util::Iterate;
+use BSE::Util::Tags qw(tag_object);
+
+our $VERSION = "1.000";
+
+my %actions =
+ (
+ log => "bse_log_list",
+ detail => "bse_log_detail",
+ );
+
+sub default_action { "log" }
+
+sub actions { \%actions }
+
+sub rights { \%actions }
+
+# sub _strip_arg {
+# my ($rargs, $col, $val) = @_;
+
+# return [ grep $_->{col} ne $col || $_->{val} ne $val, @$rargs ];
+# }
+
+# sub tag_addarg {
+# my ($self, $rargs, $args, $acts, $func_name, $templater) = @_;
+
+# my (@args) = DevHelp::Tags->get_parms($args, $acts, $templater);
+# my @orig_args = @args;
+# my $work = $rargs;
+# while (@args > 1) {
+# $work = _strip_arg($work, splice(@args, 0, 2));
+# }
+
+# return BSE::Cfg->single->admin_url
+# (log => { (map { $_->{col} => $_->{val} } @$work), @orig_args });
+# }
+
+# sub tag_delarg {
+# my ($self, $rargs, $args, $acts, $func_name, $templater) = @_;
+
+# my (@args) = DevHelp::Tags->get_parms($args, $acts, $templater);
+# my $work = $rargs;
+# while (@args > 1) {
+# $work = _strip_arg($work, splice(@args, 0, 2));
+# }
+
+# return BSE::Cfg->single->admin_url
+# (log => { map { $_->{col} => $_->{val} } @$work });
+# }
+
+sub req_log {
+ my ($self, $req, $errors) = @_;
+
+ my @query;
+ my @args;
+# my @cols = BSE::TB::AuditEntry->columns;
+# shift @cols;
+# my $cgi = $req->cgi;
+# for my $col (@cols) {
+# my @values = $cgi->param($col);
+# if (@values) {
+# push @query,
+# [
+# "or",
+# map [ "=", $col, $_ ], @values
+# ];
+# push @args, map +{ col => $col, val => $_ }, @values;
+# }
+# }
+
+ my @ids =
+ BSE::TB::AuditLog->getColumnBy( "id", \@query, { order => "id desc" });
+
+ $req->cache_set(auditlog => \@ids);
+
+ my $message = $req->message($errors);
+
+ my $it = BSE::Util::Iterate::Objects->new(req => $req);
+ my $h_it = BSE::Util::Iterate->new(req => $req);
+ my %recs;
+ my %acts =
+ (
+ $req->admin_tags,
+ $it->make_paged
+ (
+ single => "auditentry",
+ plural => "auditlog",
+ fetch => [ getByPkey => "BSE::TB::AuditLog" ],
+ name => "auditlog",
+ session => $req->session,
+ data => \@ids,
+ perpage_parm => "pp=50",
+ cgi => $req->cgi,
+ ),
+# addarg => [ tag_addarg => $self, \@args ],
+# delarg => [ tag_delarg => $self, \@args ],
+# $h_it->make
+# (
+# data => \@args,
+# single => "arg",
+# plural => "args",
+# ),
+ message => $message,
+ );
+
+ return $req->response("admin/log/log", \%acts);
+}
+
+sub req_detail {
+ my ($self, $req) = @_;
+
+ my %errors;
+ my $id = $req->cgi->param("id");
+ unless ($id && $id =~ /^[0-9]+$/) {
+ $errors{id} = "Missing or invalid log entry id";
+ }
+ my $entry;
+ unless (%errors) {
+ $entry = BSE::TB::AuditLog->getByPkey($id)
+ or $errors{id} = "No such log entry";
+ }
+ keys %errors
+ and return $self->req_log($req, \%errors);
+ my $nextid = '';
+ my $previd = '';
+ my $ids = $req->cache_get("auditlog");
+ if ($ids) {
+ my ($id_index) = grep $id == $ids->[$_], 0..$#$ids;
+ if (defined $id_index) {
+ $id_index > 0 and $previd = $ids->[$id_index-1];
+ $id_index < $#$ids and $nextid = $ids->[$id_index+1];
+ }
+ }
+
+ my %acts =
+ (
+ $req->admin_tags,
+ auditentry => [ \&tag_object, $entry ],
+ next_auditentry_id => $nextid,
+ prev_auditentry_id => $previd,
+ );
+
+ return $req->response("admin/log/entry", \%acts);
+}
+
+1;
use Carp qw(confess);
use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date sql_add_date_days/;
-our $VERSION = "1.001";
+our $VERSION = "1.002";
use constant MAX_UNACKED_CONF_MSGS => 3;
use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
$self->SUPER::remove();
}
+sub link {
+ my ($self) = @_;
+
+ return BSE::Cfg->single->admin_url(siteusers => { a_edit => 1, id => $self->id });
+}
+
1;
require 5.005;
use strict;
-our $VERSION = "1.000";
+our $VERSION = "1.001";
use Carp;
use BSE::DB;
&& return $_[0]->set(lcfirst $1, $_[1]);
}
confess qq/Can't locate object method "$calledName" via package "/,
- ref $_[0],'"';
+ (ref $_[0] || $_[0]),'"';
}
sub _get_bases {
package Squirrel::Table;
-our $VERSION = "1.000";
+our $VERSION = "1.001";
-use vars qw($VERSION);
use Carp;
use strict;
-$VERSION = "0.11";
-
use BSE::DB;
my %query_cache;
my $item = $rowClass->new(@$row);
$coll{$item->{pkey}} = $item;
push(@order, $item);
-
}
my $result = bless { ptr=>-1, coll=>\%coll, order=>\@order }, $class;
return $sth;
}
-sub getColumnsBy {
- my ($self, $cols, %find) = @_;
+sub _where_clause {
+ my ($self, $map, @query) = @_;
+
+ if (ref $query[0]) {
+ unshift @query, "and";
+ }
+ my ($sql, @args);
+ my $op = shift @query;
+ if ($op =~ /^(and|or)$/) {
+ my @exprs;
+ for my $sub (@query) {
+ my ($expr, @subargs) = $self->_where_clause($map, @$sub);
+ push @exprs, $expr;
+ push @args, @subargs;
+ }
+ return ("(".join(" $op ", @exprs).")", @args);
+ }
+ elsif ($op =~ /^(=|<>|>=|<=|like|not like)$/) {
+ my $dbcol = $map->{$query[0]}
+ or confess "Unknown column $query[0]";
+ return ("$dbcol $op ?", $query[1] );
+ }
+ elsif ($op =~ /^(?:not )?null$/) {
+ my $dbcol = $map->{$query[0]}
+ or confess "Unknown column $query[0]";
+ return ("$dbcol $op", () );
+ }
+ elsif ($op eq "between") {
+ my $dbcol = $map->{$query[0]}
+ or confess "Unknown column $query[0]";
+ return ("$dbcol $op ? and ?", @query[0, 1] );
+ }
+ else {
+ my $dbcol = $map->{$op}
+ or confess "Unknown column $op";
+ return ("$dbcol = ?", $query[0]);
+ }
+}
+
+sub _make_sql {
+ my ($self, $cols, $query, $options) = @_;
+
+ my $table_name = $self->rowClass->table
+ or confess "No table_name defined";
my @db_cols = $self->rowClass->db_columns;
my @code_cols = $self->rowClass->columns;
my %map;
@map{@code_cols} = @db_cols;
-
- my @conds;
+
+ my $sql = "select * from $table_name";
my @args;
- for my $col (keys %find) {
- my $db_col = $map{$col}
- or confess "Cannot generate query: unknown column $col";
- # this doesn't handle null, but that should use a "special"
- push @conds, "$db_col = ?";
- push @args, $find{$col};
+ if (@$query) {
+ ((my $where), @args) = $self->_where_clause(\%map, @$query);
+ if (length $where) {
+ $sql .= " where $where";
+ }
+ }
+ if ($options->{order}) {
+ $sql .= " order by $options->{order}";
}
- my @result_cols = map $map{$_}, @$cols;
- my $sql = "select " . join(",", @result_cols) .
- " from " . $self->rowClass->table .
- " where " . join(" and ", @conds);
+ return ($sql, @args);
+}
+
+sub getColumnsBy {
+ my ($self, $cols, $query, $opts) = @_;
+
+ my ($sql, @args) = $self->_make_sql($cols, $query, $opts);
$dh ||= BSE::DB->single;
my $sth = $dh->{dbh}->prepare($sql)
return wantarray ? @rows : \@rows;
}
+sub getColumnBy {
+ my ($self, $col, $query, $opts) = @_;
+
+ my ($sql, @args) = $self->_make_sql([ $col ], $query, $opts);
+
+ $dh ||= BSE::DB->single;
+ my $sth = $dh->{dbh}->prepare($sql)
+ or confess "Cannot prepare generated $sql: ", $dh->{dbh}->errstr;
+
+ $sth->execute(@args)
+ or confess "Cannot execute $sql: ",$dh->{dbh}->errstr;
+
+ my @rows;
+ while (my $row = $sth->fetchrow_arrayref) {
+ push @rows, $row->[0];
+ }
+
+ return wantarray ? @rows : \@rows;
+}
+
sub getSpecial {
my ($self, $name, @args) = @_;
}
#auditlog .col_when_at,
-#auditlog .col_who {
+#auditlog .col_who,
+#auditlog .col_object,
+#auditlog .col_level,
+#auditlog .col_actor,
+#auditlog .col_object {
white-space: nowrap;
}
+#auditlog .audit_crit td,
+#auditlog .audit_emerg td,
+#auditlog .audit_alert td {
+ background-color: #FFA0A0;
+}
+
+#auditlog .audit_error td {
+ background-color: #FFE0E0;
+}
+
+#auditlog a.filter,
+#auditentry a.filter {
+ padding: 0px 2px;
+ background-color: #C0FFC0;
+ text-decoration: none;
+ border: 1px dotted #080;
+}
+
+#auditlog a.unfilter {
+ padding: 0px 2px;
+ background-color: #FFC0C0;
+ text-decoration: none;
+ border: 1px dotted #800;
+}
+
+#auditentry .dump {
+ white-space: pre-wrap;
+}
+
div.pagelist {
margin: 6px 0px;
}
.pagelist a,
.pagelist span {
- padding: 2px 4px;
+ padding: 2px 5px;
text-decoration: none;
color: #000;
}
border: 1px dotted #88F;
}
-.pagelist a:hover {
- text-decoration: underline;
- /*background-color: #CCF;*/
- border: 1px solid #44f;
+.pagelist a:hover,
+.pagelist a:active,
+.pagelist a:focus {
+ /*text-decoration: underline;*/
+ background-color: #CCF;
+ border: 1px solid #444;
}
.pagelist span {
- background-color: #CCF;
- border: 1px solid #88f;
+ background-color: #606080;
+ border: 1px solid #000;
+ color: #FFF;
font-weight: bold;
-}
\ No newline at end of file
+}
--- /dev/null
+<:wrap admin/xbase.tmpl title => "Audit Entry", bodyid => "auditentry":>
+<h1>BSE Audit Log - Entry <:auditentry id:></h1>
+<p>| <a href="/admin/">Admin Menu</a>
+| <a href="<:adminurl log:>">Return to Log</a>
+ |</p>
+<:if Or [next_auditentry_id] [prev_auditentry_id]:>
+<p>| <:ifPrev_auditentry_id:><a href="<:adminurl log a_detail 1 id [prev_auditentry_id]:>">< < Previous</a> |<:or:><:eif:>
+ <:ifNext_auditentry_id:><a href="<:adminurl log a_detail 1 id [next_auditentry_id]:>">Next > ></a> |<:or:><:eif:>
+</p><:or Or:><:eif Or:>
+
+<table class="editform">
+ <tr>
+ <th>Id:</th>
+ <td><:auditentry id:></td>
+ </tr>
+ <tr>
+ <th>When:</th>
+ <td><:date "%H:%M %d/%m/%Y" auditentry when_at:></td>
+ </tr>
+ <tr>
+ <th>Facility:</th>
+ <td><:auditentry facility:></td>
+ </tr>
+ <tr>
+ <th>Component:</th>
+ <td><:auditentry component:></td>
+ </tr>
+ <tr>
+ <th>Module:</th>
+ <td><:auditentry module:></td>
+ </tr>
+ <tr>
+ <th>Function:</th>
+ <td><:auditentry function:></td>
+ </tr>
+ <tr>
+ <th>Level:</th>
+ <td><:auditentry level_name:></td>
+ </tr>
+ <tr>
+ <th>Actor:</th>
+ <td><:ifAuditentry actor_link:><a href="<:auditentry actor_link:>"><:auditentry actor_name:></a><:or:><:auditentry actor_name:><:eif:></td>
+ </tr>
+ <tr>
+ <th>Object:</th>
+ <td><:ifAuditentry object_link:><a href="<:auditentry object_link:>"><:auditentry object_name:></a><:or:><:auditentry object_name<:eif:></td>
+ </tr>
+ <tr>
+ <th>Message:</th>
+ <td><:auditentry msg:></td>
+ </tr>
+ <tr>
+ <th>IP Address:</th>
+ <td><:auditentry ip_address:></td>
+ </tr>
+ <tr>
+ <th>Dump:</th>
+ <td><span class="dump"><:auditentry dump:></span></td>
+ </tr>
+</table>
\ No newline at end of file
--- /dev/null
+<:wrap admin/xbase.tmpl title => "Audit Log", bodyid => "auditlog":>
+<h1>BSE Audit Log</h1>
+<p>| <a href="/admin/">Admin Menu</a> |</p>
+
+<div class="pagelist"><:iterator begin auditlog_pagec:>
+<:switch:>
+<:case auditentry_pagec gap:>...
+<:case auditentry_pagec link:><a href="<:adminurl log p [auditentry_pagec page]:>"><:auditentry_pagec page:></a>
+<:case default:><span><:auditentry_pagec page:></span>
+<:endswitch:>
+<:iterator end auditlog_pagec:></div>
+<table class="editform">
+ <tr>
+ <th>Id</th>
+ <th>When</th>
+ <th>Level</th>
+ <th>Who</th>
+ <th>What</th>
+ <th>Object</th>
+ <th>Message</th>
+ </tr>
+<:iterator begin auditlog:>
+<tr class="audit_<:auditentry level_name:><:ifArithmetic [auditentry_index] % 2:> odd<:or:><:eif:>">
+ <td class="col_id"><a href="<:adminurl log a_detail 1 id [auditentry id]:>"><:auditentry id:></a></td>
+ <td class="col_when_at"><:date "%H:%M %d/%m/%Y" auditentry when_at:></td>
+ <td class="col_level"><:auditentry level_name:></td>
+ <td class="col_actor"><:ifAuditentry actor_link:><a href="<:auditentry actor_link:>"><:auditentry actor_name:></a><:or:><:auditentry actor_name:><:eif:></td>
+ <td class="col_what"><:auditentry component:>/<:auditentry module:>/<:auditentry function:></td>
+ <td class="col_object"><:ifAuditentry object_link:><a href="<:auditentry object_link:>"><:auditentry object_name:></a><:or:><:auditentry object_name:><:eif:></td>
+ <td class="col_msg"><:auditentry msg:></td>
+</tr>
+<:iterator end auditlog:>
+</table>
\ No newline at end of file
<:ifParam jstools:><script type="text/javascript" src="/js/admin_tools.js"></script><:or:><:eif:>
<:ifParam js:><script type="text/javascript" src="/js/<:param js:>"></script><:or:><:eif:>
</head>
- <body>
+ <body<:ifParam bodyid:> id="<:param bodyid:>"<:or:><:eif:>>
<:ifParam showtitle:><h1><:param title:></h1><:or:><:eif:>
<:wrap here:>
<hr />
projects / bse.git / commitdiff