view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

    $js .= "    case 117: window.location = '$up'; break // 'u'\n"         if $up;
    $js .= "    case  45: window.location = '$up'; break // '-'\n"         if $up;
    $js .= "    case 100: window.location = '$idx'; break // 'd'\n"        if $idx;
    $js .= "    case 106: window.location = '$jnl'; break // 'j'\n"        if $jnl;

    $js .= heredoc(<<"    EOD", 4);
       default:
      }
      return false
    }
    
    document.onkeypress = handleKey
    </script>
    EOD
    $js;
}

sub button($$;$$) {
    my ($tag, $link, $level, $active) = @_;
    my $Tag = ucfirst($tag);
    local $fjoin = \&hjoin;

    $level  = 0 unless defined $level;
    $active = 1 unless defined $active;
    $tag .= "-gr" unless $active;
    my @path;
    push(@path, ("..") x $level) if $level;
    push(@path, d_icons("$tag.png"));
    my $path = $fjoin->(@path);
    my $b = img($path, class => "button",
		alt => "[$Tag]");
    $active ? "<a class='info' href='$link' title='$Tag'>$b</a>" : $b;
}

sub hbuttons {
    my (@b) = @_;

    # When using a <table>, it seems to be impossible to get it
    # aligned properly on the journal pages. Apparently,
    # <td align=right> semantics cannot be implemented using CSS.

    "<div class='hb'>".
    join("", map { $_ } @b).
    "</div>";
}

sub vbuttons {
    my (@b) = @_;
    "<table class='vb'>".
    join("", map { "<tr><td>$_</td></tr>"} @b).
    "</table>";
}

sub ixname($;$) {
    my ($n, $rel) = @_;
    my $f = sprintf("index%04d.html", $n + 1);
    return $f if $rel;
    d_index($f);
}

# To aid XHTML compliancy.
sub br { "<br />" }

# Pseudo-smart approach to creating paired single/double quotes.
# Note that the (s-|s\s|t\s) case is specific to the dutch language,
# but probably won't harm other languages...
# Yes, you'll get stupid results with input like rock'n'roll.

sub fixquotes($) {
    my ($t) = @_;

    # HTML::Entities will already have turned " into &quot; -- undo.
    $t =~ s/\&quot;/"/g;
    while ( $t =~ /^([^"]*)"([^"]+)"(.*)/s ) {
	$t = $1 . "&ldquo;" . $2 . "&rdquo;" . $3;
    }
    $t =~ s/"/&quot;/g;

    # HTML::Entities will already have turned ' into &#39; -- undo.
    $t =~ s/\&#39;/'/g;
    while ( $t =~ /^(.*?)'(s-|s\s|t\s)(.*)/s ) {
	$t = $1 . "&apos;" . $2 . $3;
    }
    while ( $t =~ /^([^']*)'([^']+)'(.*)/s ) {
	$t = $1 . "&lsquo;" . $2 . "&rsquo;" . $3;
    }
    $t;
}

# Escape sensitive characters in HTML.
# Two variants: one using HTML::Entities, the other a dumber stub.
# If HTML::Entities is available, it will be used.

sub html($) {
    eval {
	require HTML::Entities;

	if ( !$encoding or $encoding =~ /^(iso-?8859-?15|latin-?9)$/i ) {
	    # Apply Latin-9 instead of Latin-1.
	    no warnings 'once';
	    for ( \%HTML::Entities::char2entity ) {
		$_->{chr(0204)} = '&euro;';
		$_->{chr(0246)} = '&Scaron;';
		$_->{chr(0250)} = '&scaron;';
		$_->{chr(0264)} = '&Zcaron;';
		$_->{chr(0270)} = '&zcaron;';
		$_->{chr(0274)} = '&OE;';
		$_->{chr(0275)} = '&oe;';
		$_->{chr(0276)} = '&Yuml;';
	    }
	}
	no warnings 'redefine';
	*html = sub($) {
	    my ($t) = @_;
	    return '' unless $t;
	    $t = HTML::Entities::encode($t);
	    fixquotes($t);
	};
    };
    if ( $@ ) {
	if ( $encoding ) {