view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

    my $idx  = $nav{idx};
    my $jnl  = $nav{jnl};
    my $js = heredoc(<<"    EOD", 4);
    <script type='text/javascript'>
    function handleKey(e) {
      var key;
      if ( e == null ) { // IE
	key = event.keyCode
      }
      else { // Mozilla
	if ( e.altKey || e.ctrlKey ) {
	  return true
	}
	key = e.which
      }
      switch(key) {
    EOD

    $js .= "    case   8: window.location = '$prev'; break // Backspace\n" if $prev;
    $js .= "    case  32: window.location = '$next'; break // Space\n"     if $next;
    $js .= "    case  13: window.location = '$down'; break // Enter\n"     if $down;
    $js .= "    case  43: window.location = '$down'; break // '+'\n"       if $down;
    $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.