view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

    my $next = $nav{next};
    my $prev = $nav{prev};
    my $up   = $nav{up};
    my $down = $nav{down};
    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 117: window.location = '$up'; break // 'u'\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);

    $level  = 0 unless defined $level;
    $active = 1 unless defined $active;
    $tag .= "-gr" unless $active;
    $level = "../" x $level;
    $level .= $lib_common . "/" if $lib_common ne "";
    my $b = img("${level}icons/$tag.png", align => "top",
		border => 0, alt => "[$Tag]");
    $active ? "<a class='info' href='$link' alt='[$Tag]'>$b</a>" : $b;
}

sub ixname($) {
    my ($x) = @_;
    "index" . ($x ? $x : "") . ".html";
}

# 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;
	# 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);
	};
    };
    no warnings 'redefine';
    *html = sub($) {
	my ($t) = @_;
	return '' unless $t;
	$t =~ s/&/&amp;/g;