$title

+EOF + + $trans = translate ('%s stats by %s'); + $title = sprintf ($trans, $channel, $user); + + $trans = translate ('Statistics generated on %s'); + my $time_msg = sprintf ($trans, $generated_time); + + $trans = translate ('Hours'); + + print $fh <$title +

$time_msg

+ + + + + + + + +

$trans 0-5

$trans 6-11

$trans 12-17

$trans 18-24

+ +EOF +} + +# this routine adds a box to the end of the html- +# page with onis' homepage URL, the author's name +# and email-address. Feel free to uncomment the +# creation of this box if it's appereance nags +# you.. +sub close_file +{ + my $runtime = time () - $time_start; + my $now = scalar (localtime ()); + my $total_lines = get_total_lines () || 0; + my $lines_per_sec = 'infinite'; + + my $hp = translate ("onis' homepage"); + my $gen = translate ('This page was generated on %s with %s'); + my $stats = translate ('%u lines processed in %u seconds (%s lines per second)'); + my $by = translate ('onis is written %s by %s'); + my $link = translate ('Get the latest version from %s'); + + my $lps = translate ('infinite'); + if ($runtime) + { + $lps = sprintf ("%.1f", ($total_lines / $runtime)); + } + + print $fh < + + + + +EOF + print $fh ' \n +

'; + printf $fh ($gen, $now, "onis $::VERSION ("onis not irc stats")"); + print $fh "
\n "; + printf $fh ($stats, $total_lines, $runtime, $lps); + print $fh qq#\n

\n #; + printf $fh ($by, '2000-2004', 'Florian octo Forster <octo@nospam.verplant.org>'); + print $fh qq#

# if ($PUBLIC_PAGE); + print $fh "
\n "; + printf $fh ($link, sprintf (qq#%s#, $hp)); + + print $fh < +

+ + + +EOF +} + +sub html_escape +{ + my @retval = (); + + foreach (@_) + { + my $esc = escape_uris ($_); + push (@retval, $esc); + } + + if (wantarray ()) + { + return @retval; + } + else + { + return join ("\n", @retval); + } +} + +sub escape_uris +{ + my $text = shift; + my $retval = ''; + + return ('') if (!defined ($text)); + + #if ($text =~ m#(?:(?:ftp|https?)://|www\.)[\w\.-]+\.[A-Za-z]{2,4}(?::\d+)?(?:/[\w\d\.\%/-~]+)?(?=\W|$)#i) + if ($text =~ m#(?:(?:ftp|https?)://|www\.)[\w\.-]+\.[A-Za-z]{2,4}(?::\d+)?(?:/[\w\d\.\%\/\-\~]*(?:\?[\+\w\&\%\=]+)?)?(?=\W|$)#i) + { + my $orig_match = $&; + my $prematch = $`; + my $postmatch = $'; + + my $match = $orig_match; + if ($match =~ /^www/i) { $match = 'http://' . $match; } + if ($match !~ m#://.+/#) { $match .= '/'; } + + if ((length ($orig_match) > 50) and ($orig_match =~ m#^http://#)) + { + $orig_match =~ s#^http://##; + } + if (length ($orig_match) > 50) + { + my $len = length ($orig_match) - 47; + substr ($orig_match, 47, $len, '...'); + } + + $retval = escape_normal ($prematch); + $retval .= qq($orig_match); + $retval .= escape_uris ($postmatch); + } + else + { + $retval = escape_normal ($text); + } + + return ($retval); +} + +sub escape_normal +{ + my $text = shift; + + return ('') if (!defined ($text)); + + $text =~ s/\&/\&/g; + $text =~ s/"/\"/g; + $text =~ s//\>/g; + + # german umlauts + $text =~ s/ä/\ä/g; + $text =~ s/ö/\ö/g; + $text =~ s/ü/\ü/g; + $text =~ s/Ä/\Ä/g; + $text =~ s/Ü/\Ö/g; + $text =~ s/Ö/\Ü/g; + $text =~ s/ß/\ß/g; + + if ($WANT_COLOR) + { + $text = find_colors ($text); + } + else + { + $text =~ s/[\cB\c_\cV\cO]|\cC(?:\d+(?:,\d+)?)?//g; + } + + return ($text); +} + +sub find_colors +{ + my $string = shift; + my $open_spans = 0; + + my $code_ref; + + my %flags = + ( + span_open => 0, + fg_color => -1, + bg_color => -1, + bold => 0, + underline => 0, + 'reverse' => 0 + ); + + while ($string =~ m/([\cB\c_\cV\cO])|(\cC)(?:(\d+)(?:,(\d+))?)?/g) + { + my $controlchar = $1 ? $1 : $2; + my $fg = defined ($3) ? $3 : -1; + my $bg = defined ($4) ? $4 : -1; + + my $prematch = $`; + my $postmatch = $'; + + my $newspan = ""; + + # Close open spans first + if ($flags{'span_open'}) + { + $newspan .= ""; + $flags{'span_open'} = 0; + } + + # To catch `\cC' without anything following.. + if (($controlchar eq "\cC") and ($fg == -1) and ($bg == -1)) + { + $flags{'fg_color'} = -1; + $flags{'bg_color'} = -1; + } + elsif ($controlchar eq "\cC") + { + if ($fg != -1) + { + $flags{'fg_color'} = $fg % scalar (@mirc_colors); + } + if ($bg != -1) + { + $flags{'bg_color'} = $bg % scalar (@mirc_colors); + } + } + elsif ($controlchar eq "\cB") + { + $flags{'bold'} = 1 - $flags{'bold'}; + } + elsif ($controlchar eq "\c_") + { + $flags{'underline'} = 1 - $flags{'underline'}; + } + elsif ($controlchar eq "\cV") + { + $flags{'reverse'} = 1 - $flags{'reverse'}; + } + # reset + elsif ($controlchar eq "\cO") + { + $flags{'fg_color'} = -1; + $flags{'bg_color'} = -1; + $flags{'bold'} = 0; + $flags{'underline'} = 0; + $flags{'reverse'} = 0; + } + + # build the new span-tag + if (($flags{'fg_color'} != -1) || ($flags{'bg_color'} != -1) + || $flags{'bold'} || $flags{'underline'}) + { + my $fg = $flags{'fg_color'}; + my $bg = $flags{'bg_color'}; + my @style = (); + + if ($flags{'reverse'} and ($bg != -1)) + { + $fg = $flags{'bg_color'}; + $bg = $flags{'fg_color'}; + } + + if ($fg != -1) + { + push (@style, 'color: ' . $mirc_colors[$fg] . ';'); + } + if ($bg != -1) + { + push (@style, 'background-color: ' . $mirc_colors[$bg] . ';'); + } + if ($flags{'bold'}) + { + push (@style, 'font-weight: bold;'); + } + if ($flags{'underline'}) + { + push (@style, 'text-decoration: underline;'); + } + + $newspan .= ''; + $flags{'span_open'} = 1; + } + + $string = $prematch . $newspan . $postmatch; + } + + if ($flags{'span_open'}) + { + $string .= ""; + $flags{'span_open'} = 0; + } + + return ($string); +} -- 2.11.0