site/cgi-bin/modules/Generate.pm

   1 package Generate;
   2 use strict;
   3 use Articles;
   4 use Constants qw($IMAGEDIR $LOCAL_FORMAT $BODY_EMBED
   5                  $EMBED_MAX_DEPTH $HAVE_HTML_PARSER);
   6 use DevHelp::Tags;
   7 use DevHelp::HTML;
   8 use BSE::Util::Tags;
   9 use BSE::CfgInfo qw(custom_class);
  10
  11 my $excerptSize = 300;
  12
  13 sub new {
  14   my ($class, %opts) = @_;
  15   $opts{maxdepth} = $EMBED_MAX_DEPTH unless exists $opts{maxdepth};
  16   $opts{depth} = 0 unless $opts{depth};
  17   return bless \%opts, $class;
  18 }
  19
  20 # replace commonly used characters
  21 # like MS dumb-quotes
  22 # unfortunately some browsers^W^Wnetscape don't support the entities yet <sigh>
  23 sub make_entities {
  24   my $text = shift;
  25
  26   $text =~ s/\226/-/g; # "--" looks ugly
  27   $text =~ s/\222/'/g;
  28   $text =~ s/\221/`/g;
  29   $text =~ s/\&#8217;/'/g;
  30
  31   return $text;
  32 }
  33
  34 sub summarize {
  35   my ($self, $articles, $text, $acts, $length) = @_;
  36
  37   # remove any block level formatting
  38   $self->remove_block($articles, $acts, \$text);
  39
  40   $text =~ tr/\n\r / /s;
  41
  42   if (length $text > $length) {
  43     $text = substr($text, 0, $length);
  44     $text =~ s/\s+\S+$//;
  45
  46     # roughly balance [ and ]
  47     my $temp = $text;
  48     1 while $temp =~ s/\s\[[^\]]*\]//; # eliminate matched
  49     my $count = 0;
  50     ++$count while $temp =~ s/\w\[[^\]]*$//; # count unmatched
  51
  52     $text .= ']' x $count;
  53     $text .= '...';
  54   }
  55
  56   # the formatter now adds <p></p> around the text, but we don't
  57   # want that here
  58   my $result = $self->format_body({}, $articles, $text, 'tr', 1, 0);
  59   $result =~ s!<p>|</p>!!g;
  60
  61   return $result;
  62 }
  63
  64 # attempts to move the given position forward if it's within a HTML tag,
  65 # entity or just a word
  66 sub adjust_for_html {
  67   my ($self, $text, $pos) = @_;
  68
  69   # advance if in a tag
  70   return $pos + length $1
  71     if substr($text, 0, $pos) =~ /<[^<>]*$/
  72       && substr($text, $pos) =~ /^([^<>]*>)/;
  73   return $pos + length $1
  74     if substr($text, 0, $pos) =~ /&[^;&]*$/
  75       && substr($text, $pos) =~ /^([^;&]*;)/;
  76   return $pos + length $1
  77     if $pos <= length $text
  78       && substr($text, $pos-1, 1) =~ /\w$/
  79       && substr($text, $pos) =~ /^(\w+)/;
  80
  81   return $pos;
  82 }
  83
  84 # sub _make_hr {
  85 #   my ($width, $height) = @_;
  86 #   my $tag = "<hr";
  87 #   $tag .= qq!width="$width"! if length $width;
  88 #   $tag .= qq!height="$height"! if length $height;
  89 #   $tag .= " />";
  90 #   return $tag;
  91 # }
  92
  93 # # produces a table, possibly with options for the <table> and <tr> tags
  94 # sub _make_table {
  95 #   my ($options, $text) = @_;
  96 #   my $tag = "<table";
  97 #   my $cellend = '';
  98 #   my $cellstart = '';
  99 #   if ($options =~ /=/) {
 100 #     $tag .= " " . $options;
 101 #   }
 102 #   elsif ($options =~ /\S/) {
 103 #     $options =~ s/\s+$//;
 104 #     my ($width, $bg, $pad, $fontsz, $fontface) = split /\|/, $options;
 105 #     for ($width, $bg, $pad, $fontsz, $fontface) {
 106 #       $_ = '' unless defined;
 107 #     }
 108 #     $tag .= qq! width="$width"! if length $width;
 109 #     $tag .= qq! bgcolor="$bg"! if length $bg;
 110 #     $tag .= qq! cellpadding="$pad"! if length $pad;
 111 #     if (length $fontsz || length $fontface) {
 112 #       $cellstart = qq!<font!;
 113 #       $cellstart .= qq! size="$fontsz"! if length $fontsz;
 114 #       $cellstart .= qq! face="$fontface"! if length $fontface;
 115 #       $cellstart .= qq!>!;
 116 #       $cellend = "</font>";
 117 #     }
 118 #   }
 119 #   $tag .= ">";
 120 #   my @rows = split '\n', $text;
 121 #   my $maxwidth = 0;
 122 #   for my $row (@rows) {
 123 #     my ($opts, @cols) = split /\|/, $row;
 124 #     $tag .= "<tr";
 125 #     if ($opts =~ /=/) {
 126 #       $tag .= " ".$opts;
 127 #     }
 128 #     $tag .= "><td>$cellstart".join("$cellend</td><td>$cellstart", @cols)
 129 #       ."$cellend</td></tr>";
 130 #   }
 131 #   $tag .= "</table>";
 132 #   return $tag;
 133 # }
 134
 135 # # make a UL
 136 # sub _format_bullets {
 137 #   my ($text) = @_;
 138
 139 #   $text =~ s/^\s+|\s+$//g;
 140 #   my @points = split /(?:\r?\n)?\*\*\s*/, $text;
 141 #   shift @points if @points and $points[0] eq '';
 142 #   return '' unless @points;
 143 #   for my $point (@points) {
 144 #     $point =~ s!\n$!<br /><br />!;
 145 #   }
 146 #   return "<ul><li>".join("<li>", @points)."</ul>";
 147 # }
 148
 149 # # make a OL
 150 # sub _format_ol {
 151 #   my ($text) = @_;
 152 #   $text =~ s/^\s+|\s+$//g;
 153 #   my @points = split /(?:\r?\n)?##\s*/, $text;
 154 #   shift @points if @points and $points[0] eq '';
 155 #   return '' unless @points;
 156 #   for my $point (@points) {
 157 #     #print STDERR  "point: ",unpack("H*", $point),"\n";
 158 #     $point =~ s!\n$!<br /><br />!;
 159 #   }
 160 #   return "<ol><li>".join("<li>", @points)."</ol>";
 161 # }
 162
 163 # raw html - this has some limitations
 164 # the input text has already been escaped, so we need to unescape it
 165 # too bad if you want [] in your html (but you can use entities)
 166 sub _make_html {
 167   return unescape_html($_[0]);
 168 }
 169
 170 sub _embed_low {
 171   my ($self, $acts, $articles, $what, $template, $maxdepth) = @_;
 172
 173   $maxdepth = $self->{maxdepth}
 174     if !$maxdepth || $maxdepth > $self->{maxdepth};
 175   #if ($self->{depth}) {
 176   #  print STDERR "Embed depth $self->{depth}\n";
 177   #}
 178   if ($self->{depth} > $self->{maxdepth}) {
 179     if ($self->{maxdepth} == $EMBED_MAX_DEPTH) {
 180       return "** too many embedding levels **";
 181     }
 182     else {
 183       return '';
 184     }
 185   }
 186
 187   my $id;
 188   if ($what !~ /^\d+$/) {
 189     # not an article id, assume there's an article here we can use
 190     $id = $acts->{$what} && $acts->{$what}->('id');
 191     unless ($id && $id =~ /^\d+$/) {
 192       # save it for later
 193       defined $template or $template = "-";
 194       return "<:embed $what $template $maxdepth:>";
 195     }
 196   }
 197   else {
 198     $id = $what;
 199   }
 200   my $embed = $articles->getByPkey($id);
 201   if ($embed) {
 202     my $gen = $self;
 203     if (ref($self) ne $embed->{generator}) {
 204       my $genname = $embed->{generator};
 205       $genname =~ s#::#/#g; # broken on MacOS I suppose
 206       $genname .= ".pm";
 207       eval {
 208         require $genname;
 209       };
 210       if ($@) {
 211         print STDERR "Cannot load generator $embed->{generator}: $@\n";
 212         return "** Cannot load generator $embed->{generator} for article $id **";
 213       }
 214       my $top = $self->{top} || $embed;
 215       $gen = $embed->{generator}->new(admin=>$self->{admin}, cfg=>$self->{cfg},
 216                                       request=>$self->{request}, top=>$top);
 217     }
 218
 219     # a rare appropriate use of local
 220     # it's a pity that it's broken before 5.8
 221     #local $gen->{depth} = $self->{depth}+1;
 222     #local $gen->{maxdepth} = $maxdepth;
 223     #$template = "" if defined($template) && $template eq "-";
 224     #return $gen->embed($embed, $articles, $template);
 225
 226     my $olddepth = $gen->{depth};
 227     $gen->{depth} = $self->{depth}+1;
 228     my $oldmaxdepth = $gen->{maxdepth};
 229     $gen->{maxdepth} = $maxdepth;
 230     $template = "" if defined($template) && $template eq "-";
 231     my $result = $gen->embed($embed, $articles, $template);
 232     $gen->{depth} = $olddepth;
 233     $gen->{maxdepth} = $oldmaxdepth;
 234
 235     return $result;
 236   }
 237   else {
 238     return "** Cannot find article $id to be embedded **";
 239   }
 240 }
 241
 242 sub _body_embed {
 243   my ($self, $acts, $articles, $which, $template, $maxdepth) = @_;
 244
 245   my $text = $self->_embed_low($acts, $articles, $which, $template, $maxdepth);
 246
 247   return $text;
 248 }
 249
 250 sub _make_img {
 251   my ($args, $imagePos, $images) = @_;
 252
 253   my ($index, $align, $url) = split /\|/, $args, 3;
 254   my $text = '';
 255   if ($index >=1 && $index <= @$images) {
 256 # I considered this
 257 #      if (!$align) {
 258 #        $align = $$imagePos =~ /r/ ? 'right' : 'left';
 259 #        $$imagePos =~ tr/rl/lr/; # I wonder
 260 #      }
 261     my $im = $images->[$index-1];
 262     $text = qq!<img src="/images/$im->{image}" width="$im->{width}"!
 263       . qq! height="$im->{height}" alt="! . escape_html($im->{alt}).'"'
 264         . qq! border="0"!;
 265     $text .= qq! align="$align"! if $align && $align ne 'center';
 266     $text .= qq! />!;
 267     $text = qq!<div align="center">$text</div>!
 268       if $align && $align eq 'center';
 269     if (!$url && $im->{url}) {
 270       $url = $im->{url};
 271     }
 272     if ($url) {
 273       $text = qq!<a href="! . escape_html($url) . qq!">$text</a>!;
 274     }
 275   }
 276   return $text;
 277 }
 278
 279 # replace markup, insert img tags
 280 sub format_body {
 281   my ($self, $acts, $articles, $body, $imagePos, $abs_urls,
 282       $auto_images, @images)  = @_;
 283
 284   return substr($body, 6) if $body =~ /^<html>/i;
 285
 286   require BSE::Formatter;
 287
 288   my $formatter = BSE::Formatter->new($self, $acts, $articles,
 289                                       $abs_urls, \$auto_images,
 290                                       \@images);
 291
 292   $body = $formatter->format($body);
 293
 294   # we don't format named images
 295   @images = grep $_->{name} eq '', @images;
 296   if ($auto_images && @images) {
 297     # the first image simply goes where we're told to put it
 298     # the imagePos is [tb][rl] (top|bottom)(right|left)
 299     my $align = $imagePos =~ /r/ ? 'right' : 'left';
 300
 301     # Offset the end a bit so we don't get an image hanging as obviously
 302     # off the end.
 303     # Numbers determined by trial - it can still look pretty rough.
 304     my $len = length $body;
 305     if ($len > 1000) {
 306       $len -= 500;
 307     }
 308     elsif ($len > 800) {
 309       $len -= 200;
 310     }
 311
 312     #my $incr = @images > 1 ? 2*$len / (2*@images+1) : 0;
 313     my $incr = $len / @images;
 314     # inserting the image tags moves character positions around
 315     # so we need the temp buffer
 316     if ($imagePos =~ /b/) {
 317       @images = reverse @images;
 318       if (@images % 2 == 0) {
 319         # starting at the bottom, swap it around
 320         $align = $align eq 'right' ? 'left' : 'right';
 321       }
 322     }
 323     my $output = '';
 324     for my $image (@images) {
 325       # adjust to make sure this isn't in the middle of a tag or entity
 326       my $pos = $self->adjust_for_html($body, $incr);
 327
 328       # assuming 5.005_03 would make this simpler, but <sigh>
 329       my $img = qq!<img src="/images/$image->{image}"!
 330         .qq! width="$image->{width}" height="$image->{height}" border="0"!
 331           .qq! alt="$image->{alt}" align="$align" hspace="10" vspace="10" />!;
 332       if ($image->{url}) {
 333         $img = qq!<a href="$image->{url}">$img</a>!;
 334       }
 335       $output .= $img;
 336       $output .= substr($body, 0, $pos);
 337       substr($body, 0, $pos) = '';
 338       $align = $align eq 'right' ? 'left' : 'right';
 339     }
 340     $body = $output . $body; # don't forget the rest of it
 341   }
 342
 343   return make_entities($body);
 344 }
 345
 346 sub embed {
 347   my ($self, $article, $articles, $template) = @_;
 348
 349   if (defined $template && $template =~ /\$/) {
 350     $template =~ s/\$/$article->{template}/;
 351   }
 352   else {
 353     $template = $article->{template}
 354       unless defined($template) && $template =~ /\S/;
 355   }
 356
 357   my $html = BSE::Template->get_source($template, $self->{cfg});
 358
 359   # the template will hopefully contain <:embed start:> and <:embed end:>
 360   # tags
 361   # otherwise pull out the body content
 362   if ($html =~ /<:\s*embed\s*start\s*:>(.*)<:\s*embed\s*end\s*:>/s
 363      || $html =~ m"<\s*body[^>]*>(.*)<\s*/\s*body>"s) {
 364     $html = $1;
 365   }
 366   return $self->generate_low($html, $article, $articles, 1);
 367 }
 368
 369 sub iter_kids_of {
 370   my ($args, $acts, $name, $templater) = @_;
 371
 372   my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
 373   for my $id (@ids) {
 374     unless ($id =~ /^\d+$|^-1$/) {
 375       $id = $templater->perform($acts, $id, "id");
 376     }
 377   }
 378   @ids = grep /^\d+$|^-1$/, @ids;
 379   map Articles->listedChildren($_), @ids;
 380 }
 381
 382 sub iter_all_kids_of {
 383   my ($args, $acts, $name, $templater) = @_;
 384
 385   my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
 386   for my $id (@ids) {
 387     unless ($id =~ /^\d+$|^-1$/) {
 388       $id = $templater->perform($acts, $id, "id");
 389     }
 390   }
 391   @ids = grep /^\d+$|^-1$/, @ids;
 392   map Articles->all_visible_kids($_), @ids;
 393 }
 394
 395 sub iter_inlines {
 396   my ($args, $acts, $name, $templater) = @_;
 397
 398   my @ids = map { split } DevHelp::Tags->get_parms($args, $acts, $templater);
 399   for my $id (@ids) {
 400     unless ($id =~ /^\d+$/) {
 401       $id = $templater->perform($acts, $id, "id");
 402     }
 403   }
 404   @ids = grep /^\d+$/, @ids;
 405   map Articles->getByPkey($_), @ids;
 406 }
 407
 408 sub baseActs {
 409   my ($self, $articles, $acts, $article, $embedded) = @_;
 410
 411   # used to generate the side menu
 412   my $section_index = -1;
 413   my @sections = $articles->listedChildren(-1);
 414     #sort { $a->{displayOrder} <=> $b->{displayOrder} }
 415     #grep $_->{listed}, $articles->sections;
 416   my $subsect_index = -1;
 417   my @subsections; # filled as we move through the sections
 418   my @level3; # filled as we move through the subsections
 419   my $level3_index = -1;
 420
 421   my $cfg = $self->{cfg} || BSE::Cfg->new;
 422   my %extras = $cfg->entriesCS('extra tags');
 423   for my $key (keys %extras) {
 424     # follow any links
 425     my $data = $cfg->entryVar('extra tags', $key);
 426     $extras{$key} = sub { $data };
 427   }
 428   return
 429     (
 430      %extras,
 431
 432      custom_class($cfg)->base_tags($articles, $acts, $article, $embedded, $cfg),
 433      BSE::Util::Tags->static($acts, $self->{cfg}),
 434      # for embedding the content from children and other sources
 435      ifEmbedded=> sub { $embedded },
 436      embed => sub {
 437        my ($what, $template, $maxdepth) = split ' ', $_[0];
 438        undef $maxdepth if defined $maxdepth && $maxdepth !~ /^\d+/;
 439        return $self->_embed_low($acts, $articles, $what, $template, $maxdepth);
 440      },
 441      ifCanEmbed=> sub { $self->{depth} <= $self->{maxdepth} },
 442
 443      summary =>
 444      sub {
 445        my ($which, $acts, $name, $templater) = @_;
 446        $which or $which = "child";
 447        $acts->{$which}
 448          or return "<:summary $which Cannot find $which:>";
 449        my $id = $templater->perform($acts, $which, "id")
 450          or return "<:summary $which No id returned :>";
 451        my $article = $articles->getByPkey($id)
 452          or return "<:summary $which Cannot find article $id:>";
 453        return $self->summarize($articles, $article->{body}, $acts,
 454                                $article->{summaryLength})
 455      },
 456      ifAdmin => sub { $self->{admin} },
 457
 458      # for generating the side menu
 459      iterate_level1_reset => sub { $section_index = -1 },
 460      iterate_level1 => sub {
 461        ++$section_index;
 462        if ($section_index < @sections) {
 463          #@subsections = grep $_->{listed},
 464          #  $articles->children($sections[$section_index]->{id});
 465          @subsections = grep { $_->{listed} != 2 }
 466            $articles->listedChildren($sections[$section_index]->{id});
 467          $subsect_index = -1;
 468          return 1;
 469        }
 470        else {
 471          return 0;
 472        }
 473      },
 474      level1 => sub {
 475        return escape_html($sections[$section_index]{$_[0]});
 476      },
 477
 478      # used to generate a list of subsections for the side-menu
 479      iterate_level2 => sub {
 480        ++$subsect_index;
 481        if ($subsect_index < @subsections) {
 482          @level3 = grep { $_->{listed} != 2 }
 483            $articles->listedChildren($subsections[$subsect_index]{id});
 484          $level3_index = -1;
 485          return 1;
 486        }
 487        return 0;
 488      },
 489      level2 => sub {
 490        return escape_html($subsections[$subsect_index]{$_[0]});
 491      },
 492      ifLevel2 =>
 493      sub {
 494        return scalar @subsections;
 495      },
 496
 497      # possibly level3 items
 498      iterate_level3 => sub {
 499        return ++$level3_index < @level3;
 500      },
 501      level3 => sub { escape_html($level3[$level3_index]{$_[0]}) },
 502      ifLevel3 => sub { scalar @level3 },
 503
 504      # generate an admin or link url, depending on admin state
 505      url=>
 506      sub {
 507        my ($name, $acts, $func, $templater) = @_;
 508        my $item = $self->{admin} ? 'admin' : 'link';
 509        $acts->{$name} or return "<:url $name:>";
 510        return $templater->perform($acts, $name, $item);
 511      },
 512      ifInMenu =>
 513      sub {
 514        $acts->{$_[0]} or return 0;
 515        return $acts->{$_[0]}->('listed') == 1;
 516      },
 517      titleImage=>
 518      sub {
 519        my ($image, $text) = split ' ', $_[0];
 520        if (-e $IMAGEDIR."/titles/".$image) {
 521          return qq!<img src="/images/titles/!.$image .qq!" border=0>!
 522        }
 523        else {
 524          return escape_html($text);
 525        }
 526      },
 527      DevHelp::Tags->make_iterator2
 528      ( \&iter_kids_of, 'ofchild', 'children_of' ),
 529      DevHelp::Tags->make_iterator2
 530      ( \&iter_all_kids_of, 'ofallkid', 'allkids_of' ),
 531      DevHelp::Tags->make_iterator2
 532      ( \&iter_inlines, 'inline', 'inlines' ),
 533      gimage =>
 534      sub {
 535        my ($name, $align, $rest) = split ' ', $_[0], 3;
 536
 537        my $im = $self->get_gimage($name)
 538          or return '';
 539
 540        $self->_format_image($im, $align, $rest);
 541      },
 542     );
 543 }
 544
 545 sub find_terms {
 546   my ($body, $case_sensitive, @terms) = @_;
 547
 548   # locate the terms
 549   my @found;
 550   if ($case_sensitive) {
 551     for my $term (@terms) {
 552       if ($$body =~ /^(.*?)\Q$term/s) {
 553         push(@found, [ length($1), $term ]);
 554       }
 555     }
 556   }
 557   else {
 558     for my $term (@terms) {
 559       if ($$body =~ /^(.*?)\Q$term/is) {
 560         push(@found, [ length($1), $term ]);
 561       }
 562     }
 563   }
 564
 565   return @found;
 566 }
 567
 568 # this takes the same inputs as _make_table(), but eliminates any
 569 # markup instead
 570 sub _cleanup_table {
 571   my ($opts, $data) = @_;
 572   my @lines = split /\n/, $data;
 573   for (@lines) {
 574     s/^[^|]*\|//;
 575     tr/|/ /s;
 576   }
 577   return join(' ', @lines);
 578 }
 579
 580 # produce a nice excerpt for a found article
 581 sub excerpt {
 582   my ($self, $article, $found, $case_sensitive, @terms) = @_;
 583
 584   my $body = $article->{body};
 585
 586   # we remove any formatting tags here, otherwise we get wierd table
 587   # rubbish or other formatting in the excerpt.
 588   $self->remove_block('Articles', [], \$body);
 589   1 while $body =~ s/[bi]\[([^\]\[]+)\]/$1/g;
 590
 591   $body = escape_html($body);
 592
 593   my @found = find_terms(\$body, $case_sensitive, @terms);
 594
 595   my @reterms = @terms;
 596   for (@reterms) {
 597     tr/ / /s;
 598     $_ = quotemeta;
 599     s/\\?\s+/\\s+/g;
 600   }
 601   # do a reverse sort so that the longer terms (and composite
 602   # terms) are replaced first
 603   my $re_str = join("|", reverse sort @reterms);
 604   my $re;
 605   my $cfg = $self->{cfg};
 606   if ($cfg->entryBool('basic', 'highlight_partial', 1)) {
 607     $re = $case_sensitive ? qr/\b($re_str)/ : qr/\b($re_str)/i;
 608   }
 609   else {
 610     $re = $case_sensitive ? qr/\b($re_str)\b/ : qr/\b($re_str)\b/i;
 611   }
 612
 613   # this used to try searching children as well, but it broke more
 614   # than it fixed
 615   if (!@found) {
 616     # we tried hard and failed
 617     # return a generic article
 618     if (length $body > $excerptSize) {
 619       $body = substr($body, 0, $excerptSize);
 620       $body =~ s/\S+\s*$/.../;
 621     }
 622     $$found = 0;
 623     return $body;
 624   }
 625
 626   # only the first 5
 627   splice(@found, 5,-1) if @found > 5;
 628   my $itemSize = $excerptSize / @found;
 629
 630   # try to combine any that are close
 631   @found = sort { $a->[0] <=> $b->[0] } @found;
 632   for my $i (reverse 0 .. $#found-1) {
 633     if ($found[$i+1][0] - $found[$i][0] < $itemSize) {
 634       my @losing = @{$found[$i+1]};
 635       shift @losing;
 636       push(@{$found[$i]}, @losing);
 637       splice(@found, $i+1, 1); # remove it
 638     }
 639   }
 640
 641   my $termSize = $excerptSize / @found;
 642   my $result = '';
 643   for my $term (@found) {
 644     my ($pos, @terms) = @$term;
 645     my $start = $pos - $termSize/2;
 646     my $part;
 647     if ($start < 0) {
 648       $start = 0;
 649       $part = substr($body, 0, $termSize);
 650     }
 651     else {
 652       $result .= "...";
 653       $part = substr($body, $start, $termSize);
 654       $part =~ s/^\w+//;
 655     }
 656     if ($start + $termSize < length $body) {
 657       $part =~ s/\s*\S*$/... /;
 658     }
 659     $result .= $part;
 660   }
 661   $result =~ s{$re}{<b>$1</b>}ig;
 662   $$found = 1;
 663
 664   return $result;
 665 }
 666
 667 sub visible {
 668   return 1;
 669 }
 670
 671 # # removes any html tags from the supplied text
 672 # sub _strip_html {
 673 #   my ($text) = @_;
 674
 675 #   if ($HAVE_HTML_PARSER) {
 676 #     my $out = '';
 677 #     # don't forget that require is smart
 678 #     require "HTML/Parser.pm";
 679
 680 #     # this may need to detect and skip <script></script> and stylesheets
 681 #     my $ignore_text = 0; # non-zero in a <script></script> or <style></style>
 682 #     my $start_h =
 683 #       sub {
 684 #       ++$ignore_text if $_[0] eq 'script' or $_[0] eq 'style';
 685 #       if ($_[0] eq 'img' && $_[1]{alt} && !$ignore_text) {
 686 #         $out .= $_[1]{alt};
 687 #       }
 688 #       };
 689 #     my $end_h =
 690 #       sub {
 691 #       --$ignore_text if $_[0] eq 'script' or $_[0] eq 'style';
 692 #       };
 693 #     my $text_h =
 694 #       sub {
 695 #       $out .= $_[0] unless $ignore_text
 696 #       };
 697 #     my $p = HTML::Parser->new( text_h  => [ $text_h,  "dtext" ],
 698 #                                start_h => [ $start_h, "tagname, attr" ],
 699 #                                end_h   => [ $end_h,   "tagname" ]);
 700 #     $p->parse($text);
 701 #     $p->eof();
 702
 703 #     $text = $out;
 704 #   }
 705 #   else {
 706 #     # this won't work for some HTML, but it's a fallback
 707 #     $text =~ s/<[^>]*>//g;
 708 #   }
 709
 710 #   return $text;
 711 # }
 712
 713 # make whatever text $body points at safe for summarizing by removing most
 714 # block level formatting
 715 sub remove_block {
 716   my ($self, $articles, $acts, $body) = @_;
 717
 718   require BSE::Formatter;
 719
 720   my $formatter = BSE::Formatter->new($self, $acts, $articles,
 721                                       1, \0, []);
 722
 723   $$body = $formatter->remove_format($$body);
 724 }
 725
 726 sub get_gimage {
 727   my ($self, $name) = @_;
 728
 729   unless ($self->{gimages}) {
 730     require Images;
 731     my @gimages = Images->getBy(articleId => -1);
 732     my %gimages = map { $_->{name} => $_ } @gimages;
 733     $self->{gimages} = \%gimages;
 734   }
 735
 736   return $self->{gimages}{$name};
 737 }
 738
 739 sub _format_image {
 740   my ($self, $im, $align, $rest) = @_;
 741
 742   if ($align && exists $im->{$align}) {
 743     return escape_html($im->{$align});
 744   }
 745   else {
 746     my $html = qq!<img src="/images/$im->{image}" width="$im->{width}"!
 747       . qq! height="$im->{height}" alt="! . escape_html($im->{alt})
 748              . qq!"!;
 749     $html .= qq! align="$align"! if $align && $align ne '-';
 750     unless (defined($rest) && $rest =~ /\bborder=/i) {
 751       $html .= ' border="0"';
 752     }
 753     $html .= " $rest" if defined $rest;
 754     $html .= qq! />!;
 755     if ($im->{url}) {
 756       $html = qq!<a href="$im->{url}">$html</a>!;
 757     }
 758     return $html;
 759   }
 760 }
 761
 762 1;
 763
 764 __END__
 765
 766 =head1 NAME
 767
 768 Generate - provides base Squirel::Template actions for use in generating
 769 pages.
 770
 771 =head1 SYNOPSIS
 772
 773 =head1 DESCRIPTION
 774
 775 This is probably better documented in L<templates.pod>.
 776
 777 =head1 COMMON TAGS
 778
 779 These tags can be used anywhere, including in admin templates.  It's
 780 possible some admin code has been missed, if you find a place where
 781 these cannot be used let us know.
 782
 783
 784 =over
 785
 786 =item kb I<data tag>
 787
 788 Formats the give value in kI<whatevers>.  If you have a number that
 789 could go over 1000 and you want it to use the 'k' metric prefix when
 790 it does, use this tag.  eg. <:kb file sizeInBytes:>
 791
 792 =item date I<data tag>
 793
 794 =item date "I<format>" I<data tag>
 795
 796 Formats a date or date/time value from the database into something
 797 more human readable.  If you don't supply a format then the default
 798 format of "%d-%b-%Y" is used ("20-Mar-2002").
 799
 800 The I<format> is a strftime() format specification, if that means
 801 anything to you.  If it doesn't, each code starts with % and are
 802 replaced as follows:
 803
 804 =over
 805
 806 =item %a
 807
 808 abbreviated weekday name
 809
 810 =item %A
 811
 812 full weekday name
 813
 814 =item %b
 815
 816 abbreviated month name
 817
 818 =item %B
 819
 820 full month name
 821
 822 =item %c
 823
 824 "preferred" date and time representation
 825
 826 =item %d
 827
 828 day of the month as a 2 digit number
 829
 830 =item %H
 831
 832 hour (24-hour clock)
 833
 834 =item %I
 835
 836 hour (12-hour clock)
 837
 838 =item %j
 839
 840 day of year as a 3-digit number
 841
 842 =item %m
 843
 844 month as a 2 digit number
 845
 846 =item %M
 847
 848 minute as a 2 digit number
 849
 850 =item %p
 851
 852 AM or PM or their equivalents
 853
 854 =item %S
 855
 856 seconds as a 2 digit number
 857
 858 =item %U
 859
 860 week number as a 2 digit number (first Sunday as the first day of week 1)
 861
 862 =item %w
 863
 864 weekday as a decimal number (0-6)
 865
 866 =item %W
 867
 868 week number as a 2 digit number (first Monday as the first day of week 1)
 869
 870 =item %x
 871
 872 the locale's appropriate date representation
 873
 874 =item %X
 875
 876 the locale's appropriate time representation
 877
 878 =item %y
 879
 880 2-digit year without century
 881
 882 =item %Y
 883
 884 the full year
 885
 886 =item %Z
 887
 888 time zone name or abbreviation
 889
 890 =item %%
 891
 892 just '%'
 893
 894 =back
 895
 896 Your local strftime() implementation may implement some extensions to
 897 the above, if your server is on a Unix system try running "man
 898 strftime" for more information.
 899
 900 =item bodytext I<data tag>
 901
 902 Formats the text from the given tag in the same way that body text is.
 903
 904 =item ifEq I<data1> I<data2>
 905
 906 Checks if the 2 values are exactly equal.  This is a string
 907 comparison.
 908
 909 The 2 data parameters can either be a tag reference in [], a literal
 910 string inside "" or a single word.
 911
 912 =item ifMatch I<data1> I<data2>
 913
 914 Treats I<data2> as a perl regular expression and attempts to match
 915 I<data1> against it.
 916
 917 The 2 data parameters can either be a tag reference in [], a literal
 918 string inside "" or a single word.
 919
 920 =item cfg I<section> I<key>
 921
 922 =item cfg I<section> I<key> I<default>
 923
 924 Retrieves a value from the BSE configuration file.
 925
 926 If you don't supply a default then a default will be the empty string.
 927
 928 =item release
 929
 930 The release number of BSE.
 931
 932 =back
 933
 934 =head1 TAGS
 935
 936 =over 4
 937
 938 =item ifAdmin
 939
 940 Conditional tag, true if generating in admin mode.
 941
 942 =item iterator ... level1
 943
 944 Iterates over the listed level 1 articles.
 945
 946 =item level1 I<name>
 947
 948 The value of the I<name> field of the current level 1 article.
 949
 950 =item iterator ... level2
 951
 952 Iterates over the listed level 2 children of the current level 1 article.
 953
 954 =item level2 I<name>
 955
 956 The value of the I<name> field of the current level 2 article.
 957
 958 =item ifLevel2 I<name>
 959
 960 Conditional tag, true if the current level 1 article has any listed
 961 level 2 children.
 962
 963 =item iterator ... level3
 964
 965 Iterates over the listed level 3 children of the current level 2 article.
 966
 967 =item level3 I<name>
 968
 969 The value of the I<name> field of the current level 3 article.
 970
 971 =item ifLevel3 I<name>
 972
 973 Conditional tag, true if the current level 2 article has any listed
 974 level 3 children.
 975
 976 =item url I<which>
 977
 978 Returns a link to the specified article .  Due to the way the action
 979 list is built, this can be article types defined in derived classes of
 980 Generate, like the C<parent> article in Generate::Article.
 981
 982 =item money I<data tag>
 983
 984 Formats the given value as a monetary value.  This does not include a
 985 currency symbol.  Internally BSE stores monetary values as integers to
 986 prevent the loss of accuracy inherent in floating point numbers.  You
 987 need to use this tag to display any monetary value.
 988
 989 =item ifInMenu I<which>
 990
 991 Conditional tag, true if the given item can appear in a menu.
 992
 993 =item titleImage I<imagename> I<text>
 994
 995 Generates an IMG tag if the given I<imagename> is in the title image
 996 directory ($IMAGEDIR/titles).  If it doesn't exists, produces the
 997 I<text>.
 998
 999 =item embed I<which>
1000
1001 =item embed I<which> I<template>
1002
1003 =item embed I<which> I<template> I<maxdepth>
1004
1005 =item embed child
1006
1007 Embeds the article specified by which using either the specified
1008 template or the articles template.
1009
1010 In this case I<which> can also be an article ID.
1011
1012 I<template> is a filename relative to the templates directory.  If
1013 this is "-" then the articles template is used (so you can set
1014 I<maxdepth> without setting the template.)  If I<template> contains a
1015 C<$> sign it will be replaced with the name of the original template.
1016
1017 If I<maxdepth> is supplied and is less than the current maximum depth
1018 then it becomes the new maximum depth.  This can be used with ifCanEmbed.
1019
1020 =item embed start ... embed end
1021
1022 Marks the range of text that would be embedded in a parent that used
1023 C<embed child>.
1024
1025 =item ifEmbedded
1026
1027 Conditional tag, true if the current article is being embedded.
1028
1029 =back
1030
1031 =head1 BUGS
1032
1033 Needs more documentation.
1034
1035 =cut