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