site/cgi-bin/modules/BSE/Edit/Article.pm

   1 package BSE::Edit::Article;
   2 use strict;
   3 use base qw(BSE::Edit::Base);
   4 use BSE::Util::Tags qw(tag_error_img);
   5 use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
   6 use BSE::Util::Valid qw/valid_date/;
   7 use BSE::Permissions;
   8 use DevHelp::HTML qw(:default popup_menu);
   9 use BSE::Arrows;
  10 use BSE::CfgInfo qw(custom_class admin_base_url);
  11
  12 sub article_dispatch {
  13   my ($self, $req, $article, $articles) = @_;
  14
  15   BSE::Permissions->check_logon($req)
  16     or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
  17
  18   my $cgi = $req->cgi;
  19   my $action;
  20   my %actions = $self->article_actions;
  21   for my $check (keys %actions) {
  22     if ($cgi->param($check) || $cgi->param("$check.x")) {
  23       $action = $check;
  24       last;
  25     }
  26   }
  27   my @extraargs;
  28   unless ($action) {
  29     ($action, @extraargs) = $self->other_article_actions($cgi);
  30   }
  31   $action ||= 'edit';
  32   my $method = $actions{$action};
  33   return $self->$method($req, $article, $articles, @extraargs);
  34 }
  35
  36 sub noarticle_dispatch {
  37   my ($self, $req, $articles) = @_;
  38
  39   BSE::Permissions->check_logon($req)
  40     or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
  41
  42   my $cgi = $req->cgi;
  43   my $action = 'add';
  44   my %actions = $self->noarticle_actions;
  45   for my $check (keys %actions) {
  46     if ($cgi->param($check) || $cgi->param("$check.x")) {
  47       $action = $check;
  48       last;
  49     }
  50   }
  51   my $method = $actions{$action};
  52   return $self->$method($req, $articles);
  53 }
  54
  55 sub article_actions {
  56   my ($self) = @_;
  57
  58   return
  59     (
  60      edit => 'edit_form',
  61      save => 'save',
  62      add_stepkid => 'add_stepkid',
  63      del_stepkid => 'del_stepkid',
  64      save_stepkids => 'save_stepkids',
  65      add_stepparent => 'add_stepparent',
  66      del_stepparent => 'del_stepparent',
  67      save_stepparents => 'save_stepparents',
  68      artimg => 'save_image_changes',
  69      addimg => 'add_image',
  70      remove => 'remove',
  71      showimages => 'show_images',
  72      process => 'save_image_changes',
  73      removeimg => 'remove_img',
  74      moveimgup => 'move_img_up',
  75      moveimgdown => 'move_img_down',
  76      filelist => 'filelist',
  77      fileadd => 'fileadd',
  78      fileswap => 'fileswap',
  79      filedel => 'filedel',
  80      filesave => 'filesave',
  81      hide => 'hide',
  82      unhide => 'unhide',
  83     );
  84 }
  85
  86 sub other_article_actions {
  87   my ($self, $cgi) = @_;
  88
  89   for my $param ($cgi->param) {
  90     if ($param =~ /^removeimg_(\d+)(\.x)?$/) {
  91       return ('removeimg', $1 );
  92     }
  93   }
  94
  95   return;
  96 }
  97
  98 sub noarticle_actions {
  99   return
 100     (
 101      add => 'add_form',
 102      save => 'save_new',
 103     );
 104 }
 105
 106 sub get_parent {
 107   my ($self, $parentid, $articles) = @_;
 108
 109   if ($parentid == -1) {
 110     return
 111       {
 112        id => -1,
 113        title=>'All Sections',
 114        level => 0,
 115        listed => 0,
 116        parentid => undef,
 117       };
 118   }
 119   else {
 120     return $articles->getByPkey($parentid);
 121   }
 122 }
 123
 124 sub tag_hash {
 125   my ($object, $args) = @_;
 126
 127   my $value = $object->{$args};
 128   defined $value or $value = '';
 129   if ($value =~ /\cJ/ && $value =~ /\cM/) {
 130     $value =~ tr/\cM//d;
 131   }
 132   escape_html($value);
 133 }
 134
 135 sub tag_hash_mbcs {
 136   my ($object, $args) = @_;
 137
 138   my $value = $object->{$args};
 139   defined $value or $value = '';
 140   if ($value =~ /\cJ/ && $value =~ /\cM/) {
 141     $value =~ tr/\cM//d;
 142   }
 143   escape_html($value, '<>&"');
 144 }
 145
 146 sub tag_art_type {
 147   my ($level, $cfg) = @_;
 148
 149   escape_html($cfg->entry('level names', $level, 'Article'));
 150 }
 151
 152 sub tag_if_new {
 153   my ($article) = @_;
 154
 155   !$article->{id};
 156 }
 157
 158 sub reparent_updown {
 159   return 1;
 160 }
 161
 162 sub should_be_catalog {
 163   my ($self, $article, $parent, $articles) = @_;
 164
 165   if ($article->{parentid} && (!$parent || $parent->{id} != $article->{parentid})) {
 166     $parent = $articles->getByPkey($article->{id});
 167   }
 168
 169   my $shopid = $self->{cfg}->entryErr('articles', 'shop');
 170
 171   return $article->{parentid} && $parent &&
 172     ($article->{parentid} == $shopid ||
 173      $parent->{generator} eq 'Generate::Catalog');
 174 }
 175
 176 sub possible_parents {
 177   my ($self, $article, $articles, $req) = @_;
 178
 179   my %labels;
 180   my @values;
 181
 182   my $shopid = $self->{cfg}->entryErr('articles', 'shop');
 183   my @parents = $articles->getBy('level', $article->{level}-1);
 184   @parents = grep { $_->{generator} eq 'Generate::Article'
 185                       && $_->{id} != $shopid } @parents;
 186
 187   # user can only select parent they can add to
 188   @parents = grep $req->user_can('edit_add_child', $_), @parents;
 189
 190   @values = ( map {$_->{id}} @parents );
 191   %labels = ( map { $_->{id} => "$_->{title} ($_->{id})" } @parents );
 192
 193   if ($article->{level} == 1 && $req->user_can('edit_add_child')) {
 194     push @values, -1;
 195     $labels{-1} = "No parent - this is a section";
 196   }
 197
 198   if ($article->{id} && $self->reparent_updown($article)) {
 199     # we also list the siblings and grandparent (if any)
 200     my @siblings = grep $_->{id} != $article->{id} && $_->{id} != $shopid,
 201     $articles->getBy(parentid => $article->{parentid});
 202     @siblings = grep $req->user_can('edit_add_child', $_), @siblings;
 203     push @values, map $_->{id}, @siblings;
 204     @labels{map $_->{id}, @siblings} =
 205       map { "-- move down a level -- $_->{title} ($_->{id})" } @siblings;
 206
 207     if ($article->{parentid} != -1) {
 208       my $parent = $articles->getByPkey($article->{parentid});
 209       if ($parent->{parentid} != -1) {
 210         my $gparent = $articles->getByPkey($parent->{parentid});
 211         if ($req->user_can('edit_add_child', $gparent)) {
 212           push @values, $gparent->{id};
 213           $labels{$gparent->{id}} =
 214             "-- move up a level -- $gparent->{title} ($gparent->{id})";
 215         }
 216       }
 217       else {
 218         if ($req->user_can('edit_add_child')) {
 219           push @values, -1;
 220           $labels{-1} = "-- move up a level -- become a section";
 221         }
 222       }
 223     }
 224   }
 225
 226   return (\@values, \%labels);
 227 }
 228
 229 sub tag_list {
 230   my ($self, $article, $articles, $cgi, $req, $what) = @_;
 231
 232   if ($what eq 'listed') {
 233     my @values = qw(0 1);
 234     my %labels = ( 0=>"No", 1=>"Yes");
 235     if ($article->{level} <= 2) {
 236       $labels{2} = "In Sections, but not menu";
 237       push(@values, 2);
 238     }
 239     else {
 240       $labels{2} = "In content, but not menus";
 241       push(@values, 2);
 242     }
 243     return popup_menu(-name=>'listed',
 244                       -values=>\@values,
 245                       -labels=>\%labels,
 246                       -default=>$article->{listed});
 247   }
 248   else {
 249     my ($values, $labels) = $self->possible_parents($article, $articles, $req);
 250     my $html;
 251     if (defined $article->{parentid}) {
 252       $html = popup_menu(-name=>'parentid',
 253                          -values=> $values,
 254                          -labels => $labels,
 255                          -default => $article->{parentid},
 256                          -override=>1);
 257     }
 258     else {
 259       $html = popup_menu(-name=>'parentid',
 260                          -values=> $values,
 261                          -labels => $labels,
 262                          -override=>1);
 263     }
 264
 265     # munge the html - we display a default value, so we need to wrap the
 266     # default <select /> around this one
 267     $html =~ s!^<select[^>]+>|</select>!!gi;
 268     return $html;
 269   }
 270 }
 271
 272 sub tag_checked {
 273   my ($arg, $acts, $funcname, $templater) = @_;
 274   my ($func, $args) = split ' ', $arg, 2;
 275   return $templater->perform($acts, $func, $args) ? 'checked' : '';
 276 }
 277
 278 sub iter_get_images {
 279   my ($self, $article) = @_;
 280
 281   $article->{id} or return;
 282   $self->get_images($article);
 283 }
 284
 285 sub iter_get_kids {
 286   my ($article, $articles) = @_;
 287
 288   my @children;
 289   $article->{id} or return;
 290   if (UNIVERSAL::isa($article, 'Article')) {
 291     @children = $article->children;
 292   }
 293   elsif ($article->{id}) {
 294     @children = $articles->children($article->{id});
 295   }
 296
 297   return sort { $b->{displayOrder} <=> $a->{displayOrder} } @children;
 298 }
 299
 300 sub tag_if_have_child_type {
 301   my ($level, $cfg) = @_;
 302
 303   defined $cfg->entry("level names", $level+1);
 304 }
 305
 306 sub tag_is {
 307   my ($args, $acts, $isname, $templater) = @_;
 308
 309   my ($func, $funcargs) = split ' ', $args, 2;
 310   return $templater->perform($acts, $func, $funcargs) ? 'Yes' : 'No';
 311 }
 312
 313 sub default_template {
 314   my ($self, $article, $cfg, $templates) = @_;
 315
 316   if ($article->{parentid}) {
 317     my $template = $cfg->entry("children of $article->{parentid}", "template");
 318     return $template
 319       if $template && grep $_ eq $template, @$templates;
 320   }
 321   if ($article->{level}) {
 322     my $template = $cfg->entry("level $article->{level}", "template");
 323     return $template
 324       if $template && grep $_ eq $template, @$templates;
 325   }
 326   return $templates->[0];
 327 }
 328
 329 sub tag_templates {
 330   my ($self, $article, $cfg, $cgi) = @_;
 331
 332   my @templates = sort $self->templates($article);
 333   my $default;
 334   if ($article->{template} && grep $_ eq $article->{template}, @templates) {
 335     $default = $article->{template};
 336   }
 337   else {
 338     my @options;
 339     $default = $self->default_template($article, $cfg, \@templates);
 340   }
 341   return popup_menu(-name=>'template',
 342                     -values=>\@templates,
 343                     -default=>$default,
 344                     -override=>1);
 345 }
 346
 347 sub title_images {
 348   my ($self, $article) = @_;
 349
 350   my @title_images;
 351   my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
 352   if (opendir TITLE_IMAGES, "$imagedir/titles") {
 353     @title_images = sort
 354       grep -f "$imagedir/titles/$_" && /\.(gif|jpeg|jpg|png)$/i,
 355       readdir TITLE_IMAGES;
 356     closedir TITLE_IMAGES;
 357   }
 358
 359   @title_images;
 360 }
 361
 362 sub tag_title_images  {
 363   my ($self, $article, $cfg, $cgi) = @_;
 364
 365   my @images = $self->title_images($article);
 366   my @values = ( '', @images );
 367   my %labels = ( '' => 'None', map { $_ => $_ } @images );
 368   return $cgi->
 369     popup_menu(-name=>'titleImage',
 370                -values=>\@values,
 371                -labels=>\%labels,
 372                -default=>$article->{id} ? $article->{titleImage} : '',
 373                -override=>1);
 374 }
 375
 376 sub base_template_dirs {
 377   return ( "common" );
 378 }
 379
 380 sub template_dirs {
 381   my ($self, $article) = @_;
 382
 383   my @dirs = $self->base_template_dirs;
 384   if (my $parentid = $article->{parentid}) {
 385     my $section = "children of $parentid";
 386     if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
 387       push @dirs, split /,/, $dirs;
 388     }
 389   }
 390   if (my $id = $article->{id}) {
 391     my $section = "article $id";
 392     if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
 393       push @dirs, split /,/, $dirs;
 394     }
 395   }
 396   if ($article->{level}) {
 397     push @dirs, $article->{level};
 398     my $dirs = $self->{cfg}->entry("level $article->{level}", 'template_dirs');
 399     push @dirs, split /,/, $dirs if $dirs;
 400   }
 401
 402   @dirs;
 403 }
 404
 405 sub templates {
 406   my ($self, $article) = @_;
 407
 408   my @dirs = $self->template_dirs($article);
 409   my @templates;
 410   my @basedirs = BSE::Template->template_dirs($self->{cfg});
 411   for my $basedir (@basedirs) {
 412     for my $dir (@dirs) {
 413       my $path = File::Spec->catdir($basedir, $dir);
 414       if (-d $path) {
 415         if (opendir TEMPLATE_DIR, $path) {
 416           push(@templates, sort map "$dir/$_",
 417                grep -f "$path/$_" && /\.(tmpl|html)$/i, readdir TEMPLATE_DIR);
 418           closedir TEMPLATE_DIR;
 419         }
 420       }
 421     }
 422   }
 423
 424   # eliminate any dups, and order it nicely
 425   my %seen;
 426   @templates = sort { lc($a) cmp lc($b) }
 427     grep !$seen{$_}++, @templates;
 428
 429   return (@templates, $self->extra_templates($article));
 430 }
 431
 432 sub extra_templates {
 433   my ($self, $article) = @_;
 434
 435   my $basedir = $self->{cfg}->entryVar('paths', 'templates');
 436   my @templates;
 437   if (my $id = $article->{id}) {
 438     push @templates, 'index.tmpl'
 439       if $id == 1 && -f "$basedir/index.html";
 440     push @templates, 'index2.tmpl'
 441       if $id == 2 && -f "$basedir/index2.html";
 442     my $shopid = $self->{cfg}->entryErr('articles', 'shop');
 443     push @templates, "shop_sect.tmpl"
 444       if $id == $shopid && -f "$basedir/shop_sect.tmpl";
 445     my $section = "article $id";
 446     my $extras = $self->{cfg}->entry($section, 'extra_templates');
 447     push @templates, grep /\.(tmpl|html)$/i, split /,/, $extras
 448       if $extras;
 449   }
 450
 451   @templates;
 452 }
 453
 454 sub edit_parent {
 455   my ($article) = @_;
 456
 457   return '' unless $article->{id} && $article->{id} != -1;
 458   return <<HTML;
 459 <a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
 460 HTML
 461 }
 462
 463 sub iter_allkids {
 464   my ($article) = @_;
 465
 466   return unless $article->{id} && $article->{id} > 0;
 467   $article->allkids;
 468 }
 469
 470 sub _load_step_kids {
 471   my ($article, $step_kids) = @_;
 472
 473   my @stepkids = OtherParents->getBy(parentId=>$article->{id}) if $article->{id};
 474   %$step_kids = map { $_->{childId} => $_ } @stepkids;
 475   $step_kids->{loaded} = 1;
 476 }
 477
 478 sub tag_if_step_kid {
 479   my ($article, $allkids, $rallkid_index, $step_kids) = @_;
 480
 481   _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
 482
 483   my $kid = $allkids->[$$rallkid_index]
 484     or return;
 485   exists $step_kids->{$kid->{id}};
 486 }
 487
 488 sub tag_step_kid {
 489   my ($article, $allkids, $rallkid_index, $step_kids, $arg) = @_;
 490
 491   _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
 492
 493   my $kid = $allkids->[$$rallkid_index]
 494     or return '';
 495   my $step_kid = $step_kids->{$kid->{id}}
 496     or return '';
 497   #use Data::Dumper;
 498   #print STDERR "found kid (want $arg): ", Dumper($kid), Dumper($step_kid);
 499   escape_html($step_kid->{$arg});
 500 }
 501
 502 sub tag_move_stepkid {
 503   my ($self, $cgi, $req, $article, $allkids, $rallkids_index, $arg,
 504       $acts, $funcname, $templater) = @_;
 505
 506   $req->user_can(edit_reorder_children => $article)
 507     or return '';
 508
 509   @$allkids > 1 or return '';
 510
 511   my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
 512   $img_prefix = '' unless defined $img_prefix;
 513   $urladd = '' unless defined $urladd;
 514
 515   my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
 516   my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
 517   if ($cgi->param('_t')) {
 518     $url .= "&_t=".$cgi->param('_t');
 519   }
 520   $url .= $urladd;
 521   $url .= "#step";
 522   my $down_url = '';
 523   if ($$rallkids_index < $#$allkids) {
 524     $down_url = "$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index+1]{id}";
 525   }
 526   my $up_url = '';
 527   if ($$rallkids_index > 0) {
 528     $up_url = "$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index-1]{id}";
 529   }
 530
 531   return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
 532 }
 533
 534 sub possible_stepkids {
 535   my ($req, $article, $articles, $stepkids) = @_;
 536
 537   $req->user_can(edit_stepkid_add => $article)
 538     or return;
 539
 540   my @possible = sort { lc $a->{title} cmp lc $b->{title} }
 541     grep !$stepkids->{$_->{id}} && $_->{id} != $article->{id}, $articles->all;
 542   if ($req->access_control) {
 543     @possible = grep $req->user_can(edit_stepparent_add => $_), @possible;
 544   }
 545   return @possible;
 546 }
 547
 548 sub tag_possible_stepkids {
 549   my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
 550
 551   _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
 552   @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
 553     unless @$possstepkids;
 554   my %labels = map { $_->{id} => "$_->{title} ($_->{id})" } @$possstepkids;
 555   return
 556     popup_menu(-name=>'stepkid',
 557                -values=> [ map $_->{id}, @$possstepkids ],
 558                -labels => \%labels);
 559 }
 560
 561 sub tag_if_possible_stepkids {
 562   my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
 563
 564   _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
 565   @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
 566     unless @$possstepkids;
 567
 568   @$possstepkids;
 569 }
 570
 571 sub iter_get_stepparents {
 572   my ($article) = @_;
 573
 574   return unless $article->{id} && $article->{id} > 0;
 575
 576   OtherParents->getBy(childId=>$article->{id});
 577 }
 578
 579 sub tag_ifStepParents {
 580   my ($args, $acts, $funcname, $templater) = @_;
 581
 582   return $templater->perform($acts, 'ifStepparents', '');
 583 }
 584
 585 sub tag_stepparent_targ {
 586   my ($article, $targs, $rindex, $arg) = @_;
 587
 588   if ($article->{id} && $article->{id} > 0 && !@$targs) {
 589     @$targs = $article->step_parents;
 590   }
 591   escape_html($targs->[$$rindex]{$arg});
 592 }
 593
 594 sub tag_move_stepparent {
 595   my ($self, $cgi, $req, $article, $stepparents, $rindex, $arg,
 596       $acts, $funcname, $templater) = @_;
 597
 598   $req->user_can(edit_reorder_stepparents => $article)
 599     or return '';
 600
 601   @$stepparents > 1 or return '';
 602
 603   my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
 604   $img_prefix = '' unless defined $img_prefix;
 605   $urladd = '' unless defined $urladd;
 606
 607   my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
 608   my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
 609   my $html = '';
 610   my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
 611   if ($cgi->param('_t')) {
 612     $url .= "&_t=".$cgi->param('_t');
 613   }
 614   $url .= $urladd;
 615   $url .= "#stepparents";
 616   my $blank = qq!<img src="$images_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />!;
 617   my $down_url = '';
 618   if ($$rindex < $#$stepparents) {
 619     $down_url = "$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex+1]{parentId}";
 620   }
 621   my $up_url = '';
 622   if ($$rindex > 0) {
 623     $up_url = "$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex-1]{parentId}";
 624   }
 625
 626   return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
 627 }
 628
 629 sub _stepparent_possibles {
 630   my ($req, $article, $articles, $targs) = @_;
 631
 632   $req->user_can(edit_stepparent_add => $article)
 633     or return;
 634
 635   @$targs = $article->step_parents unless @$targs;
 636   my %targs = map { $_->{id}, 1 } @$targs;
 637   my @possibles = grep !$targs{$_->{id}} && $_->{id} != $article->{id},
 638     $articles->all;
 639   if ($req->access_control) {
 640     @possibles = grep $req->user_can(edit_stepkid_add => $_), @possibles;
 641   }
 642   @possibles = sort { lc $a->{title} cmp lc $b->{title} } @possibles;
 643
 644   return @possibles;
 645 }
 646
 647 sub tag_if_stepparent_possibles {
 648   my ($req, $article, $articles, $targs, $possibles) = @_;
 649
 650   if ($article->{id} && $article->{id} > 0 && !@$possibles) {
 651     @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
 652   }
 653   scalar @$possibles;
 654 }
 655
 656 sub tag_stepparent_possibles {
 657   my ($cgi, $req, $article, $articles, $targs, $possibles) = @_;
 658
 659   if ($article->{id} && $article->{id} > 0 && !@$possibles) {
 660     @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
 661   }
 662   popup_menu(-name=>'stepparent',
 663              -values => [ map $_->{id}, @$possibles ],
 664              -labels => { map { $_->{id}, "$_->{title} ($_->{id})" }
 665                           @$possibles });
 666 }
 667
 668 sub iter_files {
 669   my ($article) = @_;
 670
 671   return unless $article->{id} && $article->{id} > 0;
 672
 673   return $article->files;
 674 }
 675
 676 sub tag_edit_parent {
 677   my ($article) = @_;
 678
 679   return '' unless $article->{id} && $article->{id} != -1;
 680
 681   return <<HTML;
 682 <a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
 683 HTML
 684 }
 685
 686 sub tag_if_children {
 687   my ($args, $acts, $funcname, $templater) = @_;
 688
 689   return $templater->perform($acts, 'ifChildren', '');
 690 }
 691
 692 sub tag_movechild {
 693   my ($self, $req, $article, $kids, $rindex, $arg,
 694       $acts, $funcname, $templater) = @_;
 695
 696   $req->user_can('edit_reorder_children', $article)
 697     or return '';
 698
 699   @$kids > 1 or return '';
 700
 701   $$rindex >=0 && $$rindex < @$kids
 702     or return '** movechild can only be used in the children iterator **';
 703
 704   my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
 705   $img_prefix = '' unless defined $img_prefix;
 706   $urladd = '' unless defined $urladd;
 707
 708   my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
 709   my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
 710   my $urlbase = admin_base_url($req->cfg);
 711   my $refresh_url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
 712   my $t = $req->cgi->param('_t');
 713   if ($t && $t =~ /^\w+$/) {
 714     $refresh_url .= "&_t=$t";
 715   }
 716
 717   $refresh_url .= $urladd;
 718
 719   my $id = $kids->[$$rindex]{id};
 720   my $down_url = '';
 721   if ($$rindex < $#$kids) {
 722     $down_url = "$cgi_uri/admin/move.pl?id=$id&d=down&edit=1&all=1";
 723   }
 724   my $up_url = '';
 725   if ($$rindex > 0) {
 726     $up_url = "$cgi_uri/admin/move.pl?id=$id&d=up&edit=1&all=1"
 727   }
 728
 729   return make_arrows($req->cfg, $down_url, $up_url, $refresh_url, $img_prefix);
 730 }
 731
 732 sub tag_edit_link {
 733   my ($article, $args, $acts, $funcname, $templater) = @_;
 734   my ($which, $name) = split / /, $args, 2;
 735   $name ||= 'Edit';
 736   my $gen_class;
 737   if ($acts->{$which}
 738       && ($gen_class = $templater->perform($acts, $which, 'generator'))) {
 739     eval "use $gen_class";
 740     unless ($@) {
 741       my $gen = $gen_class->new(top => $article);
 742       my $link = $gen->edit_link($templater->perform($acts, $which, 'id'));
 743       return qq!<a href="$link">$name</a>!;
 744     }
 745   }
 746   return '';
 747 }
 748
 749 sub tag_imgmove {
 750   my ($req, $article, $rindex, $images, $arg,
 751       $acts, $funcname, $templater) = @_;
 752
 753   $req->user_can(edit_images_reorder => $article)
 754     or return '';
 755
 756   @$images > 1 or return '';
 757
 758   $$rindex >= 0 && $$rindex < @$images
 759     or return '** imgmove can only be used in image iterator **';
 760
 761   my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
 762   $img_prefix = '' unless defined $img_prefix;
 763   $urladd = '' unless defined $urladd;
 764
 765   my $urlbase = admin_base_url($req->cfg);
 766   my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
 767   my $t = $req->cgi->param('_t');
 768   if ($t && $t =~ /^\w+$/) {
 769     $url .= "&_t=$t";
 770   }
 771   $url .= $urladd;
 772
 773   my $image = $images->[$$rindex];
 774   my $down_url;
 775   if ($$rindex < $#$images) {
 776     $down_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgdown=1&imageid=$image->{id}";
 777   }
 778   my $up_url = '';
 779   if ($$rindex > 0) {
 780     $up_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgup=1&imageid=$image->{id}";
 781   }
 782   return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
 783 }
 784
 785 sub tag_movefiles {
 786   my ($self, $req, $article, $files, $rindex, $arg,
 787       $acts, $funcname, $templater) = @_;
 788
 789   $req->user_can('edit_files_reorder', $article)
 790     or return '';
 791
 792   @$files > 1 or return '';
 793
 794   my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
 795   $img_prefix = '' unless defined $img_prefix;
 796   $urladd = '' unless defined $urladd;
 797
 798   $$rindex >= 0 && $$rindex < @$files
 799     or return '** movefiles can only be used in the files iterator **';
 800
 801   my $urlbase = admin_base_url($req->cfg);
 802   my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}$urladd";
 803   my $t = $req->cgi->param('_t');
 804   if ($t && $t =~ /^\w+$/) {
 805     $url .= "&_t=$t";
 806   }
 807
 808   my $down_url = "";
 809   if ($$rindex < $#$files) {
 810     $down_url = "$ENV{SCRIPT_NAME}?fileswap=1&amp;id=$article->{id}&amp;file1=$files->[$$rindex]{id}&amp;file2=$files->[$$rindex+1]{id}";
 811   }
 812   my $up_url = "";
 813   if ($$rindex > 0) {
 814     $up_url = "$ENV{SCRIPT_NAME}?fileswap=1&amp;id=$article->{id}&amp;file1=$files->[$$rindex]{id}&amp;file2=$files->[$$rindex-1]{id}";
 815   }
 816
 817   return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
 818 }
 819
 820 sub tag_old {
 821   my ($article, $cgi, $args, $acts, $funcname, $templater) = @_;
 822
 823   my ($col, $func, $funcargs) = split ' ', $args, 3;
 824   my $value = $cgi->param($col);
 825   if (defined $value) {
 826     return escape_html($value);
 827   }
 828   else {
 829     if ($func) {
 830       return $templater->perform($acts, $func, $funcargs);
 831     }
 832     else {
 833       $value = $article->{$args};
 834       defined $value or $value = '';
 835       return escape_html($value);
 836     }
 837   }
 838 }
 839
 840 sub iter_admin_users {
 841   require BSE::TB::AdminUsers;
 842
 843   BSE::TB::AdminUsers->all;
 844 }
 845
 846 sub iter_admin_groups {
 847   require BSE::TB::AdminGroups;
 848
 849   BSE::TB::AdminGroups->all;
 850 }
 851
 852 sub tag_if_field_perm {
 853   my ($req, $article, $field) = @_;
 854
 855   unless ($field =~ /^\w+$/) {
 856     print STDERR "Bad fieldname '$field'\n";
 857     return;
 858   }
 859   if ($article->{id}) {
 860     return $req->user_can("edit_field_edit_$field", $article);
 861   }
 862   else {
 863     #print STDERR "adding, always successful\n";
 864     return 1;
 865   }
 866 }
 867
 868 sub tag_default {
 869   my ($self, $req, $article, $args, $acts, $funcname, $templater) = @_;
 870
 871   my ($col, $func, $funcargs) = split ' ', $args, 3;
 872   if ($article->{id}) {
 873     if ($func) {
 874       return $templater->perform($acts, $func, $funcargs);
 875     }
 876     else {
 877       my $value = $article->{$args};
 878       defined $value or $value = '';
 879       return escape_html($value);
 880     }
 881   }
 882   else {
 883     my $value = $self->default_value($req, $article, $col);
 884     return escape_html($value);
 885   }
 886 }
 887
 888 sub iter_flags {
 889   my ($self) = @_;
 890
 891   $self->flags;
 892 }
 893
 894 sub tag_if_flag_set {
 895   my ($article, $arg, $acts, $funcname, $templater) = @_;
 896
 897   my @args = DevHelp::Tags->get_parms($arg, $acts, $templater);
 898   @args or return;
 899
 900   return index($article->{flags}, $args[0]) >= 0;
 901 }
 902
 903 sub iter_crumbs {
 904   my ($article, $articles) = @_;
 905
 906   my @crumbs;
 907   my $temp = $article;
 908   defined($temp->{parentid}) or return;
 909   while ($temp->{parentid} > 0
 910          and my $crumb = $articles->getByPkey($temp->{parentid})) {
 911     unshift @crumbs, $crumb;
 912     $temp = $crumb;
 913   }
 914
 915   @crumbs;
 916 }
 917
 918 sub tag_typename {
 919   my ($args, $acts, $funcname, $templater) = @_;
 920
 921   exists $acts->{$args} or return "** need an article name **";
 922   my $generator = $templater->perform($acts, $args, 'generator');
 923
 924   $generator =~ /^(?:BSE::)?Generate::(\w+)$/
 925     or return "** invalid generator $generator **";
 926
 927   return $1;
 928 }
 929
 930 sub low_edit_tags {
 931   my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
 932
 933   my $cgi = $request->cgi;
 934   $msg ||= $cgi->param('message');
 935   $msg ||= '';
 936   $errors ||= {};
 937   if (keys %$errors && !$msg) {
 938     # try to get the errors in the same order as the table
 939     my @cols = $self->table_object($articles)->rowClass->columns;
 940     my %work = %$errors;
 941     my @out = grep defined, delete @work{@cols};
 942
 943     $msg = join "<br>", @out, values %work;
 944   }
 945   my $parent;
 946   if ($article->{id}) {
 947     if ($article->{parentid} > 0) {
 948       $parent = $article->parent;
 949     }
 950     else {
 951       $parent = { title=>"No parent - this is a section", id=>-1 };
 952     }
 953   }
 954   else {
 955     $parent = { title=>"How did we get here?", id=>0 };
 956   }
 957   my $cfg = $self->{cfg};
 958   my $mbcs = $cfg->entry('html', 'mbcs', 0);
 959   my $tag_hash = $mbcs ? \&tag_hash_mbcs : \&tag_hash;
 960   my @images;
 961   my $image_index;
 962   my @children;
 963   my $child_index;
 964   my %stepkids;
 965   my @allkids;
 966   my $allkid_index;
 967   my @possstepkids;
 968   my @stepparents;
 969   my $stepparent_index;
 970   my @stepparent_targs;
 971   my @stepparentpossibles;
 972   my @files;
 973   my $file_index;
 974   return
 975     (
 976      BSE::Util::Tags->basic($acts, $cgi, $cfg),
 977      BSE::Util::Tags->admin($acts, $cfg),
 978      BSE::Util::Tags->secure($request),
 979      article => [ $tag_hash, $article ],
 980      old => [ \&tag_old, $article, $cgi ],
 981      default => [ \&tag_default, $self, $request, $article ],
 982      articleType => [ \&tag_art_type, $article->{level}, $cfg ],
 983      parentType => [ \&tag_art_type, $article->{level}-1, $cfg ],
 984      ifNew => [ \&tag_if_new, $article ],
 985      list => [ \&tag_list, $self, $article, $articles, $cgi, $request ],
 986      script => $ENV{SCRIPT_NAME},
 987      level => $article->{level},
 988      checked => \&tag_checked,
 989      DevHelp::Tags->make_iterator2
 990      ([ \&iter_get_images, $self, $article ], 'image', 'images', \@images,
 991       \$image_index),
 992      imgmove => [ \&tag_imgmove, $request, $article, \$image_index, \@images ],
 993      message => $msg,
 994      DevHelp::Tags->make_iterator2
 995      ([ \&iter_get_kids, $article, $articles ],
 996       'child', 'children', \@children, \$child_index),
 997      ifchildren => \&tag_if_children,
 998      childtype => [ \&tag_art_type, $article->{level}+1, $cfg ],
 999      ifHaveChildType => [ \&tag_if_have_child_type, $article->{level}, $cfg ],
1000      movechild => [ \&tag_movechild, $self, $request, $article, \@children,
1001                     \$child_index],
1002      is => \&tag_is,
1003      templates => [ \&tag_templates, $self, $article, $cfg, $cgi ],
1004      titleImages => [ \&tag_title_images, $self, $article, $cfg, $cgi ],
1005      editParent => [ \&tag_edit_parent, $article ],
1006      DevHelp::Tags->make_iterator2
1007      ([ \&iter_allkids, $article ], 'kid', 'kids', \@allkids, \$allkid_index),
1008      ifStepKid =>
1009      [ \&tag_if_step_kid, $article, \@allkids, \$allkid_index, \%stepkids ],
1010      stepkid => [ \&tag_step_kid, $article, \@allkids, \$allkid_index,
1011                   \%stepkids ],
1012      movestepkid =>
1013      [ \&tag_move_stepkid, $self, $cgi, $request, $article, \@allkids,
1014        \$allkid_index ],
1015      possible_stepkids =>
1016      [ \&tag_possible_stepkids, \%stepkids, $request, $article,
1017        \@possstepkids, $articles, $cgi ],
1018      ifPossibles =>
1019      [ \&tag_if_possible_stepkids, \%stepkids, $request, $article,
1020        \@possstepkids, $articles, $cgi ],
1021      DevHelp::Tags->make_iterator2
1022      ( [ \&iter_get_stepparents, $article ], 'stepparent', 'stepparents',
1023        \@stepparents, \$stepparent_index),
1024      ifStepParents => \&tag_ifStepParents,
1025      stepparent_targ =>
1026      [ \&tag_stepparent_targ, $article, \@stepparent_targs,
1027        \$stepparent_index ],
1028      movestepparent =>
1029      [ \&tag_move_stepparent, $self, $cgi, $request, $article, \@stepparents,
1030        \$stepparent_index ],
1031      ifStepparentPossibles =>
1032      [ \&tag_if_stepparent_possibles, $request, $article, $articles,
1033        \@stepparent_targs, \@stepparentpossibles, ],
1034      stepparent_possibles =>
1035      [ \&tag_stepparent_possibles, $cgi, $request, $article, $articles,
1036        \@stepparent_targs, \@stepparentpossibles, ],
1037      DevHelp::Tags->make_iterator2
1038      ([ \&iter_files, $article ], 'file', 'files', \@files, \$file_index ),
1039      movefiles =>
1040      [ \&tag_movefiles, $self, $request, $article, \@files, \$file_index ],
1041      DevHelp::Tags->make_iterator2
1042      (\&iter_admin_users, 'iadminuser', 'adminusers'),
1043      DevHelp::Tags->make_iterator2
1044      (\&iter_admin_groups, 'iadmingroup', 'admingroups'),
1045      edit => [ \&tag_edit_link, $article ],
1046      error => [ $tag_hash, $errors ],
1047      error_img => [ \&tag_error_img, $cfg, $errors ],
1048      ifFieldPerm => [ \&tag_if_field_perm, $request, $article ],
1049      parent => [ $tag_hash, $parent ],
1050      DevHelp::Tags->make_iterator2
1051      ([ \&iter_flags, $self ], 'flag', 'flags' ),
1052      ifFlagSet => [ \&tag_if_flag_set, $article ],
1053      DevHelp::Tags->make_iterator2
1054      ([ \&iter_crumbs, $article, $articles ], 'crumb', 'crumbs' ),
1055      typename => \&tag_typename,
1056     );
1057 }
1058
1059 sub edit_template {
1060   my ($self, $article, $cgi) = @_;
1061
1062   my $base = $article->{level};
1063   my $t = $cgi->param('_t');
1064   if ($t && $t =~ /^\w+$/) {
1065     $base = $t;
1066   }
1067   return $self->{cfg}->entry('admin templates', $base,
1068                              "admin/edit_$base");
1069 }
1070
1071 sub add_template {
1072   my ($self, $article, $cgi) = @_;
1073
1074   $self->edit_template($article, $cgi);
1075 }
1076
1077 sub low_edit_form {
1078   my ($self, $request, $article, $articles, $msg, $errors) = @_;
1079
1080   my $cgi = $request->cgi;
1081   my %acts;
1082   %acts = $self->low_edit_tags(\%acts, $request, $article, $articles, $msg,
1083                               $errors);
1084   my $template = $article->{id} ?
1085     $self->edit_template($article, $cgi) : $self->add_template($article, $cgi);
1086
1087   return BSE::Template->get_response($template, $request->cfg, \%acts);
1088 }
1089
1090 sub edit_form {
1091   my ($self, $request, $article, $articles, $msg, $errors) = @_;
1092
1093   return $self->low_edit_form($request, $article, $articles, $msg, $errors);
1094 }
1095
1096 sub add_form {
1097   my ($self, $req, $articles, $msg, $errors) = @_;
1098
1099   my $level;
1100   my $cgi = $req->cgi;
1101   my $parentid = $cgi->param('parentid');
1102   if ($parentid) {
1103     if ($parentid =~ /^\d+$/) {
1104       if (my $parent = $self->get_parent($parentid, $articles)) {
1105         $level = $parent->{level}+1;
1106       }
1107       else {
1108         $parentid = undef;
1109       }
1110     }
1111     elsif ($parentid eq "-1") {
1112       $level = 1;
1113     }
1114   }
1115   unless (defined $level) {
1116     $level = $cgi->param('level');
1117     undef $level unless defined $level && $level =~ /^\d+$/
1118       && $level > 0 && $level < 100;
1119     defined $level or $level = 3;
1120   }
1121
1122   my %article;
1123   my @cols = Article->columns;
1124   @article{@cols} = ('') x @cols;
1125   $article{id} = '';
1126   $article{parentid} = $parentid;
1127   $article{level} = $level;
1128   $article{body} = '<maximum of 64Kb>';
1129   $article{listed} = 1;
1130   $article{generator} = $self->generator;
1131
1132   my ($values, $labels) = $self->possible_parents(\%article, $articles, $req);
1133   @$values
1134     or return $self->edit_sections($req, $articles,
1135                 "You can't add children to any article at that level");
1136
1137   return $self->low_edit_form($req, \%article, $articles, $msg, $errors);
1138 }
1139
1140 sub generator { 'Generate::Article' }
1141
1142 sub typename {
1143   my ($self) = @_;
1144
1145   my $gen = $self->generator;
1146
1147   ($gen =~ /(\w+)$/)[0] || 'Article';
1148 }
1149
1150 sub _validate_common {
1151   my ($self, $data, $articles, $errors, $article) = @_;
1152
1153 #   if (defined $data->{parentid} && $data->{parentid} =~ /^(?:-1|\d+)$/) {
1154 #     unless ($data->{parentid} == -1 or
1155 #           $articles->getByPkey($data->{parentid})) {
1156 #       $errors->{parentid} = "Selected parent article doesn't exist";
1157 #     }
1158 #   }
1159 #   else {
1160 #     $errors->{parentid} = "You need to select a valid parent";
1161 #   }
1162   if (exists $data->{title} && $data->{title} !~ /\S/) {
1163     $errors->{title} = "Please enter a title";
1164   }
1165
1166   if (exists $data->{template} && $data->{template} =~ /\.\./) {
1167     $errors->{template} = "Please only select templates from the list provided";
1168   }
1169
1170 }
1171
1172 sub validate {
1173   my ($self, $data, $articles, $errors) = @_;
1174
1175   $self->_validate_common($data, $articles, $errors);
1176   custom_class($self->{cfg})
1177     ->article_validate($data, undef, $self->typename, $errors);
1178
1179   return !keys %$errors;
1180 }
1181
1182 sub validate_old {
1183   my ($self, $article, $data, $articles, $errors) = @_;
1184
1185   $self->_validate_common($data, $articles, $errors, $article);
1186   custom_class($self->{cfg})
1187     ->article_validate($data, $article, $self->typename, $errors);
1188
1189   if (exists $data->{release} && !valid_date($data->{release})) {
1190     $errors->{release} = "Invalid release date";
1191   }
1192
1193   return !keys %$errors;
1194 }
1195
1196 sub validate_parent {
1197   1;
1198 }
1199
1200 sub fill_new_data {
1201   my ($self, $req, $data, $articles) = @_;
1202
1203   custom_class($self->{cfg})
1204     ->article_fill_new($data, $self->typename);
1205
1206   1;
1207 }
1208
1209 sub link_path {
1210   my ($self, $article) = @_;
1211
1212   # check the config for the article and any of its ancestors
1213   my $work_article = $article;
1214   my $path = $self->{cfg}->entry('article uris', $work_article->{id});
1215   while (!$path) {
1216     last if $work_article->{parentid} == -1;
1217     $work_article = $work_article->parent;
1218     $path = $self->{cfg}->entry('article uris', $work_article->{id});
1219   }
1220   return $path if $path;
1221
1222   $self->default_link_path($article);
1223 }
1224
1225 sub default_link_path {
1226   my ($self, $article) = @_;
1227
1228   $self->{cfg}->entry('uri', 'articles', '/a');
1229 }
1230
1231 sub make_link {
1232   my ($self, $article) = @_;
1233
1234   my $article_uri = $self->link_path($article);
1235   my $link = "$article_uri/$article->{id}.html";
1236   my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1237   if ($link_titles) {
1238     (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
1239     $link .= "/".$extra;
1240   }
1241
1242   $link;
1243 }
1244
1245 sub save_new {
1246   my ($self, $req, $articles) = @_;
1247
1248   my $cgi = $req->cgi;
1249   my %data;
1250   my $table_object = $self->table_object($articles);
1251   my @columns = $table_object->rowClass->columns;
1252   $self->save_thumbnail($cgi, undef, \%data);
1253   for my $name (@columns) {
1254     $data{$name} = $cgi->param($name)
1255       if defined $cgi->param($name);
1256   }
1257   $data{flags} = join '', sort $cgi->param('flags');
1258
1259   my $msg;
1260   my %errors;
1261   $self->validate(\%data, $articles, \%errors)
1262     or return $self->add_form($req, $articles, $msg, \%errors);
1263
1264   my $parent;
1265   if ($data{parentid} > 0) {
1266     $parent = $articles->getByPkey($data{parentid}) or die;
1267     $req->user_can('edit_add_child', $parent)
1268       or return $self->add_form($req, $articles,
1269                                 "You cannot add a child to that article");
1270     for my $name (@columns) {
1271       if (exists $data{$name} &&
1272           !$req->user_can("edit_add_field_$name", $parent)) {
1273         delete $data{$name};
1274       }
1275     }
1276   }
1277   else {
1278     $req->user_can('edit_add_child')
1279       or return $self->add_form($req, $articles,
1280                                 "You cannot create a top-level article");
1281     for my $name (@columns) {
1282       if (exists $data{$name} &&
1283           !$req->user_can("edit_add_field_$name")) {
1284         delete $data{$name};
1285       }
1286     }
1287   }
1288
1289   $self->validate_parent(\%data, $articles, $parent, \$msg)
1290     or return $self->add_form($req, $articles, $msg);
1291
1292   $self->fill_new_data($req, \%data, $articles);
1293   my $level = $parent ? $parent->{level}+1 : 1;
1294   $data{displayOrder} = time;
1295   $data{titleImage} ||= '';
1296   $data{imagePos} = 'tr';
1297   $data{release} = sql_date($data{release}) || now_sqldate();
1298   $data{expire} = sql_date($data{expire}) || $Constants::D_99;
1299   unless ($data{template}) {
1300     $data{template} ||=
1301       $self->{cfg}->entry("children of $data{parentid}", 'template');
1302     $data{template} ||=
1303       $self->{cfg}->entry("level $level", 'template');
1304   }
1305   $data{link} ||= '';
1306   $data{admin} ||= '';
1307   if ($parent) {
1308     $data{threshold} = $parent->{threshold}
1309       if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1310     $data{summaryLength} = $parent->{summaryLength}
1311       if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1312   }
1313   else {
1314     $data{threshold} = $self->{cfg}->entry("level $level", 'threshold', 5)
1315       if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1316     $data{summaryLength} = 200
1317       if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1318   }
1319   $data{generator} = $self->generator;
1320   $data{lastModified} = now_sqldatetime();
1321   $data{level} = $level;
1322   $data{listed} = 1 unless defined $data{listed};
1323
1324   shift @columns;
1325   my $article = $table_object->add(@data{@columns});
1326
1327   # we now have an id - generate the links
1328
1329   my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
1330   $article->setAdmin("$cgi_uri/admin/admin.pl?id=$article->{id}");
1331   $article->setLink($self->make_link($article));
1332   $article->save();
1333
1334   use Util 'generate_article';
1335   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1336
1337   my $r = $cgi->param('r');
1338   if ($r) {
1339     $r .= ($r =~ /\?/) ? '&' : '?';
1340     $r .= "id=$article->{id}";
1341   }
1342   else {
1343
1344     $r = admin_base_url($req->cfg) . $article->{admin};
1345   }
1346   return BSE::Template->get_refresh($r, $self->{cfg});
1347
1348 }
1349
1350 sub fill_old_data {
1351   my ($self, $req, $article, $data) = @_;
1352
1353   if (exists $data->{body}) {
1354     $data->{body} =~ s/\x0D\x0A/\n/g;
1355     $data->{body} =~ tr/\r/\n/;
1356   }
1357   for my $col (Article->columns) {
1358     next if $col =~ /^custom/;
1359     $article->{$col} = $data->{$col}
1360       if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
1361   }
1362   custom_class($self->{cfg})
1363     ->article_fill_old($article, $data, $self->typename);
1364
1365   return 1;
1366 }
1367
1368 sub save {
1369   my ($self, $req, $article, $articles) = @_;
1370
1371   $req->user_can(edit_save => $article)
1372     or return $self->edit_form($req, $article, $articles,
1373                                "You don't have access to save this article");
1374
1375   my $cgi = $req->cgi;
1376   my %data;
1377   for my $name ($article->columns) {
1378     $data{$name} = $cgi->param($name)
1379       if defined($cgi->param($name)) and $name ne 'id' && $name ne 'parentid'
1380         && $req->user_can("edit_field_edit_$name", $article);
1381   }
1382   # possibly this needs tighter error checking
1383   $data{flags} = join '', sort $cgi->param('flags')
1384     if $req->user_can("edit_field_edit_flags", $article);
1385   my %errors;
1386   $self->validate_old($article, \%data, $articles, \%errors)
1387     or return $self->edit_form($req, $article, $articles, undef, \%errors);
1388   $self->save_thumbnail($cgi, $article, \%data)
1389     if $req->user_can('edit_field_edit_thumbImage', $article);
1390   $self->fill_old_data($req, $article, \%data);
1391   if (exists $article->{template} &&
1392       $article->{template} =~ m|\.\.|) {
1393     my $msg = "Please only select templates from the list provided";
1394     return $self->edit_form($req, $article, $articles, $msg);
1395   }
1396
1397   # reparenting
1398   my $newparentid = $cgi->param('parentid');
1399   if ($newparentid && $req->user_can('edit_field_edit_parentid', $article)) {
1400     if ($newparentid == $article->{parentid}) {
1401       # nothing to do
1402     }
1403     elsif ($newparentid != -1) {
1404       print STDERR "Reparenting...\n";
1405       my $newparent = $articles->getByPkey($newparentid);
1406       if ($newparent) {
1407         if ($newparent->{level} != $article->{level}-1) {
1408           # the article cannot become a child of itself or one of it's
1409           # children
1410           if ($article->{id} == $newparentid
1411               || $self->is_descendant($article->{id}, $newparentid, $articles)) {
1412             my $msg = "Cannot become a child of itself or of a descendant";
1413             return $self->edit_form($req, $article, $articles, $msg);
1414           }
1415           my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1416           if ($self->is_descendant($article->{id}, $shopid, $articles)) {
1417             my $msg = "Cannot become a descendant of the shop";
1418             return $self->edit_form($req, $article, $articles, $msg);
1419           }
1420           my $msg;
1421           $self->reparent($article, $newparentid, $articles, \$msg)
1422             or return $self->edit_form($req, $article, $articles, $msg);
1423         }
1424         else {
1425           # stays at the same level, nothing special
1426           $article->{parentid} = $newparentid;
1427         }
1428       }
1429       # else ignore it
1430     }
1431     else {
1432       # becoming a section
1433       my $msg;
1434       $self->reparent($article, -1, $articles, \$msg)
1435         or return $self->edit_form($req, $article, $articles, $msg);
1436     }
1437   }
1438
1439   $article->{listed} = $cgi->param('listed')
1440     if defined $cgi->param('listed') &&
1441       $req->user_can('edit_field_edit_listed', $article);
1442   $article->{release} = sql_date($cgi->param('release'))
1443     if defined $cgi->param('release') &&
1444       $req->user_can('edit_field_edit_release', $article);
1445
1446   $article->{expire} = sql_date($cgi->param('expire')) || $Constants::D_99
1447     if defined $cgi->param('expire') &&
1448       $req->user_can('edit_field_edit_expire', $article);
1449   $article->{lastModified} =  now_sqldatetime();
1450   if ($article->{link} &&
1451       !$self->{cfg}->entry('protect link', $article->{id})) {
1452     my $article_uri = $self->make_link($article);
1453     $article->setLink($article_uri);
1454   }
1455
1456   $article->save();
1457
1458   use Util 'generate_article';
1459   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1460
1461   return $self->refresh($article, $cgi, undef, 'Article saved');
1462 }
1463
1464 sub sql_date {
1465   my $str = shift;
1466   my ($year, $month, $day);
1467
1468   # look for a date
1469   if (($day, $month, $year) = ($str =~ m!(\d+)/(\d+)/(\d+)!)) {
1470     $year += 2000 if $year < 100;
1471
1472     return sprintf("%04d-%02d-%02d", $year, $month, $day);
1473   }
1474   return undef;
1475 }
1476
1477 sub reparent {
1478   my ($self, $article, $newparentid, $articles, $rmsg) = @_;
1479
1480   my $newlevel;
1481   if ($newparentid == -1) {
1482     $newlevel = 1;
1483   }
1484   else {
1485     my $parent = $articles->getByPkey($newparentid);
1486     unless ($parent) {
1487       $$rmsg = "Cannot get new parent article";
1488       return;
1489     }
1490     $newlevel = $parent->{level} + 1;
1491   }
1492   # the caller will save this one
1493   $article->{parentid} = $newparentid;
1494   $article->{level} = $newlevel;
1495   $article->{displayOrder} = time;
1496
1497   my @change = ( [ $article->{id}, $newlevel ] );
1498   while (@change) {
1499     my $this = shift @change;
1500     my ($art, $level) = @$this;
1501
1502     my @kids = $articles->getBy(parentid=>$art);
1503     push @change, map { [ $_->{id}, $level+1 ] } @kids;
1504
1505     for my $kid (@kids) {
1506       $kid->{level} = $level+1;
1507       $kid->save;
1508     }
1509   }
1510
1511   return 1;
1512 }
1513
1514 # tests if $desc is a descendant of $art
1515 # where both are article ids
1516 sub is_descendant {
1517   my ($self, $art, $desc, $articles) = @_;
1518
1519   my @check = ($art);
1520   while (@check) {
1521     my $parent = shift @check;
1522     $parent == $desc and return 1;
1523     my @kids = $articles->getBy(parentid=>$parent);
1524     push @check, map $_->{id}, @kids;
1525   }
1526
1527   return 0;
1528 }
1529
1530 sub save_thumbnail {
1531   my ($self, $cgi, $original, $newdata) = @_;
1532
1533   unless ($original) {
1534     @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1535   }
1536   my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
1537   if ($cgi->param('remove_thumb') && $original && $original->{thumbImage}) {
1538     unlink("$imagedir/$original->{thumbImage}");
1539     @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1540   }
1541   my $image = $cgi->param('thumbnail');
1542   if ($image && -s $image) {
1543     # where to put it...
1544     my $name = '';
1545     $image =~ /([\w.-]+)$/ and $name = $1;
1546     my $filename = time . "_" . $name;
1547
1548     use Fcntl;
1549     my $counter = "";
1550     $filename = time . '_' . $counter . '_' . $name
1551       until sysopen( OUTPUT, "$imagedir/$filename",
1552                      O_WRONLY| O_CREAT| O_EXCL)
1553         || ++$counter > 100;
1554
1555     fileno(OUTPUT) or die "Could not open image file: $!";
1556     binmode OUTPUT;
1557     my $buffer;
1558
1559     #no strict 'refs';
1560
1561     # read the image in from the browser and output it to our
1562     # output filehandle
1563     print STDERR "\$image ",ref $image,"\n";
1564     seek $image, 0, 0;
1565     print OUTPUT $buffer while sysread $image, $buffer, 1024;
1566
1567     close OUTPUT
1568       or die "Could not close image output file: $!";
1569
1570     use Image::Size;
1571
1572     if ($original && $original->{thumbImage}) {
1573       #unlink("$imagedir/$original->{thumbImage}");
1574     }
1575     @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
1576     $newdata->{thumbImage} = $filename;
1577   }
1578 }
1579
1580 sub child_types {
1581   my ($self, $article) = @_;
1582
1583   my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1584   if ($article && $article->{id} && $article->{id} == $shopid) {
1585     return ( 'BSE::Edit::Catalog' );
1586   }
1587   return ( 'BSE::Edit::Article' );
1588 }
1589
1590 sub add_stepkid {
1591   my ($self, $req, $article, $articles) = @_;
1592
1593   $req->user_can(edit_stepkid_add => $article)
1594     or return $self->edit_form($req, $article, $articles,
1595                                "You don't have access to add step children to this article");
1596
1597   my $cgi = $req->cgi;
1598   require 'BSE/Admin/StepParents.pm';
1599   eval {
1600     my $childId = $cgi->param('stepkid');
1601     defined $childId
1602       or die "No stepkid supplied to add_stepkid";
1603     $childId =~ /^\d+$/
1604       or die "Invalid stepkid supplied to add_stepkid";
1605     my $child = $articles->getByPkey($childId)
1606       or die "Article $childId not found";
1607
1608     $req->user_can(edit_stepparent_add => $child)
1609       or die "You don't have access to add a stepparent to that article\n";
1610
1611     use BSE::Util::Valid qw/valid_date/;
1612     my $release = $cgi->param('release');
1613     valid_date($release) or $release = undef;
1614     my $expire = $cgi->param('expire');
1615     valid_date($expire) or $expire = undef;
1616
1617     my $newentry =
1618       BSE::Admin::StepParents->add($article, $child, $release, $expire);
1619   };
1620   if ($@) {
1621     return $self->edit_form($req, $article, $articles, $@);
1622   }
1623
1624   use Util 'generate_article';
1625   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1626
1627   return $self->refresh($article, $cgi, 'step', 'Stepchild added');
1628 }
1629
1630 sub del_stepkid {
1631   my ($self, $req, $article, $articles) = @_;
1632
1633   $req->user_can(edit_stepkid_delete => $article)
1634     or return $self->edit_form($req, $article, $articles,
1635                                "You don't have access to delete stepchildren from this article");
1636
1637   my $cgi = $req->cgi;
1638   require 'BSE/Admin/StepParents.pm';
1639   eval {
1640     my $childId = $cgi->param('stepkid');
1641     defined $childId
1642       or die "No stepkid supplied to add_stepkid";
1643     $childId =~ /^\d+$/
1644       or die "Invalid stepkid supplied to add_stepkid";
1645     my $child = $articles->getByPkey($childId)
1646       or die "Article $childId not found";
1647
1648     $req->user_can(edit_stepparent_delete => $child)
1649       or die "You cannot remove stepparents from that article\n";
1650
1651     BSE::Admin::StepParents->del($article, $child);
1652   };
1653
1654   if ($@) {
1655     return $self->edit_form($req, $article, $articles, $@);
1656   }
1657   use Util 'generate_article';
1658   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1659
1660   return $self->refresh($article, $cgi, 'step', 'Stepchild deleted');
1661 }
1662
1663 sub save_stepkids {
1664   my ($self, $req, $article, $articles) = @_;
1665
1666   $req->user_can(edit_stepkid_save => $article)
1667     or return $self->edit_form($req, $article, $articles,
1668                                "No access to save stepkid data for this article");
1669
1670   my $cgi = $req->cgi;
1671   require 'BSE/Admin/StepParents.pm';
1672   my @stepcats = OtherParents->getBy(parentId=>$article->{id});
1673   my %stepcats = map { $_->{parentId}, $_ } @stepcats;
1674   my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1675   for my $stepcat (@stepcats) {
1676     $req->user_can(edit_stepparent_save => $stepcat->{childId})
1677       or next;
1678     for my $name (qw/release expire/) {
1679       my $date = $cgi->param($name.'_'.$stepcat->{childId});
1680       if (defined $date) {
1681         if ($date eq '') {
1682           $date = $datedefs{$name};
1683         }
1684         elsif (valid_date($date)) {
1685           use BSE::Util::SQL qw/date_to_sql/;
1686           $date = date_to_sql($date);
1687         }
1688         else {
1689           return $self->refresh($article, $cgi, '', "Invalid date '$date'");
1690         }
1691         $stepcat->{$name} = $date;
1692       }
1693     }
1694     eval {
1695       $stepcat->save();
1696     };
1697     $@ and return $self->refresh($article, $cgi, '', $@);
1698   }
1699   use Util 'generate_article';
1700   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1701
1702   return $self->refresh($article, $cgi, 'step', 'Stepchild information saved');
1703 }
1704
1705 sub add_stepparent {
1706   my ($self, $req, $article, $articles) = @_;
1707
1708   $req->user_can(edit_stepparent_add => $article)
1709     or return $self->edit_form($req, $article, $articles,
1710                                "You don't have access to add stepparents to this article");
1711
1712   my $cgi = $req->cgi;
1713   require 'BSE/Admin/StepParents.pm';
1714   eval {
1715     my $step_parent_id = $cgi->param('stepparent');
1716     defined($step_parent_id)
1717       or die "No stepparent supplied to add_stepparent";
1718     int($step_parent_id) eq $step_parent_id
1719       or die "Invalid stepcat supplied to add_stepcat";
1720     my $step_parent = $articles->getByPkey($step_parent_id)
1721       or die "Parent $step_parent_id not found\n";
1722
1723     $req->user_can(edit_stepkid_add => $step_parent)
1724       or die "You don't have access to add a stepkid to that article\n";
1725
1726     my $release = $cgi->param('release');
1727     defined $release
1728       or $release = "01/01/2000";
1729     use BSE::Util::Valid qw/valid_date/;
1730     $release eq '' or valid_date($release)
1731       or die "Invalid release date";
1732     my $expire = $cgi->param('expire');
1733     defined $expire
1734       or $expire = '31/12/2999';
1735     $expire eq '' or valid_date($expire)
1736       or die "Invalid expire data";
1737
1738     my $newentry =
1739       BSE::Admin::StepParents->add($step_parent, $article, $release, $expire);
1740   };
1741   $@ and return $self->refresh($article, $cgi, 'step', $@);
1742
1743   use Util 'generate_article';
1744   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1745
1746   return $self->refresh($article, $cgi, 'stepparents', 'Stepparent added');
1747 }
1748
1749 sub del_stepparent {
1750   my ($self, $req, $article, $articles) = @_;
1751
1752   $req->user_can(edit_stepparent_delete => $article)
1753     or return $self->edit_form($req, $article, $articles,
1754                                "You cannot remove stepparents from that article");
1755
1756   my $cgi = $req->cgi;
1757   require 'BSE/Admin/StepParents.pm';
1758   my $step_parent_id = $cgi->param('stepparent');
1759   defined($step_parent_id)
1760     or return $self->refresh($article, $cgi, 'stepparents',
1761                              "No stepparent supplied to add_stepcat");
1762   int($step_parent_id) eq $step_parent_id
1763     or return $self->refresh($article, $cgi, 'stepparents',
1764                              "Invalid stepparent supplied to add_stepparent");
1765   my $step_parent = $articles->getByPkey($step_parent_id)
1766     or return $self->refresh($article, $cgi, 'stepparent',
1767                              "Stepparent $step_parent_id not found");
1768
1769   $req->user_can(edit_stepkid_delete => $step_parent)
1770     or die "You don't have access to remove the stepkid from that article\n";
1771
1772   eval {
1773     BSE::Admin::StepParents->del($step_parent, $article);
1774   };
1775   $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
1776
1777   use Util 'generate_article';
1778   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1779
1780   return $self->refresh($article, $cgi, 'stepparents', 'Stepparent deleted');
1781 }
1782
1783 sub save_stepparents {
1784   my ($self, $req, $article, $articles) = @_;
1785
1786   $req->user_can(edit_stepparent_save => $article)
1787     or return $self->edit_form($req, $article, $articles,
1788                                "No access to save stepparent data for this artice");
1789
1790   my $cgi = $req->cgi;
1791
1792   require 'BSE/Admin/StepParents.pm';
1793   my @stepparents = OtherParents->getBy(childId=>$article->{id});
1794   my %stepparents = map { $_->{parentId}, $_ } @stepparents;
1795   my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1796   for my $stepparent (@stepparents) {
1797     $req->user_can(edit_stepkid_save => $stepparent->{parentId})
1798       or next;
1799     for my $name (qw/release expire/) {
1800       my $date = $cgi->param($name.'_'.$stepparent->{parentId});
1801       if (defined $date) {
1802         if ($date eq '') {
1803           $date = $datedefs{$name};
1804         }
1805         elsif (valid_date($date)) {
1806           use BSE::Util::SQL qw/date_to_sql/;
1807           $date = date_to_sql($date);
1808         }
1809         else {
1810           return $self->refresh($article, $cgi, "Invalid date '$date'");
1811         }
1812         $stepparent->{$name} = $date;
1813       }
1814     }
1815     eval {
1816       $stepparent->save();
1817     };
1818     $@ and return $self->refresh($article, $cgi, '', $@);
1819   }
1820
1821   use Util 'generate_article';
1822   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1823
1824   return $self->refresh($article, $cgi, 'stepparents',
1825                         'Stepparent information saved');
1826 }
1827
1828 sub refresh {
1829   my ($self, $article, $cgi, $name, $message, $extras) = @_;
1830
1831   my $url = $cgi->param('r');
1832   unless ($url) {
1833     my $urlbase = admin_base_url($self->{cfg});
1834     $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
1835     $url .= "&message=" . CGI::escape($message) if $message;
1836     if ($cgi->param('_t')) {
1837       $url .= "&_t=".CGI::escape($cgi->param('_t'));
1838     }
1839     $url .= $extras if defined $extras;
1840     my $cgiextras = $cgi->param('e');
1841     $url .= "#$name" if $name;
1842   }
1843
1844   return BSE::Template->get_refresh($url, $self->{cfg});
1845 }
1846
1847 sub show_images {
1848   my ($self, $req, $article, $articles, $msg, $errors) = @_;
1849
1850   my %acts;
1851   %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
1852   my $template = 'admin/article_img';
1853
1854   return BSE::Template->get_response($template, $req->cfg, \%acts);
1855 }
1856
1857 sub save_image_changes {
1858   my ($self, $req, $article, $articles) = @_;
1859
1860   $req->user_can(edit_images_save => $article)
1861     or return $self->edit_form($req, $article, $articles,
1862                                  "You don't have access to save image information for this article");
1863
1864   my $cgi = $req->cgi;
1865   my $image_pos = $cgi->param('imagePos');
1866   if ($image_pos
1867       && $image_pos =~ /^(?:tl|tr|bl|br)$/
1868       && $image_pos ne $article->{imagePos}) {
1869     $article->{imagePos} = $image_pos;
1870     $article->save;
1871   }
1872   my @images = $self->get_images($article);
1873
1874   @images or
1875     return $self->refresh($article, $cgi, undef, 'No images to save information for');
1876
1877   my $changed;
1878   my @alt = $cgi->param('alt');
1879   if (@alt) {
1880     ++$changed;
1881     for my $index (0..$#images) {
1882       $index < @alt or last;
1883       $images[$index]{alt} = $alt[$index];
1884     }
1885   }
1886   my @urls = $cgi->param('url');
1887   if (@urls) {
1888     ++$changed;
1889     for my $index (0..$#images) {
1890       $index < @urls or next;
1891       $images[$index]{url} = $urls[$index];
1892     }
1893   }
1894   my %errors;
1895   my @names = map scalar($cgi->param('name'.$_)), 0..$#images;
1896   if (@names) {
1897     # make sure there aren't any dups
1898     my %used;
1899     my $index = 0;
1900     for my $name (@names) {
1901       defined $name or $name = '';
1902       if ($name ne '') {
1903         if ($name =~ /^[a-z_]\w*$/i) {
1904           if ($used{lc $name}++) {
1905             $errors{"name$index"} = 'Names must be empty, or alphanumeric and unique to the article';
1906           }
1907         }
1908         else {
1909           $errors{"name$index"} = 'Image identifiers must be unique to the article';
1910         }
1911       }
1912       unless ($errors{"name$index"}) {
1913         my $msg;
1914         $self->validate_image_name($name, \$msg)
1915           or $errors{"name$index"} = $msg;
1916       }
1917
1918       ++$index;
1919     }
1920   }
1921   keys %errors
1922     and return $self->edit_form($req, $article, $articles, undef,
1923                                 \%errors);
1924   for my $index (0..$#images) {
1925     $images[$index]{name} = $names[$index];
1926   }
1927   if ($changed) {
1928     for my $image (@images) {
1929       $image->save;
1930     }
1931   }
1932
1933   use Util 'generate_article';
1934   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1935
1936   return $self->refresh($article, $cgi, undef, 'Image information saved');
1937 }
1938
1939 sub add_image {
1940   my ($self, $req, $article, $articles) = @_;
1941
1942   $req->user_can(edit_images_add => $article)
1943     or return $self->edit_form($req, $article, $articles,
1944                                  "You don't have access to add new images to this article");
1945
1946   my $cgi = $req->cgi;
1947
1948   my %errors;
1949   my $msg;
1950   my $imageref = $cgi->param('name');
1951   if (defined $imageref && $imageref ne '') {
1952     if ($imageref =~ /^[a-z_]\w+$/i) {
1953       # make sure it's unique
1954       my @images = $self->get_images($article);
1955       for my $img (@images) {
1956         if (defined $img->{name} && lc $img->{name} eq lc $imageref) {
1957           $errors{name} = 'Duplicate image name';
1958           last;
1959         }
1960       }
1961     }
1962     else {
1963       $errors{name} = 'Name must be empty or alphanumeric';
1964     }
1965   }
1966   else {
1967     $imageref = '';
1968   }
1969   unless ($errors{name}) {
1970     my $workmsg;
1971     $self->validate_image_name($imageref, \$workmsg)
1972       or $errors{name} = $workmsg;
1973   }
1974
1975   my $image = $cgi->param('image');
1976   if ($image) {
1977     if (-z $image) {
1978       $errors{image} = 'Image file is empty';
1979     }
1980   }
1981   else {
1982     #$msg = 'Enter or select the name of an image file on your machine';
1983     $errors{image} = 'Please enter an image filename';
1984   }
1985   if ($msg || keys %errors) {
1986     return $self->edit_form($req, $article, $articles, $msg, \%errors);
1987   }
1988
1989   my $imagename = $image;
1990   $imagename .= ''; # force it into a string
1991   my $basename = '';
1992   $imagename =~ /([\w.-]+)$/ and $basename = $1;
1993
1994   # create a filename that we hope is unique
1995   my $filename = time. '_'. $basename;
1996
1997   # for the sysopen() constants
1998   use Fcntl;
1999
2000   my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
2001   # loop until we have a unique filename
2002   my $counter="";
2003   $filename = time. '_' . $counter . '_' . $basename
2004     until sysopen( OUTPUT, "$imagedir/$filename", O_WRONLY| O_CREAT| O_EXCL)
2005       || ++$counter > 100;
2006
2007   fileno(OUTPUT) or die "Could not open image file: $!";
2008
2009   # for OSs with special text line endings
2010   binmode OUTPUT;
2011
2012   my $buffer;
2013
2014   no strict 'refs';
2015
2016   # read the image in from the browser and output it to our output filehandle
2017   print OUTPUT $buffer while read $image, $buffer, 1024;
2018
2019   # close and flush
2020   close OUTPUT
2021     or die "Could not close image file $filename: $!";
2022
2023   use Image::Size;
2024
2025
2026   my($width,$height) = imgsize("$imagedir/$filename");
2027
2028   my $alt = $cgi->param('altIn');
2029   defined $alt or $alt = '';
2030   my $url = $cgi->param('url');
2031   defined $url or $url = '';
2032   my %image =
2033     (
2034      articleId => $article->{id},
2035      image => $filename,
2036      alt=>$alt,
2037      width=>$width,
2038      height => $height,
2039      url => $url,
2040      displayOrder=>time,
2041      name => $imageref,
2042     );
2043   require Images;
2044   my @cols = Image->columns;
2045   shift @cols;
2046   my $imageobj = Images->add(@image{@cols});
2047
2048   use Util 'generate_article';
2049   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2050
2051   return $self->refresh($article, $cgi, undef, 'New image added');
2052 }
2053
2054 # remove an image
2055 sub remove_img {
2056   my ($self, $req, $article, $articles, $imageid) = @_;
2057
2058   $req->user_can(edit_images_delete => $article)
2059     or return $self->edit_form($req, $article, $articles,
2060                                  "You don't have access to delete images from this article");
2061
2062   $imageid or die;
2063
2064   my @images = $self->get_images($article);
2065   my ($image) = grep $_->{id} == $imageid, @images
2066     or return $self->show_images($req, $article, $articles, "No such image");
2067   my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
2068   unlink "$imagedir$image->{image}";
2069   $image->remove;
2070
2071   use Util 'generate_article';
2072   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2073
2074   return $self->refresh($article, $req->cgi, undef, 'Image removed');
2075 }
2076
2077 sub move_img_up {
2078   my ($self, $req, $article, $articles) = @_;
2079
2080   $req->user_can(edit_images_reorder => $article)
2081     or return $self->edit_form($req, $article, $articles,
2082                                  "You don't have access to reorder images in this article");
2083
2084   my $imageid = $req->cgi->param('imageid');
2085   my @images = $self->get_images($article);
2086   my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
2087     or return $self->edit_form($req, $article, $articles, "No such image");
2088   $imgindex > 0
2089     or return $self->edit_form($req, $article, $articles, "Image is already at the top");
2090   my ($to, $from) = @images[$imgindex-1, $imgindex];
2091   ($to->{displayOrder}, $from->{displayOrder}) =
2092     ($from->{displayOrder}, $to->{displayOrder});
2093   $to->save;
2094   $from->save;
2095
2096   use Util 'generate_article';
2097   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2098
2099   return $self->refresh($article, $req->cgi, undef, 'Image moved');
2100 }
2101
2102 sub move_img_down {
2103   my ($self, $req, $article, $articles) = @_;
2104
2105   $req->user_can(edit_images_reorder => $article)
2106     or return $self->edit_form($req, $article, $articles,
2107                                  "You don't have access to reorder images in this article");
2108
2109   my $imageid = $req->cgi->param('imageid');
2110   my @images = $self->get_images($article);
2111   my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
2112     or return $self->edit_form($req, $article, $articles, "No such image");
2113   $imgindex < $#images
2114     or return $self->edit_form($req, $article, $articles, "Image is already at the end");
2115   my ($to, $from) = @images[$imgindex+1, $imgindex];
2116   ($to->{displayOrder}, $from->{displayOrder}) =
2117     ($from->{displayOrder}, $to->{displayOrder});
2118   $to->save;
2119   $from->save;
2120
2121   use Util 'generate_article';
2122   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2123
2124   return $self->refresh($article, $req->cgi, undef, 'Image moved');
2125 }
2126
2127 sub get_article {
2128   my ($self, $articles, $article) = @_;
2129
2130   return $article;
2131 }
2132
2133 sub table_object {
2134   my ($self, $articles) = @_;
2135
2136   $articles;
2137 }
2138
2139 my %types =
2140   (
2141    qw(
2142    pdf  application/pdf
2143    txt  text/plain
2144    htm  text/html
2145    html text/html
2146    sgm  text/sgml
2147    sgml text/sgml
2148    xml  text/xml
2149    tsv  text/tab-separated-values
2150    csv  text/plain
2151    gif  image/gif
2152    jpg  image/jpeg
2153    jpeg image/jpeg
2154    jp2  image/jpeg2000
2155    png  image/png
2156    bmp  image/bmp
2157    tif  image/tiff
2158    tiff image/tiff
2159    pct  image/pict
2160    pict image/pict
2161    eps  application/postscript
2162    ps   application/postscript
2163    doc  application/msword
2164    rtf  application/rtf
2165    zip  application/zip
2166    gz   application/gzip
2167    tar  application/x-tar
2168    tgz  application/gzip
2169    hqx  application/mac-binhex40
2170    bin  application/macbinary
2171    sit  application/x-stuffit
2172    Z    application/x-compress
2173    xls  application/ms-excel
2174    ppt  application/ms-powerpoint
2175    swf  application/x-shockwave-flash
2176    fla  application/x-shockwave-flash
2177    dxr  application/x-director
2178    dcr  application/x-director
2179    dir  application/x-director
2180    mov  video/quicktime
2181    moov video/quicktime
2182    mpg  video/mpeg
2183    mp4  video/mp4
2184    mpeg video/mpeg
2185    avi  video/avi
2186    flc  video/flc
2187    wmv  video/x-ms-wmv
2188    asf  video/x-ms-asf
2189    mp2  audio/x-mpeg
2190    mp3  audio/x-mpeg
2191    m4a  audio/m4a
2192    3gp  audio/3gpp
2193    aif  audio/aiff
2194    aiff audio/aiff
2195    aa   audio/audible
2196    ra   audio/x-realaudio
2197    ram  audio/x-pn-realaudio
2198    rm   audio/vnd.rm-realmedia
2199    wav  audio/wav
2200    wma  audio/x-ms-wma
2201    mid  audio/midi
2202    swa  audio/mp3
2203    diff text/plain
2204    patch text/plain
2205    css  text/css
2206    )
2207   );
2208
2209 sub _refresh_filelist {
2210   my ($self, $req, $article, $msg) = @_;
2211
2212   return $self->refresh($article, $req->cgi, undef, $msg);
2213 }
2214
2215 sub filelist {
2216   my ($self, $req, $article, $articles, $msg, $errors) = @_;
2217
2218   my %acts;
2219   %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
2220   my $template = 'admin/filelist';
2221
2222   return BSE::Template->get_response($template, $req->cfg, \%acts);
2223 }
2224
2225 sub fileadd {
2226   my ($self, $req, $article, $articles) = @_;
2227
2228   $req->user_can(edit_files_add => $article)
2229     or return $self->edit_form($req, $article, $articles,
2230                               "You don't have access to add files to this article");
2231
2232   my %file;
2233   my $cgi = $req->cgi;
2234   require ArticleFile;
2235   my @cols = ArticleFile->columns;
2236   shift @cols;
2237   for my $col (@cols) {
2238     if (defined $cgi->param($col)) {
2239       $file{$col} = $cgi->param($col);
2240     }
2241   }
2242
2243   $file{forSale} = 0 + exists $file{forSale};
2244   $file{articleId} = $article->{id};
2245   $file{download} = 0 + exists $file{download};
2246   $file{requireUser} = 0 + exists $file{requireUser};
2247
2248   my $downloadPath = $self->{cfg}->entryVar('paths', 'downloads');
2249
2250   # build a filename
2251   my $file = $cgi->param('file');
2252   unless ($file) {
2253     return $self->edit_form($req, $article, $articles,
2254                            "Enter or select the name of a file on your machine",
2255                           { file => 'Please enter a filename' });
2256   }
2257   if (-z $file) {
2258     return $self->edit_form($req, $article, $articles,
2259                            "File is empty",
2260                            { file => 'File is empty' });
2261   }
2262
2263   unless ($file{contentType}) {
2264     unless ($file =~ /\.([^.]+)$/) {
2265       $file{contentType} = "application/octet-stream";
2266     }
2267     unless ($file{contentType}) {
2268       my $ext = lc $1;
2269       my $type = $types{$ext};
2270       unless ($type) {
2271         $type = $self->{cfg}->entry('extensions', $ext)
2272           || $self->{cfg}->entry('extensions', ".$ext")
2273             || "application/octet-stream";
2274       }
2275       $file{contentType} = $type;
2276     }
2277   }
2278
2279   my $basename = '';
2280   my $workfile = $file;
2281   $workfile =~ s![^\w.:/\\-]+!_!g;
2282   $workfile =~ tr/_/_/s;
2283   $workfile =~ /([ \w.-]+)$/ and $basename = $1;
2284   $basename =~ tr/ /_/;
2285
2286   my $filename = time. '_'. $basename;
2287
2288   # for the sysopen() constants
2289   use Fcntl;
2290
2291   # loop until we have a unique filename
2292   my $counter="";
2293   $filename = time. '_' . $counter . '_' . $basename
2294     until sysopen( OUTPUT, "$downloadPath/$filename",
2295                    O_WRONLY| O_CREAT| O_EXCL)
2296       || ++$counter > 100;
2297
2298   fileno(OUTPUT) or die "Could not open file: $!";
2299
2300   # for OSs with special text line endings
2301   binmode OUTPUT;
2302
2303   my $buffer;
2304
2305   no strict 'refs';
2306
2307   # read the image in from the browser and output it to our output filehandle
2308   print OUTPUT $buffer while read $file, $buffer, 8192;
2309
2310   # close and flush
2311   close OUTPUT
2312     or die "Could not close file $filename: $!";
2313
2314   use BSE::Util::SQL qw/now_datetime/;
2315   $file{filename} = $filename;
2316   $file{displayName} = $basename;
2317   $file{sizeInBytes} = -s $file;
2318   $file{displayOrder} = time;
2319   $file{whenUploaded} = now_datetime();
2320
2321   require ArticleFiles;
2322   my $fileobj = ArticleFiles->add(@file{@cols});
2323
2324   use Util 'generate_article';
2325   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2326
2327   $self->_refresh_filelist($req, $article, 'New file added');
2328 }
2329
2330 sub fileswap {
2331   my ($self, $req, $article, $articles) = @_;
2332
2333   $req->user_can('edit_files_reorder', $article)
2334     or return $self->edit_form($req, $article, $articles,
2335                            "You don't have access to reorder files in this article");
2336
2337   my $cgi = $req->cgi;
2338   my $id1 = $cgi->param('file1');
2339   my $id2 = $cgi->param('file2');
2340
2341   if ($id1 && $id2) {
2342     my @files = $article->files;
2343
2344     my ($file1) = grep $_->{id} == $id1, @files;
2345     my ($file2) = grep $_->{id} == $id2, @files;
2346
2347     if ($file1 && $file2) {
2348       ($file1->{displayOrder}, $file2->{displayOrder})
2349         = ($file2->{displayOrder}, $file1->{displayOrder});
2350       $file1->save;
2351       $file2->save;
2352     }
2353   }
2354
2355   use Util 'generate_article';
2356   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2357
2358   $self->refresh($article, $req->cgi, undef, 'File moved');
2359 }
2360
2361 sub filedel {
2362   my ($self, $req, $article, $articles) = @_;
2363
2364   $req->user_can('edit_files_delete', $article)
2365     or return $self->edit_form($req, $article, $articles,
2366                                "You don't have access to delete files from this article");
2367
2368   my $cgi = $req->cgi;
2369   my $fileid = $cgi->param('file');
2370   if ($fileid) {
2371     my @files = $article->files;
2372
2373     my ($file) = grep $_->{id} == $fileid, @files;
2374
2375     if ($file) {
2376       my $downloadPath = $req->cfg->entryErr('paths', 'downloads');
2377       my $filename = $downloadPath . "/" . $file->{filename};
2378       my $debug_del = $req->cfg->entryBool('debug', 'file_unlink', 0);
2379       if ($debug_del) {
2380         unlink $filename
2381           or print STDERR "Error deleting $filename: $!\n";
2382       }
2383       else {
2384         unlink $filename;
2385       }
2386       $file->remove();
2387     }
2388   }
2389
2390   use Util 'generate_article';
2391   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2392
2393   $self->_refresh_filelist($req, $article, 'File deleted');
2394 }
2395
2396 sub filesave {
2397   my ($self, $req, $article, $articles) = @_;
2398
2399   $req->user_can('edit_files_save', $article)
2400     or return $self->edit_form($req, $article, $articles,
2401                            "You don't have access to save file information for this article");
2402   my @files = $article->files;
2403
2404   my $cgi = $req->cgi;
2405   for my $file (@files) {
2406     if (defined $cgi->param("description_$file->{id}")) {
2407       $file->{description} = $cgi->param("description_$file->{id}");
2408       if (my $type = $cgi->param("contentType_$file->{id}")) {
2409         $file->{contentType} = $type;
2410       }
2411       $file->{download} = 0 + defined $cgi->param("download_$file->{id}");
2412       $file->{forSale} = 0 + defined $cgi->param("forSale_$file->{id}");
2413       $file->{requireUser} = 0 + defined $cgi->param("requireUser_$file->{id}");
2414       $file->save;
2415     }
2416   }
2417
2418   use Util 'generate_article';
2419   generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2420
2421   $self->_refresh_filelist($req, $article, 'File information saved');
2422 }
2423
2424 sub can_remove {
2425   my ($self, $req, $article, $articles, $rmsg) = @_;
2426
2427   unless ($req->user_can('edit_delete_article', $article, $rmsg)) {
2428     $$rmsg ||= "Access denied";
2429     return;
2430   }
2431
2432   if ($articles->children($article->{id})) {
2433     $$rmsg = "This article has children.  You must delete the children first (or change their parents)";
2434     return;
2435   }
2436   if (grep $_ == $article->{id}, @Constants::NO_DELETE) {
2437     $$rmsg = "Sorry, these pages are essential to the site structure - they cannot be deleted";
2438     return;
2439   }
2440   if ($article->{id} == $Constants::SHOPID) {
2441     $$rmsg = "Sorry, these pages are essential to the store - they cannot be deleted - you may want to hide the the store instead.";
2442     return;
2443   }
2444
2445   return 1;
2446 }
2447
2448 sub remove {
2449   my ($self, $req, $article, $articles) = @_;
2450
2451   my $why_not;
2452   unless ($self->can_remove($req, $article, $articles, \$why_not)) {
2453     return $self->edit_form($req, $article, $articles, $why_not);
2454   }
2455
2456   require Images;
2457   my @images = Images->getBy(articleId=>$article->{id});
2458   my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
2459   for my $image (@images) {
2460     unlink("$imagedir/$image->{image}");
2461     $image->remove();
2462   }
2463
2464   # remove any step(child|parent) links
2465   require OtherParents;
2466   my @steprels = OtherParents->anylinks($article->{id});
2467   for my $link (@steprels) {
2468     $link->remove();
2469   }
2470
2471   my $parentid = $article->{parentid};
2472   $article->remove;
2473   my $url = $req->cgi->param('r');
2474   unless ($url) {
2475     my $urlbase = admin_base_url($req->cfg);
2476     $url = "$urlbase$ENV{SCRIPT_NAME}?id=$parentid";
2477     $url .= "&message=Article+deleted";
2478   }
2479   return BSE::Template->get_refresh($url, $self->{cfg});
2480 }
2481
2482 sub unhide {
2483   my ($self, $req, $article, $articles) = @_;
2484
2485   if ($req->user_can(edit_field_edit_listed => $article)
2486       && $req->user_can(edit_save => $article)) {
2487     $article->{listed} = 1;
2488     $article->save;
2489
2490     use Util 'generate_article';
2491     generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2492   }
2493   return $self->refresh($article, $req->cgi, undef, 'Article unhidden');
2494 }
2495
2496 sub hide {
2497   my ($self, $req, $article, $articles) = @_;
2498
2499   if ($req->user_can(edit_field_edit_listed => $article)
2500       && $req->user_can(edit_save => $article)) {
2501     $article->{listed} = 0;
2502     $article->save;
2503
2504     use Util 'generate_article';
2505     generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2506   }
2507   my $r = $req->cgi->param('r');
2508   unless ($r) {
2509     $r = admin_base_url($req->cfg)
2510       . "/cgi-bin/admin/add.pl?id=" . $article->{parentid};
2511   }
2512   return $self->refresh($article, $req->cgi, undef, 'Article hidden');
2513 }
2514
2515 sub default_value {
2516   my ($self, $req, $article, $col) = @_;
2517
2518   if ($article->{parentid}) {
2519     my $section = "children of $article->{parentid}";
2520     my $value = $req->cfg->entry($section, $col);
2521     if (defined $value) {
2522       return $value;
2523     }
2524   }
2525   my $section = "level $article->{level}";
2526   my $value = $req->cfg->entry($section, $col);
2527   defined($value) and return $value;
2528
2529   return '';
2530 }
2531
2532 sub flag_sections {
2533   return ( 'article flags' );
2534 }
2535
2536 sub flags {
2537   my ($self) = @_;
2538
2539   my $cfg = $self->{cfg};
2540
2541   my @sections = $self->flag_sections;
2542
2543   my %flags = map $cfg->entriesCS($_), reverse @sections;
2544   my @valid = grep /^\w$/, keys %flags;
2545
2546   return map +{ id => $_, desc => $flags{$_} },
2547     sort { lc($flags{$a}) cmp lc($flags{$b}) }@valid;
2548 }
2549
2550 sub get_images {
2551   my ($self, $article) = @_;
2552
2553   $article->images;
2554 }
2555
2556 sub validate_image_name {
2557   my ($self, $name, $rmsg) = @_;
2558
2559   1; # no extra validation
2560 }
2561
2562 1;
2563
2564 =head1 NAME
2565
2566   BSE::Edit::Article - editing functionality for BSE articles
2567
2568 =head1 AUTHOR
2569
2570 Tony Cook <tony@develop-help.com>
2571
2572 =head1 REVISION
2573
2574 $Revision$
2575
2576 =cut