package Perl::Tidy::HtmlWriter;
use strict;
use warnings;
-our $VERSION = '20220217';
+our $VERSION = '20230309';
+use English qw( -no_match_vars );
use File::Basename;
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
+
# class variables
use vars qw{
%html_color
BEGIN {
if ( !eval { require HTML::Entities; 1 } ) {
- $missing_html_entities = $@ ? $@ : 1;
+ $missing_html_entities = $EVAL_ERROR ? $EVAL_ERROR : 1;
}
if ( !eval { require Pod::Html; 1 } ) {
- $missing_pod_html = $@ ? $@ : 1;
+ $missing_pod_html = $EVAL_ERROR ? $EVAL_ERROR : 1;
}
-}
+} ## end BEGIN
sub AUTOLOAD {
======================================================================
EOM
exit 1;
-}
+} ## end sub AUTOLOAD
sub DESTROY {
( $html_fh, my $html_filename ) =
Perl::Tidy::streamhandle( $html_file, 'w' );
unless ($html_fh) {
- Perl::Tidy::Warn("can't open $html_file: $!\n");
+ Perl::Tidy::Warn("can't open $html_file: $ERRNO\n");
return;
}
$html_file_opened = 1;
( $title, my $path ) = fileparse($input_file);
}
my $toc_item_count = 0;
- my $in_toc_package = "";
+ my $in_toc_package = EMPTY_STRING;
my $last_level = 0;
return bless {
_input_file => $input_file, # name of input file
# name changes
_rlast_level => \$last_level, # brace indentation level
}, $class;
-}
+} ## end sub new
sub close_object {
my ($object) = @_;
# returns true if close works, false if not
# failure probably means there is no close method
return eval { $object->close(); 1 };
-}
+} ## end sub close_object
sub add_toc_item {
my $end_package_list = sub {
if ( ${$rin_toc_package} ) {
$html_toc_fh->print("</ul>\n</li>\n");
- ${$rin_toc_package} = "";
+ ${$rin_toc_package} = EMPTY_STRING;
}
return;
};
TOC_END
}
return;
-}
+} ## end sub add_toc_item
BEGIN {
);
# These token types will all be called identifiers for now
- # FIXME: could separate user defined modules as separate type
my @identifier = qw< i t U C Y Z G :: CORE::>;
@token_short_names{@identifier} = ('i') x scalar(@identifier);
# my @list = qw" .. -> <> ... \ ? ";
# @token_long_names{@list} = ('misc-operators') x scalar(@list);
-}
+} ## end BEGIN
sub make_getopt_long_names {
my ( $class, $rgetopt_names ) = @_;
push @{$rgetopt_names}, "podheader!";
push @{$rgetopt_names}, "podindex!";
return;
-}
+} ## end sub make_getopt_long_names
sub make_abbreviated_names {
${$rexpansion}{"text"} = ["html-toc-extension"];
${$rexpansion}{"sext"} = ["html-src-extension"];
return;
-}
+} ## end sub make_abbreviated_names
sub check_options {
}
$missing_html_entities = 1 unless $rOpts->{'html-entities'};
return;
-}
+} ## end sub check_options
sub write_style_sheet_file {
my $css_filename = shift;
my $fh;
unless ( $fh = IO::File->new("> $css_filename") ) {
- Perl::Tidy::Die("can't open $css_filename: $!\n");
+ Perl::Tidy::Die("can't open $css_filename: $ERRNO\n");
}
write_style_sheet_data($fh);
close_object($fh);
return;
-}
+} ## end sub write_style_sheet_file
sub write_style_sheet_data {
my $long_name = $short_to_long_names{$short_name};
my $abbrev = '.' . $short_name;
- if ( length($short_name) == 1 ) { $abbrev .= ' ' } # for alignment
+ if ( length($short_name) == 1 ) { $abbrev .= SPACE } # for alignment
my $color = $html_color{$short_name};
if ( !defined($color) ) { $color = $text_color }
$fh->print("$abbrev \{ color: $color;");
$fh->print("} /* $long_name */\n");
}
return;
-}
+} ## end sub write_style_sheet_data
sub set_default_color {
if ( $rOpts->{$key} ) { $color = $rOpts->{$key} }
$rOpts->{$key} = check_RGB($color);
return;
-}
+} ## end sub set_default_color
sub check_RGB {
my ($color) = @_;
if ( $color =~ /^[0-9a-fA-F]{6,6}$/ ) { $color = "#$color" }
return $color;
-}
+} ## end sub check_RGB
sub set_default_properties {
my ( $short_name, $color, $bold, $italic ) = @_;
$key = "html-italic-$short_to_long_names{$short_name}";
$rOpts->{$key} = ( defined $rOpts->{$key} ) ? $rOpts->{$key} : $italic;
return;
-}
+} ## end sub set_default_properties
sub pod_to_html {
# this error shouldn't happen ... we just used this filename
Perl::Tidy::Warn(
"unable to open temporary file $tmpfile; cannot use pod2html\n");
- goto RETURN;
+ return $success_flag;
}
my $html_fh = $self->{_html_fh};
# This routine will write the html selectively and store the toc
my $html_print = sub {
- foreach (@_) {
- $html_fh->print($_) unless ($no_print);
- if ($in_toc) { push @toc, $_ }
+ foreach my $line (@_) {
+ $html_fh->print($line) unless ($no_print);
+ if ($in_toc) { push @toc, $line }
}
return;
};
# the necessary perltidy html sections
my ( $saw_body, $saw_index, $saw_body_end );
- my $timestamp = "";
+ my $timestamp = EMPTY_STRING;
if ( $rOpts->{'timestamp'} ) {
my $date = localtime;
$timestamp = "on $date";
$html_print->("<hr />\n") if $rOpts->{'frames'};
$html_print->("<h2>Code Index:</h2>\n");
##my @toc = map { $_ .= "\n" } split /\n/, $toc_string;
- my @toc = map { $_ . "\n" } split /\n/, $toc_string;
- $html_print->(@toc);
+ my @toc_st = map { $_ . "\n" } split /\n/, $toc_string;
+ $html_print->(@toc_st);
}
- $in_toc = "";
+ $in_toc = EMPTY_STRING;
$no_print = 0;
}
$html_print->("<hr />\n") if $rOpts->{'frames'};
$html_print->("<h2>Code Index:</h2>\n");
##my @toc = map { $_ .= "\n" } split /\n/, $toc_string;
- my @toc = map { $_ . "\n" } split /\n/, $toc_string;
- $html_print->(@toc);
+ my @toc_st = map { $_ . "\n" } split /\n/, $toc_string;
+ $html_print->(@toc_st);
}
- $in_toc = "";
+ $in_toc = EMPTY_STRING;
$ul_level = 0;
$no_print = 0;
}
$success_flag = 0;
}
- RETURN:
close_object($html_fh);
# note that we have to unlink tmpfile before making frames
# because the tmpfile may be one of the names used for frames
if ( -e $tmpfile ) {
unless ( unlink($tmpfile) ) {
- Perl::Tidy::Warn("couldn't unlink temporary file $tmpfile: $!\n");
+ Perl::Tidy::Warn(
+ "couldn't unlink temporary file $tmpfile: $ERRNO\n");
$success_flag = 0;
}
}
$self->make_frame( \@toc );
}
return $success_flag;
-}
+} ## end sub pod_to_html
sub make_frame {
$title = escape_html($title);
# FUTURE input parameter:
- my $top_basename = "";
+ my $top_basename = EMPTY_STRING;
# We need to produce 3 html files:
# 1. - the table of contents
# 2. The current .html filename is renamed to be the contents panel
rename( $html_filename, $src_filename )
- or Perl::Tidy::Die("Cannot rename $html_filename to $src_filename:$!\n");
+ or Perl::Tidy::Die(
+ "Cannot rename $html_filename to $src_filename: $ERRNO\n");
# 3. Then use the original html filename for the frame
write_frame_html(
$toc_basename, $src_basename, $src_frame_name
);
return;
-}
+} ## end sub make_frame
sub write_toc_html {
# write a separate html table of contents file for frames
my ( $title, $toc_filename, $src_basename, $rtoc, $src_frame_name ) = @_;
my $fh = IO::File->new( $toc_filename, 'w' )
- or Perl::Tidy::Die("Cannot open $toc_filename:$!\n");
+ or Perl::Tidy::Die("Cannot open $toc_filename: $ERRNO\n");
$fh->print(<<EOM);
<html>
<head>
my $first_anchor =
change_anchor_names( $rtoc, $src_basename, "$src_frame_name" );
- $fh->print( join "", @{$rtoc} );
+ $fh->print( join EMPTY_STRING, @{$rtoc} );
$fh->print(<<EOM);
</body>
EOM
return;
-}
+} ## end sub write_toc_html
sub write_frame_html {
) = @_;
my $fh = IO::File->new( $frame_filename, 'w' )
- or Perl::Tidy::Die("Cannot open $toc_basename:$!\n");
+ or Perl::Tidy::Die("Cannot open $toc_basename: $ERRNO\n");
$fh->print(<<EOM);
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
</html>
EOM
return;
-}
+} ## end sub write_frame_html
sub change_anchor_names {
}
}
return $first_anchor;
-}
+} ## end sub change_anchor_names
sub close_html_file {
my $self = shift;
# --------------------------------------------------
my $input_file = $self->{_input_file};
my $title = escape_html($input_file);
- my $timestamp = "";
+ my $timestamp = EMPTY_STRING;
if ( $rOpts->{'timestamp'} ) {
my $date = localtime;
$timestamp = "on $date";
$self->make_frame( \@toc );
}
return;
-}
+} ## end sub close_html_file
sub markup_tokens {
my ( $self, $rtokens, $rtoken_type, $rlevels ) = @_;
my $rlast_level = $self->{_rlast_level};
my $rpackage_stack = $self->{_rpackage_stack};
- for ( my $j = 0 ; $j < @{$rtoken_type} ; $j++ ) {
+ foreach my $j ( 0 .. @{$rtoken_type} - 1 ) {
$type = $rtoken_type->[$j];
$token = $rtokens->[$j];
$level = $rlevels->[$j];
$type = 'M';
# but don't include sub declarations in the toc;
- # these wlll have leading token types 'i;'
- my $signature = join "", @{$rtoken_type};
+ # these will have leading token types 'i;'
+ my $signature = join EMPTY_STRING, @{$rtoken_type};
unless ( $signature =~ /^i;/ ) {
my $subname = $token;
$subname =~ s/[\s\(].*$//; # remove any attributes and prototype
push @colored_tokens, $token;
}
return ( \@colored_tokens );
-}
+} ## end sub markup_tokens
sub markup_html_element {
my ( $self, $token, $type ) = @_;
if ( $html_bold{$short_name} ) { $token = "<b>$token</b>" }
}
return $token;
-}
+} ## end sub markup_html_element
sub escape_html {
HTML::Entities::encode_entities($token);
}
return $token;
-}
+} ## end sub escape_html
sub finish_formatting {
my $self = shift;
$self->close_html_file();
return;
-}
+} ## end sub finish_formatting
sub write_line {
$html_line = $1;
}
else {
- $html_line = "";
+ $html_line = EMPTY_STRING;
}
my ($rcolored_tokens) =
$self->markup_tokens( $rtokens, $rtoken_type, $rlevels );
- $html_line .= join '', @{$rcolored_tokens};
+ $html_line .= join EMPTY_STRING, @{$rcolored_tokens};
}
# markup line of non-code..
# otherwise, just clear the current string and start
# over
else {
- ${$rpre_string} = "";
+ ${$rpre_string} = EMPTY_STRING;
$html_pod_fh->print("\n");
}
}
# add the line number if requested
if ( $rOpts->{'html-line-numbers'} ) {
my $extra_space =
- ( $line_number < 10 ) ? " "
- : ( $line_number < 100 ) ? " "
- : ( $line_number < 1000 ) ? " "
- : "";
- $html_line = $extra_space . $line_number . " " . $html_line;
+ ( $line_number < 10 ) ? SPACE x 3
+ : ( $line_number < 100 ) ? SPACE x 2
+ : ( $line_number < 1000 ) ? SPACE
+ : EMPTY_STRING;
+ $html_line = $extra_space . $line_number . SPACE . $html_line;
}
# write the line
$html_pre_fh->print("$html_line\n");
return;
-}
+} ## end sub write_line
1;