site/cgi-bin/modules/BSE/UI/AdminNewsletter.pm
site/cgi-bin/modules/BSE/UI/AdminPage.pm
site/cgi-bin/modules/BSE/UI/AdminPregen.pm
+site/cgi-bin/modules/BSE/UI/AdminReorder.pm
site/cgi-bin/modules/BSE/UI/AdminReport.pm
site/cgi-bin/modules/BSE/UI/AdminSeminar.pm
site/cgi-bin/modules/BSE/UI/AdminSendEmail.pm
use strict;
use FindBin;
use lib "$FindBin::Bin/../modules";
-use Articles;
+use BSE::DB;
use BSE::Request;
-use BSE::WebUtil 'refresh_to_admin';
-use vars qw($VERSION);
-$VERSION = 1.03;
+use Carp 'confess';
+use BSE::UI::AdminReorder;
-my $req = BSE::Request->new;
-my $cfg = $req->cfg;
-my $cgi = $req->cgi;
-unless ($req->check_admin_logon()) {
- refresh_to_admin($cfg, "/cgi-bin/admin/logon.pl");
- exit;
-}
-
-my $refreshto = $cgi->param('refreshto') || '/cgi-bin/admin/menu.pl';
-# each entry of @kids is an arrayref containing the article
-# to get sort data from, the actual object, and the field in the actual
-# object containing the display order value
-my @kids;
-my %kids;
-my $parentid = $cgi->param('parentid');
-if ($req->user_can(edit_reorder_children => $parentid)) {
- my $stepparent = $cgi->param('stepparent');
- my $stepchild = $cgi->param('stepchild');
- if ($parentid) {
- $parentid += 0;
- @kids = map [$_, $_, 'displayOrder' ], Articles->getBy(parentid=>$parentid);
- }
- elsif ($stepparent) {
- require 'OtherParents.pm';
-
- my $parent = Articles->getByPkey($stepparent);
- if ($parent) {
- my @otherlinks = OtherParents->getBy(parentId=>$stepparent);
- my @normalkids = Articles->children($stepparent);
- my @stepkids = $parent->stepkids;
- my %stepkids = map { $_->{id}, $_ } @stepkids;
- @kids = (
- map([ $_, $_, 'displayOrder' ], @normalkids),
- map([ $stepkids{$_->{childId}}, $_, 'parentDisplayOrder' ],
- @otherlinks),
- );
- }
- }
- elsif ($stepchild) {
- require 'OtherParents.pm';
-
- my $child = Articles->getByPkey($stepchild);
- if ($child) {
- my @otherlinks = OtherParents->getBy(childId=>$stepchild);
- my @stepparents = map Articles->getByPkey($_->{parentId}), @otherlinks;
- my %stepparents = map { $_->{id}, $_ } @stepparents;
- @kids = (
- map([ $stepparents{$_->{parentId}}, $_, 'childDisplayOrder' ],
- @otherlinks),
- );
- }
- }
-
- my $type = $cgi->param('type');
- if ($type) {
- @kids = grep $_->[0]{generator} =~ /::\Q$type\E$/, @kids;
- }
-
- my @order = sort { $b <=> $a } map $_->[1]{$_->[2]}, @kids;
- my $sort = join(",", $cgi->param('sort')) || 'current';
- $sort =~ s/-,/-/g;
- my $reverse = $cgi->param('reverse');
-
- my $code;
- if ($sort eq 'title') {
- $code = sub { lc($a->[0]{title}) cmp lc($b->[0]{title}) };
- }
- elsif ($sort eq 'date') {
- $code = sub { $a->[0]{lastModified} cmp $b->[0]{lastModified} };
- }
- elsif ($sort eq 'current') {
- $code = sub { $b->[1]{$b->[2]} <=> $a->[1]{$a->[2]} };
- }
- elsif ($sort eq 'id') {
- $code = sub { $a->[0]{id} <=> $b->[0]{id} };
- }
- elsif (@kids) {
- my @fields = split ',', $sort;
- my @reverse = grep(s/^-// || 0, @fields);
- my %reverse;
- @reverse{@fields} = @reverse;
- @fields = grep exists($kids[0][0]{$_}), @fields;
- my @num =
- my %num = map { $_ => 1 } Article->numeric;
-
- $code =
- sub {
- for my $field (@fields) {
- my $rev = $reverse{$field};
- my $cmp;
- if ($num{$field}) {
- $cmp = $a->[0]{$field} <=> $b->[0]{$field};
- }
- else {
- $cmp = lc $a->[0]{$field} cmp lc $b->[0]{$field};
- }
- $cmp = -$cmp if $rev;
- return $cmp if $cmp;
- }
- return $a->[0]{id} <=> $b->[0]{id};
- };
- }
- if ($reverse) {
- my $temp = $code;
- $code = sub { -$temp->() };
- }
- if ($code) {
- @kids = sort $code @kids;
- for my $i (0..$#kids) {
- my $kid = $kids[$i];
- $kid->[1]{$kid->[2]} = $order[$i];
- $kid->[1]->save();
- }
- }
-}
-
-refresh_to_admin($cfg, $refreshto);
-
-=head1 NAME
-
-reorder.pl - reorder the article siblings, given their parent id
-
-=head1 SYNOPSIS
-
- <html>...
- <a href="/cgi-bin/admin/reorder.pl?parentid=...&sort=...>Order</a>
- ...</html>
-
-=head1 DESCRIPTION
-
-Sorts the articles that are either the children, step children or step
-parents of a given article depending on the value of the I<sort> and
-I<reverse> parameters. Once the sort is complete a refresh is
-generated to the local url in I<refreshto>.
-
-One of the I<parentid>, I<stepparent>, or I<stepchild> parameters
-needs to be defined, otherwise no sort is performed.
-
-=over
-
-=item parentid
-
-The parentid of the articles to be sorted. This can be C<-1> to sort
-sections. If there are no articles that have this as their
-I<parentid> then zero articles are harmlessly sorted.
-
-=item stepparent
-
-the step parent is of articles to be sorted. This will sort both the
-normal children and stepchildren of the given article. This cannot be
-C<-1>.
-
-=item stepchild
-
-the step child of the articles to be sorted (currently must be a
-product). This will sort only the step parents, and will not include
-the normal parent.
+$SIG{__DIE__} = sub { confess $@ };
-=item sort
-
-The field to sort by:
-
-=over
-
-=item title
-
-Sort by the title.
-
-=item date
-
-Sort by the lastModified field. Note: since I<lastModified> is a date
-field articles modified on the same date may not sort the way you
-expect.
-
-=item current
-
-Trivial sort to the same order. This is intended to be used with
-I<reverse>.
-
-=back
-
-=item reverse
-
-If this is true then the sort is reversed.
-
-=item refreshto
-
-After the articles are sorted, a refresh is generated to I<refreshto>
-on $URLBASE.
-
-=back
-
-=head1 AUTHOR
-
-Tony Cook <tony@develop-help.com>
-
-=cut
+my $req = BSE::Request->new;
+my $result = BSE::UI::AdminReorder->dispatch($req);
+$req->output_result($result);
use BSE::CfgInfo qw(admin_base_url);
use Carp qw(confess);
-our $VERSION = "1.004";
+our $VERSION = "1.005";
# checks we're coming from HTTPS
sub check_secure {
ref $rights or $rights = [ split /,/, $rights ];
for my $right (@$rights) {
unless ($req->user_can($right, -1, \$msg)) {
- if ($req->is_ajax || $req->cgi->param("_")) {
- $$rresult = $req->json_content
- (
- success => 0,
- error_code => "ACCESS",
- message => "You do not have access to this function $msg",
- );
- }
- else {
- my $url = $req->url(menu =>
- { 'm' => 'You do not have access to this function '.$msg });
- $$rresult = $req->get_refresh($url);
- }
+ $$rresult = $class->access_error($req, $msg);
return;
}
}
return $class->SUPER::error($req, $errors, $template);
}
+sub access_error {
+ my ($self, $req, $msg) = @_;
+
+ if ($req->is_ajax || $req->cgi->param("_")) {
+ return $req->json_content
+ (
+ success => 0,
+ error_code => "ACCESS",
+ message => "You do not have access to this function $msg",
+ );
+ }
+ else {
+ my $url = $req->url(menu =>
+ { 'm' => 'You do not have access to this function '.$msg });
+ return $req->get_refresh($url);
+ }
+}
+
1;
--- /dev/null
+package BSE::UI::AdminReorder;
+use strict;
+use base 'BSE::UI::AdminDispatch';
+use Articles;
+use OtherParents;
+
+our $VERSION = "1.000";
+
+=head1 NAME
+
+BSE::TB::AdminReorder - sort articles
+
+=head1 SYNOPSIS
+
+ /cgi-bin/reorder.pl?...
+
+=head1 DESCRIPTION
+
+Provides targets to sort child, allkids or stepparents.
+
+Each target takes a sort specification in C<sort> and a reverse flag
+in C<reverse>.
+
+The sort spec can be any of:
+
+=over
+
+=item *
+
+any one of the keywords C<title>, C<date>, C<current>, C<id> which
+sort on title, last modification date, current sort order (as modified
+by the reverse flag), or article id. Default: C<current>.
+
+=item *
+
+a comma separated list of article field names, with optional reverse
+flags. eg. C<author,-title> to sort by author ascending, title
+descending.
+
+=back
+
+If the reverse flag is true the sort order is reversed.
+
+Each target accepts a C<refreshto> parameter, falling back to the C<r>
+parameter to refresh to after sorting. If neither is provided
+refreshes to the admin menu.
+
+=head1 TARGETS
+
+=over
+
+=cut
+
+my %actions =
+ (
+ byparent => 1,
+ bystepparent => 1,
+ bystepchild => 1,
+ error => 1,
+ );
+
+sub actions { \%actions }
+
+sub rights { +{} }
+
+sub default_action { "error" }
+
+my %field_map =
+ (
+ parentid => 'byparent',
+ stepparent => 'bystepparent',
+ stepchild => 'bystepchild',
+ );
+
+sub other_action {
+ my ($self, $cgi) = @_;
+
+ for my $key (sort keys %field_map) {
+ my ($value) = $cgi->param($key);
+ if ($value) {
+ return ( $field_map{$key}, $value );
+ }
+ }
+
+ return;
+}
+
+=item byparent
+
+Sort direct children of an article.
+
+Selected if the C<parentid> parameter is present, which must be the id
+of the parent article to sort the children by.
+
+C<parentid> may be C<-1>.
+
+Under Ajax, returns JSON like:
+
+ {
+ success: 1,
+ kids: [ kidid, kidid ... ]
+ }
+
+Requires C<bse_edit_reorder_children> access on the given parent id.
+
+=cut
+
+sub req_byparent {
+ my ($self, $req, $parentid) = @_;
+
+ my $msg;
+ $req->user_can(bse_edit_reorder_children => $parentid)
+ or return $self->access_error($req, $msg);
+
+ my ($kids, $order) = $self->_limit_and_sort
+ (
+ $req,
+ [
+ map [ $_, $_, 'displayOrder' ], Articles->getBy(parentid => $parentid)
+ ]
+ );
+
+ if ($req->is_ajax) {
+ return $req->json_content
+ (
+ success => 1,
+ kids => [ map $_->id, @$kids ],
+ );
+ }
+
+ $req->flash_notice("msg:bse/admin/reorder/byparent", [ $parentid, $order ]);
+
+ my $cgi = $req->cgi;
+ my $r = $cgi->param('refreshto') || $cgi->param('r')
+ || $req->cfg->admin_url("menu");
+
+ return $req->get_refresh($r);
+}
+
+=item bystepparent
+
+Sort all kids of an article.
+
+Selected if the C<stepparent> parameter is present, which must be the
+id of the parent article to sort the children by.
+
+C<stepparent> may B<not> be C<-1>.
+
+Under Ajax, returns JSON like:
+
+ {
+ success: 1,
+ kids: [ kidid, kidid ... ]
+ }
+
+Requires C<bse_edit_reorder_children> access on the given parent id.
+
+=cut
+
+sub req_bystepparent {
+ my ($self, $req, $stepparent) = @_;
+
+ my $msg;
+ $req->user_can(bse_edit_reorder_children => $stepparent)
+ or return $self->access_error($req, $msg);
+
+ my $parent = Articles->getByPkey($stepparent)
+ or return $self->error($req, "Unknown article $stepparent");
+
+ my @otherlinks = OtherParents->getBy(parentId => $stepparent);
+ my @normalkids = Articles->children($stepparent);
+ my @stepkids = $parent->stepkids;
+ my %stepkids = map { $_->{id}, $_ } @stepkids;
+ my @kids =
+
+ my ($kids, $order) = $self->_limit_and_sort
+ (
+ $req,
+ [
+ map([ $_, $_, 'displayOrder' ], @normalkids),
+ map([ $stepkids{$_->{childId}}, $_, 'parentDisplayOrder' ],
+ @otherlinks),
+ ]
+ );
+
+ if ($req->is_ajax) {
+ return $req->json_content
+ (
+ success => 1,
+ kids => [ map $_->id, @$kids ],
+ );
+ }
+
+ $req->flash_notice("msg:bse/admin/reorder/bystepparent", [ $stepparent, $order ]);
+
+ my $cgi = $req->cgi;
+ my $r = $cgi->param('refreshto') || $cgi->param('r')
+ || $req->cfg->admin_url("menu");
+
+ return $req->get_refresh($r);
+}
+
+=item bystepchild
+
+Sort step parents of an article.
+
+Selected if the C<stepchild> parameter is true, which must be the id
+of the child article to sort the step parents of.
+
+C<stepchild> may B<not> be C<-1>.
+
+Under Ajax, returns JSON like:
+
+ {
+ success: 1,
+ parents: [ parentid, parentid ... ]
+ }
+
+Requires C<bse_edit_reorder_children> access on the given step child id.
+
+=cut
+
+sub req_bystepchild {
+ my ($self, $req, $stepchild) = @_;
+
+ my $msg;
+ $req->user_can(bse_edit_reorder_children => $stepchild)
+ or return $self->access_error($req, $msg);
+
+ my $child = Articles->getByPkey($stepchild)
+ or return $self->error($req, "Unknown child $stepchild");
+
+ my @otherlinks = OtherParents->getBy(childId=>$stepchild);
+ my @stepparents = map Articles->getByPkey($_->{parentId}), @otherlinks;
+ my %stepparents = map { $_->{id}, $_ } @stepparents;
+
+
+ my ($parents, $order) = $self->_limit_and_sort
+ (
+ $req,
+ [
+ map([ $stepparents{$_->{parentId}}, $_, 'childDisplayOrder' ],
+ @otherlinks),
+ ]
+ );
+
+ if ($req->is_ajax) {
+ return $req->json_content
+ (
+ success => 1,
+ parents => [ map $_->id, @$parents ],
+ );
+ }
+
+ $req->flash_notice("msg:bse/admin/reorder/bystepchild", [ $stepchild, $order ]);
+
+ my $cgi = $req->cgi;
+ my $r = $cgi->param('refreshto') || $cgi->param('r')
+ || $req->cfg->admin_url("menu");
+
+ return $req->get_refresh($r);
+}
+
+sub _limit_and_sort {
+ my ($self, $req, $kids) = @_;
+
+ my $cgi = $req->cgi;
+ my $type = $cgi->param("type");
+ if ($type) {
+ $kids = [ grep $_->[0]{generator} =~ /::\Q$type\E$/, @$kids ];
+ }
+
+ my @order = sort { $b <=> $a } map $_->[1]{$_->[2]}, @$kids;
+ my $sort = join(",", $cgi->param('sort')) || 'current';
+ $sort =~ s/-,/-/g;
+ my $reverse = $cgi->param('reverse');
+
+ my $code;
+ my $order = $sort;
+ if ($sort eq 'title') {
+ $code = sub { lc($a->[0]{title}) cmp lc($b->[0]{title}) };
+ }
+ elsif ($sort eq 'date') {
+ $code = sub { $a->[0]{lastModified} cmp $b->[0]{lastModified} };
+ }
+ elsif ($sort eq 'current') {
+ $code = sub { $b->[1]{$b->[2]} <=> $a->[1]{$a->[2]} };
+ $order = '';
+ }
+ elsif ($sort eq 'id') {
+ $code = sub { $a->[0]{id} <=> $b->[0]{id} };
+ }
+ elsif (@$kids) {
+ my @fields = split ',', $sort;
+ my @reverse = grep(s/^-// || 0, @fields);
+ my %reverse;
+ @reverse{@fields} = @reverse;
+ @fields = grep exists($kids->[0][0]{$_}), @fields;
+ my @num =
+ my %num = map { $_ => 1 } Article->numeric;
+
+ $code =
+ sub {
+ for my $field (@fields) {
+ my $rev = $reverse{$field};
+ my $cmp;
+ if ($num{$field}) {
+ $cmp = $a->[0]{$field} <=> $b->[0]{$field};
+ }
+ else {
+ $cmp = lc $a->[0]{$field} cmp lc $b->[0]{$field};
+ }
+ $cmp = -$cmp if $rev;
+ return $cmp if $cmp;
+ }
+ return $a->[0]{id} <=> $b->[0]{id};
+ };
+ }
+ if ($reverse) {
+ my $temp = $code;
+ $code = sub { -$temp->() };
+ $order .= $order ? ", reversed" : "reverse";
+ }
+ if ($code) {
+ $kids = [ sort $code @$kids ];
+ for my $i (0..$#$kids) {
+ my $kid = $kids->[$i];
+ $kid->[1]{$kid->[2]} = $order[$i];
+ $kid->[1]->save();
+ }
+ }
+ return [ map $_->[0], @$kids ], $order;
+}
+
+sub req_error {
+ my ($self, $req) = @_;
+
+ if ($req->is_ajax) {
+ return
+ {
+ headers => [ "Status: 404" ]
+ };
+ }
+
+ return $self->error($req, "Can't figure out what you want to do");
+}
+
+1;
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
id: bse/admin/generic/accessdenied
description: Displayed when the user doesn't have access due to permissions (%1 - required access)
+id: bse/admin/reorder/
+description: Produced by reorder.pl
+
+id: bse/admin/reorder/byparent
+description: Flashed after sorting by parent (%1 - parent id, %2 sort order)
+
+id: bse/admin/reorder/bystepparent
+description: Flashed after sorting by step parent (%1 - parent id, %2 sort order)
+
+id: bse/admin/reorder/bystepchild
+description: Flashed after sorting by step child (%1 - child id, %2 sort order)
+
id: bse/admin/user/
description: Admin user administration messages
id: bse/admin/message/badmultiline
message: Message %1:s may contain only a single line of text
+id: bse/admin/reorder/byparent
+message: Sorted children of article %1:d by %2:s
+
+id: bse/admin/reorder/bystepparent
+message: Sorted all children of article %1:d by %2:s
+
+id: bse/admin/reorder/bystepchild
+message: Sorted step parents of article %1:d by %2:s
+
id: bse/admin/shop/saveorder/saved
message: Order saved successfully
#!perl -w
use strict;
use Test::More tests => 62;
-use BSE::Test qw(make_ua fetch_ok base_url config);
+use BSE::Test qw(make_ua fetch_ok base_url base_securl config);
++$|;
my $baseurl = base_url;
ok($baseurl =~ /^http:/, "basic check of base url");
+my $securl = base_securl;
my $ua = make_ua;
fetch_ok($ua, "admin menu - check the site exists at all", "$baseurl/admin/", "Admin");
fetch_ok($ua, "generate all", "$baseurl/cgi-bin/admin/generate.pl",
qr!sidebar\s+subsection!i);
fetch_ok($ua, "printable error", "$baseurl/cgi-bin/printable.pl?id=5&template=foo",
qr!Invalid\s+template\s+name!i);
-fetch_ok($ua, "siteusers", "$baseurl/cgi-bin/admin/siteusers.pl",
+fetch_ok($ua, "siteusers", "$securl/cgi-bin/admin/siteusers.pl",
qr!Admin Site Members!i);
-fetch_ok($ua, "reorder", "$baseurl/cgi-bin/admin/reorder.pl",
+fetch_ok($ua, "reorder", "$securl/cgi-bin/admin/reorder.pl?parentid=-1",
"html", "Title: BSE - Administration Centre");
fetch_ok($ua, 'fmail', "$baseurl/cgi-bin/fmail.pl",
projects / bse.git / commitdiff