modernize, fix and better document reorder.pl
authorTony Cook <tony@develop-help.com>
Mon, 29 Apr 2013 09:37:02 +0000 (19:37 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 29 Apr 2013 10:00:00 +0000 (20:00 +1000)
MANIFEST
site/cgi-bin/admin/reorder.pl
site/cgi-bin/modules/BSE/UI/AdminDispatch.pm
site/cgi-bin/modules/BSE/UI/AdminReorder.pm [new file with mode: 0644]
site/data/db/bse_msg_base.data
site/data/db/bse_msg_defaults.data
t/t00smoke.t

index 6155492..f843409 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -253,6 +253,7 @@ site/cgi-bin/modules/BSE/UI/AdminModules.pm
 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
index ad01863..ab05643 100755 (executable)
 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=...&amp;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);
index 8089f86..2d8642e 100644 (file)
@@ -4,7 +4,7 @@ use base qw(BSE::UI::Dispatch);
 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 {
@@ -85,19 +85,7 @@ sub check_action {
   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;
     }
   }
@@ -113,4 +101,22 @@ sub error {
   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;
diff --git a/site/cgi-bin/modules/BSE/UI/AdminReorder.pm b/site/cgi-bin/modules/BSE/UI/AdminReorder.pm
new file mode 100644 (file)
index 0000000..7b62f69
--- /dev/null
@@ -0,0 +1,356 @@
+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
index d5d807b..1873020 100644 (file)
@@ -176,6 +176,18 @@ description: General messages
 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
 
index e0e51a7..d4ae6b6 100644 (file)
@@ -136,6 +136,15 @@ message: Unknown language code - no entry found in [languages]
 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
 
index 08d815a..2df4c02 100644 (file)
@@ -1,11 +1,12 @@
 #!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",
@@ -62,10 +63,10 @@ fetch_ok($ua, "printable", "$baseurl/cgi-bin/printable.pl?id=5",
         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",