diff options
| -rw-r--r-- | foostats.pl | 914 | ||||
| -rw-r--r-- | t/tmp_filter_log | 3 |
2 files changed, 489 insertions, 428 deletions
diff --git a/foostats.pl b/foostats.pl index 4e32a9f..2b2b2fc 100644 --- a/foostats.pl +++ b/foostats.pl @@ -27,34 +27,34 @@ use constant VERSION => 'v0.1.0'; package FileHelper { use JSON; - sub write ( $path, $content ) { + sub write ($path, $content) { open my $fh, '>', "$path.tmp" - or die "\nCannot open file: $!"; + or die "\nCannot open file: $!"; print $fh $content; close $fh; rename - "$path.tmp", - $path; + "$path.tmp", + $path; } - sub write_json_gz ( $path, $data ) { + sub write_json_gz ($path, $data) { my $json = encode_json $data; say "Writing $path"; open my $fd, '>:gzip', "$path.tmp" - or die "$path.tmp: $!"; + or die "$path.tmp: $!"; print $fd $json; close $fd; rename "$path.tmp", $path - or die "$path.tmp: $!"; + or die "$path.tmp: $!"; } sub read_json_gz ($path) { say "Reading $path"; open my $fd, '<:gzip', $path - or die "$path: $!"; + or die "$path: $!"; my $json = decode_json <$fd>; close $fd; return $json; @@ -62,9 +62,9 @@ package FileHelper { sub read_lines ($path) { my @lines; - open( my $fh, '<', $path ) - or die "$path: $!"; - chomp( @lines = <$fh> ); + open(my $fh, '<', $path) + or die "$path: $!"; + chomp(@lines = <$fh>); close($fh); return @lines; } @@ -77,18 +77,18 @@ package DateHelper { my $today = localtime; my @dates; - for my $days_ago ( 0 .. 30 ) { - my $date = $today - ( $days_ago * 24 * 60 * 60 ); + for my $days_ago (0 .. 30) { + my $date = $today - ($days_ago * 24 * 60 * 60); push - @dates, - $date->strftime('%Y%m%d'); + @dates, + $date->strftime('%Y%m%d'); } return @dates; } sub last_n_months_day_dates ($months) { - my $today = localtime; + my $today = localtime; my $start_year = $today->year; my $start_month = $today->mon - $months; while ($start_month <= 0) { $start_month += 12; $start_year--; } @@ -98,7 +98,7 @@ package DateHelper { my $t = $start; while ($t <= $today) { push @dates, $t->strftime('%Y%m%d'); - $t += 24 * 60 * 60; # one day + $t += 24 * 60 * 60; # one day } return @dates; } @@ -117,34 +117,34 @@ package Foostats::Logreader { sub anonymize_ip ($ip) { my $ip_proto = - contains( $ip, ':' ) - ? 'IPv6' - : 'IPv4'; + contains($ip, ':') + ? 'IPv6' + : 'IPv4'; my $ip_hash = sha3_512_base64 $ip; - return ( $ip_hash, $ip_proto ); + return ($ip_hash, $ip_proto); } - sub read_lines ( $glob, $cb ) { + sub read_lines ($glob, $cb) { my sub year ($path) { - localtime( ( stat $path )->mtime )->strftime('%Y'); + localtime((stat $path)->mtime)->strftime('%Y'); } my sub open_file ($path) { my $flag = - $path =~ /\.gz$/ - ? '<:gzip' - : '<'; + $path =~ /\.gz$/ + ? '<:gzip' + : '<'; open my $fd, $flag, $path - or die "$path: $!"; + or die "$path: $!"; return $fd; } my $last = false; - say 'File path glob matches: ' . join( ' ', glob $glob ); + say 'File path glob matches: ' . join(' ', glob $glob); - LAST: - for my $path ( sort { -M $a <=> -M $b } glob $glob ) { + LAST: + for my $path (sort { -M $a <=> -M $b } glob $glob) { say "Processing $path"; my $file = open_file $path; @@ -152,37 +152,37 @@ package Foostats::Logreader { while (<$file>) { next - if contains( $_, 'logfile turned over' ); + if contains($_, 'logfile turned over'); # last == true means: After this file, don't process more $last = true - unless defined $cb->( $year, split / +/ ); + unless defined $cb->($year, split / +/); } say "Closing $path (last:$last)"; close $file; last LAST - if $last; + if $last; } } - sub parse_web_logs ( $last_processed_date, $cb ) { + sub parse_web_logs ($last_processed_date, $cb) { my sub parse_date ($date) { - my $t = Time::Piece->strptime( $date, '[%d/%b/%Y:%H:%M:%S' ); - return ( $t->strftime('%Y%m%d'), $t->strftime('%H%M%S') ); + my $t = Time::Piece->strptime($date, '[%d/%b/%Y:%H:%M:%S'); + return ($t->strftime('%Y%m%d'), $t->strftime('%H%M%S')); } my sub parse_web_line (@line) { - my ( $date, $time ) = parse_date $line [4]; + my ($date, $time) = parse_date $line [4]; return undef - if $date < $last_processed_date; + if $date < $last_processed_date; # X-Forwarded-For? my $ip = - $line[-2] eq '-' - ? $line[1] - : $line[-2]; - my ( $ip_hash, $ip_proto ) = anonymize_ip $ip; + $line[-2] eq '-' + ? $line[1] + : $line[-2]; + my ($ip_hash, $ip_proto) = anonymize_ip $ip; return { proto => 'web', @@ -196,42 +196,41 @@ package Foostats::Logreader { }; } - read_lines web_logs_glob(), sub ( $year, @line ) { - $cb->( parse_web_line @line ); + read_lines web_logs_glob(), sub ($year, @line) { + $cb->(parse_web_line @line); }; } - sub parse_gemini_logs ( $last_processed_date, $cb ) { - my sub parse_date ( $year, @line ) { + sub parse_gemini_logs ($last_processed_date, $cb) { + my sub parse_date ($year, @line) { my $timestr = "$line[0] $line[1]"; - return Time::Piece->strptime( $timestr, '%b %d' ) - ->strftime("$year%m%d"); + return Time::Piece->strptime($timestr, '%b %d')->strftime("$year%m%d"); } - my sub parse_vger_line ( $year, @line ) { + my sub parse_vger_line ($year, @line) { my $full_path = $line[5]; $full_path =~ s/"//g; - my ( $proto, undef, $host, $uri_path ) = - split '/', - $full_path, - 4; + my ($proto, undef, $host, $uri_path) = + split '/', + $full_path, + 4; $uri_path = '' - unless defined $uri_path; + unless defined $uri_path; return { proto => 'gemini', host => $host, uri_path => "/$uri_path", status => $line[6], - date => int( parse_date( $year, @line ) ), + date => int(parse_date($year, @line)), time => $line[2], }; } - my sub parse_relayd_line ( $year, @line ) { - my $date = int( parse_date( $year, @line ) ); + my sub parse_relayd_line ($year, @line) { + my $date = int(parse_date($year, @line)); - my ( $ip_hash, $ip_proto ) = anonymize_ip $line [12]; + my ($ip_hash, $ip_proto) = anonymize_ip $line [12]; return { ip_hash => $ip_hash, ip_proto => $ip_proto, @@ -240,26 +239,26 @@ package Foostats::Logreader { }; } - # Expect one vger and one relayd log line per event! So collect - # both events (one from one log line each) and then merge the result hash! - my ( $vger, $relayd ); - read_lines gemini_logs_glob(), sub ( $year, @line ) { - if ( $line[4] eq 'vger:' ) { + # Expect one vger and one relayd log line per event! So collect + # both events (one from one log line each) and then merge the result hash! + my ($vger, $relayd); + read_lines gemini_logs_glob(), sub ($year, @line) { + if ($line[4] eq 'vger:') { $vger = parse_vger_line $year, @line; } - elsif ( $line[5] eq 'relay' - and startswith( $line[6], 'gemini' ) ) + elsif ($line[5] eq 'relay' + and startswith($line[6], 'gemini')) { $relayd = parse_relayd_line $year, @line; return undef - if $relayd->{date} < $last_processed_date; + if $relayd->{date} < $last_processed_date; } if ( defined $vger and defined $relayd - and $vger->{time} eq $relayd->{time} ) + and $vger->{time} eq $relayd->{time}) { - $cb->( { %$vger, %$relayd } ); + $cb->({ %$vger, %$relayd }); $vger = $relayd = undef; } @@ -267,9 +266,8 @@ package Foostats::Logreader { }; } - sub parse_logs ( $last_web_date, $last_gemini_date, $odds_file, $odds_log ) - { - my $agg = Foostats::Aggregator->new( $odds_file, $odds_log ); + sub parse_logs ($last_web_date, $last_gemini_date, $odds_file, $odds_log) { + my $agg = Foostats::Aggregator->new($odds_file, $odds_log); say "Last web date: $last_web_date"; say "Last gemini date: $last_gemini_date"; @@ -289,26 +287,26 @@ package Foostats::Logreader { package Foostats::Filter { use String::Util qw(contains startswith endswith); - sub new ( $class, $odds_file, $log_path ) { + sub new ($class, $odds_file, $log_path) { say "Logging filter to $log_path"; my @odds = FileHelper::read_lines($odds_file); bless { odds => \@odds, log_path => $log_path - }, - $class; + }, + $class; } - sub ok ( $self, $event ) { + sub ok ($self, $event) { state %blocked = (); return false - if exists $blocked{ $event->{ip_hash} }; + if exists $blocked{ $event->{ip_hash} }; if ( $self->odd($event) - or $self->excessive($event) ) + or $self->excessive($event)) { - ( $blocked{ $event->{ip_hash} } //= 0 )++; + ($blocked{ $event->{ip_hash} } //= 0)++; return false; } else { @@ -316,54 +314,52 @@ package Foostats::Filter { } } - sub odd ( $self, $event ) { + sub odd ($self, $event) { \my $uri_path = \$event->{uri_path}; - for ( $self->{odds}->@* ) { + for ($self->{odds}->@*) { next if !defined $_ || $_ eq '' || /^\s*#/; next - unless contains( $uri_path, $_ ); + unless contains($uri_path, $_); - $self->log( 'WARN', $uri_path, - "contains $_ and is odd and will therefore be blocked!" ); + $self->log('WARN', $uri_path, "contains $_ and is odd and will therefore be blocked!"); return true; } - $self->log( 'OK', $uri_path, "appears fine..." ); + $self->log('OK', $uri_path, "appears fine..."); return false; } - sub log ( $self, $severity, $subject, $message ) { + sub log ($self, $severity, $subject, $message) { state %dedup; # Don't log if path was already logged return - if exists $dedup{$subject}; + if exists $dedup{$subject}; $dedup{$subject} = 1; - open( my $fh, '>>', $self->{log_path} ) - or die $self->{log_path} . ": $!"; + open(my $fh, '>>', $self->{log_path}) + or die $self->{log_path} . ": $!"; print $fh "$severity: $subject $message\n"; close($fh); } - sub excessive ( $self, $event ) { + sub excessive ($self, $event) { \my $time = \$event->{time}; \my $ip_hash = \$event->{ip_hash}; state $last_time = $time; # Time with second: 'HH:MM:SS' state %count = (); # IPs accessing within the same second! - if ( $last_time ne $time ) { + if ($last_time ne $time) { $last_time = $time; %count = (); return false; } # IP requested site more than once within the same second!? - if ( 1 < ++( $count{$ip_hash} //= 0 ) ) { - $self->log( 'WARN', $ip_hash, - "blocked due to excessive requesting..." ); + if (1 < ++($count{$ip_hash} //= 0)) { + $self->log('WARN', $ip_hash, "blocked due to excessive requesting..."); return true; } @@ -380,17 +376,17 @@ package Foostats::Aggregator { GEMFEED_URI_2 => '/gemfeed/', }; - sub new ( $class, $odds_file, $odds_log ) { + sub new ($class, $odds_file, $odds_log) { bless { - filter => Foostats::Filter->new( $odds_file, $odds_log ), + filter => Foostats::Filter->new($odds_file, $odds_log), stats => {} - }, - $class; + }, + $class; } - sub add ( $self, $event ) { + sub add ($self, $event) { return undef - unless defined $event; + unless defined $event; my $date = $event->{date}; my $date_key = $event->{proto} . "_$date"; @@ -400,9 +396,7 @@ package Foostats::Aggregator { # - feed_ips: unique IPs per feed type (atom_feed, gemfeed) # - page_ips: unique IPs per host and per URL $self->{stats}{$date_key} //= { - count => { - filtered => 0, - }, + count => { filtered => 0, }, feed_ips => { atom_feed => {}, gemfeed => {}, @@ -414,56 +408,56 @@ package Foostats::Aggregator { }; \my $s = \$self->{stats}{$date_key}; - unless ( $self->{filter}->ok($event) ) { + unless ($self->{filter}->ok($event)) { $s->{count}{filtered}++; return $event; } - $self->add_count( $s, $event ); - $self->add_page_ips( $s, $event ) - unless $self->add_feed_ips( $s, $event ); + $self->add_count($s, $event); + $self->add_page_ips($s, $event) + unless $self->add_feed_ips($s, $event); return $event; } - sub add_count ( $self, $stats, $event ) { + sub add_count ($self, $stats, $event) { \my $c = \$stats->{count}; \my $e = \$event; - ( $c->{ $e->{proto} } //= 0 )++; - ( $c->{ $e->{ip_proto} } //= 0 )++; + ($c->{ $e->{proto} } //= 0)++; + ($c->{ $e->{ip_proto} } //= 0)++; } - sub add_feed_ips ( $self, $stats, $event ) { + sub add_feed_ips ($self, $stats, $event) { \my $f = \$stats->{feed_ips}; \my $e = \$event; # Atom feed (exact path match, allow optional query string) - if ( $e->{uri_path} =~ m{^/gemfeed/atom\.xml(?:[?#].*)?$} ) { - ( $f->{atom_feed}->{ $e->{ip_hash} } //= 0 )++; + if ($e->{uri_path} =~ m{^/gemfeed/atom\.xml(?:[?#].*)?$}) { + ($f->{atom_feed}->{ $e->{ip_hash} } //= 0)++; return 1; } # Gemfeed index: '/gemfeed/' or '/gemfeed/index.gmi' (optionally with query) - if ( $e->{uri_path} =~ m{^/gemfeed/(?:index\.gmi)?(?:[?#].*)?$} ) { - ( $f->{gemfeed}->{ $e->{ip_hash} } //= 0 )++; + if ($e->{uri_path} =~ m{^/gemfeed/(?:index\.gmi)?(?:[?#].*)?$}) { + ($f->{gemfeed}->{ $e->{ip_hash} } //= 0)++; return 1; } return 0; } - sub add_page_ips ( $self, $stats, $event ) { + sub add_page_ips ($self, $stats, $event) { \my $e = \$event; \my $p = \$stats->{page_ips}; return - if !endswith( $e->{uri_path}, '.html' ) - && !endswith( $e->{uri_path}, '.gmi' ); + if !endswith($e->{uri_path}, '.html') + && !endswith($e->{uri_path}, '.gmi'); - ( $p->{hosts}->{ $e->{host} }->{ $e->{ip_hash} } //= 0 )++; - ( $p->{urls}->{ $e->{host} . $e->{uri_path} }->{ $e->{ip_hash} } //= - 0 )++; + ($p->{hosts}->{ $e->{host} }->{ $e->{ip_hash} } //= 0)++; + ($p->{urls}->{ $e->{host} . $e->{uri_path} }->{ $e->{ip_hash} } //= + 0)++; } } @@ -472,43 +466,41 @@ package Foostats::FileOutputter { use Sys::Hostname; use PerlIO::gzip; - sub new ( $class, %args ) { + sub new ($class, %args) { my $self = bless \%args, $class; mkdir $self->{stats_dir} - or die $self->{stats_dir} . ": $!" - unless -d $self->{stats_dir}; + or die $self->{stats_dir} . ": $!" + unless -d $self->{stats_dir}; return $self; } - sub last_processed_date ( $self, $proto ) { - my $hostname = hostname(); - my @processed = - glob $self->{stats_dir} . "/${proto}_????????.$hostname.json.gz"; + sub last_processed_date ($self, $proto) { + my $hostname = hostname(); + my @processed = glob $self->{stats_dir} . "/${proto}_????????.$hostname.json.gz"; my ($date) = - @processed - ? ( $processed[-1] =~ /_(\d{8})\.$hostname\.json.gz/ ) - : 0; + @processed + ? ($processed[-1] =~ /_(\d{8})\.$hostname\.json.gz/) + : 0; return int($date); } sub write ($self) { $self->for_dates( - sub ( $self, $date_key, $stats ) { + sub ($self, $date_key, $stats) { my $hostname = hostname(); - my $path = - $self->{stats_dir} . "/${date_key}.$hostname.json.gz"; + my $path = $self->{stats_dir} . "/${date_key}.$hostname.json.gz"; FileHelper::write_json_gz - $path, - $stats; + $path, + $stats; } ); } - sub for_dates ( $self, $cb ) { - $cb->( $self, $_, $self->{stats}{$_} ) for sort - keys $self->{stats}->%*; + sub for_dates ($self, $cb) { + $cb->($self, $_, $self->{stats}{$_}) for sort + keys $self->{stats}->%*; } } @@ -518,7 +510,7 @@ package Foostats::Replicator { use LWP::UserAgent; use String::Util qw(endswith); - sub replicate ( $stats_dir, $partner_node ) { + sub replicate ($stats_dir, $partner_node) { say "Replicating from $partner_node"; for my $proto (qw(gemini web)) { @@ -532,51 +524,50 @@ package Foostats::Replicator { "https://$partner_node/foostats/$dest_path", "$stats_dir/$dest_path", $count++ - < - 3 + < + 3 , # Always replicate the newest 3 files. ); } } } - sub replicate_file ( $remote_url, $dest_path, $force ) { + sub replicate_file ($remote_url, $dest_path, $force) { # $dest_path already exists, not replicating it return - if !$force - && -f $dest_path; + if !$force + && -f $dest_path; say "Replicating $remote_url to $dest_path (force:$force)... "; my $response = LWP::UserAgent->new->get($remote_url); - unless ( $response->is_success ) { + unless ($response->is_success) { say "\nFailed to fetch the file: " . $response->status_line; return; } FileHelper::write - $dest_path, - $response->decoded_content; + $dest_path, + $response->decoded_content; say 'done'; } } package Foostats::Merger { - # Removed Data::Dumper (debug-only) per review. + # Removed Data::Dumper (debug-only) per review. sub merge ($stats_dir) { my %merge; - $merge{$_} = merge_for_date( $stats_dir, $_ ) - for DateHelper::last_month_dates; + $merge{$_} = merge_for_date($stats_dir, $_) for DateHelper::last_month_dates; return %merge; } - sub merge_for_date ( $stats_dir, $date ) { + sub merge_for_date ($stats_dir, $date) { printf - "Merging for date %s\n", - $date; + "Merging for date %s\n", + $date; - my @stats = stats_for_date( $stats_dir, $date ); + my @stats = stats_for_date($stats_dir, $date); return { feed_ips => feed_ips(@stats), count => count(@stats), @@ -584,9 +575,9 @@ package Foostats::Merger { }; } - sub merge_ips ( $a, $b, $key_transform = undef ) { - my sub merge ( $a, $b ) { - while ( my ( $key, $val ) = each %$b ) { + sub merge_ips ($a, $b, $key_transform = undef) { + my sub merge ($a, $b) { + while (my ($key, $val) = each %$b) { $a->{$key} //= 0; $a->{$key} += $val; } @@ -594,52 +585,52 @@ package Foostats::Merger { my $is_num = qr/^\d+(\.\d+)?$/; - while ( my ( $key, $val ) = each %$b ) { + while (my ($key, $val) = each %$b) { $key = $key_transform->($key) - if defined $key_transform; + if defined $key_transform; - if ( not exists $a->{$key} ) { + if (not exists $a->{$key}) { $a->{$key} = $val; } - elsif (ref( $a->{$key} ) eq 'HASH' - && ref($val) eq 'HASH' ) + elsif (ref($a->{$key}) eq 'HASH' + && ref($val) eq 'HASH') { - merge( $a->{$key}, $val ); + merge($a->{$key}, $val); } elsif ($a->{$key} =~ $is_num - && $val =~ $is_num ) + && $val =~ $is_num) { $a->{$key} += $val; } else { die -"Not merging tkey '%s' (ref:%s): '%s' (ref:%s) with '%s' (ref:%s)\n", - $key, - ref($key), $a->{$key}, - ref( $a->{$key} ), - $val, - ref($val); + "Not merging tkey '%s' (ref:%s): '%s' (ref:%s) with '%s' (ref:%s)\n", + $key, + ref($key), $a->{$key}, + ref($a->{$key}), + $val, + ref($val); } } } sub feed_ips (@stats) { - my ( %gemini, %web ); + my (%gemini, %web); for my $stats (@stats) { my $merge = - $stats->{proto} eq 'web' - ? \%web - : \%gemini; + $stats->{proto} eq 'web' + ? \%web + : \%gemini; printf - "Merging proto %s feed IPs\n", - $stats->{proto}; - merge_ips( $merge, $stats->{feed_ips} ); + "Merging proto %s feed IPs\n", + $stats->{proto}; + merge_ips($merge, $stats->{feed_ips}); } my %total; - merge_ips( \%total, $web{$_} ) for keys %web; - merge_ips( \%total, $gemini{$_} ) for keys %gemini; + merge_ips(\%total, $web{$_}) for keys %web; + merge_ips(\%total, $gemini{$_}) for keys %gemini; my %merge = ( 'Total' => scalar keys %total, @@ -656,7 +647,7 @@ package Foostats::Merger { my %merge; for my $stats (@stats) { - while ( my ( $key, $val ) = each $stats->{count}->%* ) { + while (my ($key, $val) = each $stats->{count}->%*) { $merge{$key} //= 0; $merge{$key} += $val; } @@ -671,7 +662,7 @@ package Foostats::Merger { hosts => {} ); - for my $key ( keys %merge ) { + for my $key (keys %merge) { merge_ips( $merge{$key}, $_->{page_ips}->{$key}, @@ -683,25 +674,24 @@ package Foostats::Merger { ) for @stats; # Keep only uniq IP count - $merge{$key}->{$_} = scalar keys $merge{$key}->{$_}->%* - for keys $merge{$key}->%*; + $merge{$key}->{$_} = scalar keys $merge{$key}->{$_}->%* for keys $merge{$key}->%*; } return \%merge; } - sub stats_for_date ( $stats_dir, $date ) { + sub stats_for_date ($stats_dir, $date) { my @stats; for my $proto (qw(gemini web)) { for my $path (<$stats_dir/${proto}_${date}.*.json.gz>) { printf - "Reading %s\n", - $path; + "Reading %s\n", + $path; push - @stats, - FileHelper::read_json_gz($path); - @{ $stats[-1] }{qw(proto path)} = ( $proto, $path ); + @stats, + FileHelper::read_json_gz($path); + @{ $stats[-1] }{qw(proto path)} = ($proto, $path); } } @@ -714,7 +704,7 @@ package Foostats::Reporter { use HTML::Entities qw(encode_entities); sub truncate_url { - my ( $url, $max_length ) = @_; + my ($url, $max_length) = @_; $max_length //= 100; # Default to 100 characters return $url if length($url) <= $max_length; @@ -725,44 +715,44 @@ package Foostats::Reporter { my $available_length = $max_length - $ellipsis_length; # Split available length between start and end, favoring the end - my $keep_start = int( $available_length * 0.4 ); # 40% for start + my $keep_start = int($available_length * 0.4); # 40% for start my $keep_end = $available_length - $keep_start; # 60% for end - my $start = substr( $url, 0, $keep_start ); - my $end = substr( $url, -$keep_end ); + my $start = substr($url, 0, $keep_start); + my $end = substr($url, -$keep_end); return $start . $ellipsis . $end; } sub truncate_urls_for_table { - my ( $url_rows, $count_column_header ) = @_; + my ($url_rows, $count_column_header) = @_; # Calculate the maximum width needed for the count column my $max_count_width = length($count_column_header); for my $row (@$url_rows) { - my $count_width = length( $row->[1] ); + my $count_width = length($row->[1]); $max_count_width = $count_width if $count_width > $max_count_width; } # Row format: "| URL... | count |" with padding # Calculate: "| " (2) + URL + " | " (3) + count_with_padding + " |" (2) my $max_url_length = 100 - 7 - $max_count_width; - $max_url_length = 70 if $max_url_length > 70; # Cap at reasonable length + $max_url_length = 70 if $max_url_length > 70; # Cap at reasonable length # Truncate URLs in place for my $row (@$url_rows) { - $row->[0] = truncate_url( $row->[0], $max_url_length ); + $row->[0] = truncate_url($row->[0], $max_url_length); } } sub format_table { - my ( $headers, $rows ) = @_; + my ($headers, $rows) = @_; my @widths; - for my $col ( 0 .. $#{$headers} ) { - my $max_width = length( $headers->[$col] ); + for my $col (0 .. $#{$headers}) { + my $max_width = length($headers->[$col]); for my $row (@$rows) { - my $len = length( $row->[$col] ); + my $len = length($row->[$col]); $max_width = $len if $len > $max_width; } push @widths, $max_width; @@ -770,10 +760,10 @@ package Foostats::Reporter { my $header_line = '|'; my $separator_line = '|'; - for my $col ( 0 .. $#{$headers} ) { + for my $col (0 .. $#{$headers}) { $header_line .= - sprintf( " %-*s |", $widths[$col], $headers->[$col] ); - $separator_line .= '-' x ( $widths[$col] + 2 ) . '|'; + sprintf(" %-*s |", $widths[$col], $headers->[$col]); + $separator_line .= '-' x ($widths[$col] + 2) . '|'; } my @table_lines; @@ -783,33 +773,35 @@ package Foostats::Reporter { for my $row (@$rows) { my $row_line = '|'; - for my $col ( 0 .. $#{$row} ) { - $row_line .= sprintf( " %-*s |", $widths[$col], $row->[$col] ); + for my $col (0 .. $#{$row}) { + $row_line .= sprintf(" %-*s |", $widths[$col], $row->[$col]); } push @table_lines, $row_line; } push @table_lines, $separator_line; # Add bottom terminator - return join( "\n", @table_lines ); + return join("\n", @table_lines); } # Convert gemtext to HTML sub gemtext_to_html { - my ($content) = @_; - my $html = ""; - my $in_code_block = 0; - my $in_list = 0; - my @lines = split /\n/, $content; + my ($content) = @_; + my $html = ""; + my $in_code_block = 0; + my $in_list = 0; + my @lines = split /\n/, $content; my @code_block_lines = (); - + for my $line (@lines) { if ($line =~ /^```/) { if ($in_code_block) { + # End code block - check if it's a table if (is_ascii_table(\@code_block_lines)) { $html .= convert_ascii_table_to_html(\@code_block_lines); - } else { + } + else { $html .= "<pre>\n"; for my $code_line (@code_block_lines) { $html .= encode_entities($code_line) . "\n"; @@ -817,18 +809,19 @@ package Foostats::Reporter { $html .= "</pre>\n"; } @code_block_lines = (); - $in_code_block = 0; - } else { + $in_code_block = 0; + } + else { $in_code_block = 1; } next; } - + if ($in_code_block) { push @code_block_lines, $line; next; } - + # Skip 365-day summary section header in HTML output if ($line =~ /^## 365-Day Summary Reports\s*$/) { next; @@ -839,94 +832,106 @@ package Foostats::Reporter { $html .= "</ul>\n"; $in_list = 0; } - + # Headers if ($line =~ /^### (.*)/) { $html .= "<h3>" . encode_entities($1) . "</h3>\n"; - } elsif ($line =~ /^## (.*)/) { + } + elsif ($line =~ /^## (.*)/) { $html .= "<h2>" . encode_entities($1) . "</h2>\n"; - } elsif ($line =~ /^# (.*)/) { + } + elsif ($line =~ /^# (.*)/) { $html .= "<h1>" . encode_entities($1) . "</h1>\n"; } + # Links elsif ($line =~ /^=> (\S+)\s+(.*)/) { my ($url, $text) = ($1, $2); + # Drop 365-day summary links from HTML output if ($url =~ /(?:^|[\/.])365day_summary_\d{8}\.gmi$/) { next; } + # Convert .gmi links to .html $url =~ s/\.gmi$/\.html/; $html .= "<p><a href=\"" . encode_entities($url) . "\">" . encode_entities($text) . "</a></p>\n"; } + # Bullet points elsif ($line =~ /^\* (.*)/) { if (!$in_list) { $html .= "<ul>\n"; $in_list = 1; } - $html .= "<li>" . encode_entities($1) . "</li>\n"; + $html .= "<li>" . linkify_text($1) . "</li>\n"; } + # Empty line - skip to avoid excessive spacing elsif ($line =~ /^\s*$/) { + # Skip empty lines for more compact output } + # Regular text else { - $html .= "<p>" . encode_entities($line) . "</p>\n"; + $html .= "<p>" . linkify_text($line) . "</p>\n"; } } - + # Close list if still open if ($in_list) { $html .= "</ul>\n"; } - + return $html; } - + # Check if the lines form an ASCII table sub is_ascii_table { my ($lines) = @_; - return 0 if @$lines < 3; # Need at least header, separator, and one data row - + return 0 if @$lines < 3; # Need at least header, separator, and one data row + # Check for separator lines with dashes and pipes for my $line (@$lines) { return 1 if $line =~ /^\|?[\s\-]+\|/; } return 0; } - + # Convert ASCII table to HTML table sub convert_ascii_table_to_html { - my ($lines) = @_; - my $html = "<table>\n"; + my ($lines) = @_; + my $html = "<table>\n"; my $row_count = 0; - + for my $line (@$lines) { + # Skip separator lines next if $line =~ /^\|?[\s\-]+\|/ && $line =~ /\-/; - + # Parse table row my @cells = split /\s*\|\s*/, $line; - @cells = grep { length($_) > 0 } @cells; # Remove empty cells - + @cells = grep { length($_) > 0 } @cells; # Remove empty cells + if (@cells) { $html .= "<tr>\n"; + # First row is header my $tag = ($row_count == 0) ? "th" : "td"; for my $cell (@cells) { - $html .= " <$tag>" . encode_entities(trim($cell)) . "</$tag>\n"; + my $val = trim($cell); + $html .= " <$tag>" . linkify_text($val) . "</$tag>\n"; } $html .= "</tr>\n"; $row_count++; } } - + $html .= "</table>\n"; return $html; } - + # Trim whitespace from string sub trim { my ($str) = @_; @@ -934,9 +939,77 @@ package Foostats::Reporter { $str =~ s/\s+$//; return $str; } - + + # Build an href for a token that looks like a URL or FQDN + sub _guess_href { + my ($token) = @_; + my $t = $token; + $t =~ s/^\s+//; + $t =~ s/\s+$//; + + # Already absolute http(s) + return $t if $t = |