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