#!/usr/bin/perl # setup.pl - guided setup for pisg. Run it with: perl setup.pl # # It looks for IRC logs that already exist on this computer (eggdrop, ZNC, irssi, WeeChat, HexChat, # mIRC / AdiIRC), asks a few questions, writes pisg.cfg, makes the first stats page, and helps you # run it on a schedule and put it on the web for free. Nothing is changed without asking, and an # existing pisg.cfg is never overwritten (it is backed up first, if you choose to replace it). # # perl setup.pl --dry-run show what would be written, change nothing # perl setup.pl --help use strict; use warnings; use File::Basename qw(dirname basename); use File::Spec; use File::Path qw(make_path); use Cwd qw(abs_path); use POSIX qw(strftime); my $WIN = $^O eq 'MSWin32'; my $HOME = $ENV{HOME} || $ENV{USERPROFILE} || '.'; my $APPDATA = $ENV{APPDATA} || ''; my $HERE = dirname(abs_path($0)); my $DRY = grep { $_ eq '--dry-run' } @ARGV; if (grep { $_ eq '--help' || $_ eq '-h' } @ARGV) { print "Usage: perl setup.pl [--dry-run]\n"; exit 0; } $| = 1; sub say_ { print @_, "\n" } sub rule { say_ "\n" . ('-' x 72) } sub ask { my ($q, $def) = @_; print $q . (defined $def && length $def ? " [$def]" : '') . ' '; my $a = ; exit 0 unless defined $a; # end of input: stop quietly $a =~ s/^\s+|\s+$//g; return length $a ? $a : (defined $def ? $def : ''); } sub yes { my ($q, $def) = @_; my $a = lc ask("$q (y/n)", $def ? 'y' : 'n'); return $a =~ /^y/; } sub slash { my $p = shift; $p =~ s{\\}{/}g; return $p } # pisg.cfg accepts / everywhere, Windows too sub clean { my $v = shift; $v =~ s/["\r\n]//g; return $v } # a value goes between quotes in pisg.cfg sub count_files { my ($dir, $prefix) = @_; my @f = grep { -f } glob(quotemeta_glob("$dir/$prefix") . '*'); return scalar @f } sub quotemeta_glob { my $s = shift; $s =~ s/([\[\]{}*?\\ ])/\\$1/g; return $s } # ---- what formats does this pisg know? -------------------------------------------------------- my @FORMATS = sort map { basename($_, '.pm') } glob("$HERE/modules/Pisg/Parser/Format/*.pm"); @FORMATS = grep { $_ ne 'Template' } @FORMATS; # ---- looking for logs --------------------------------------------------------------------------- # Each candidate: { app, channel, network, format, dir | file, prefix, note } my @found; sub add { push @found, { @_ } } sub detect_eggdrop { my %seen; my @confs = grep { -f } (glob("$HOME/eggdrop*/eggdrop.conf"), glob("$HOME/*/eggdrop.conf"), glob("$HOME/*/*/eggdrop.conf")); for my $conf (grep { !$seen{$_}++ } @confs) { my $base = dirname($conf); open(my $fh, '<', $conf) or next; my @lines = <$fh>; close $fh; my $keep = (grep { /^\s*set\s+keep-all-logs\s+1/ } @lines) ? 1 : 0; for (@lines) { next unless /^\s*logfile\s+\S+\s+(\S+)\s+"?([^"\s]+)"?/; my ($chan, $path) = ($1, $2); next unless $chan =~ /^[#&]/; $path = File::Spec->catfile($base, $path) unless File::Spec->file_name_is_absolute($path); add(app => 'eggdrop', channel => $chan, network => '', format => 'eggdrop', dir => dirname($path), prefix => basename($path) . '.', note => $keep ? '' : "eggdrop keeps only the current log. For a long history add these to eggdrop.conf and .rehash:\n" . " set keep-all-logs 1\n set logfile-suffix \".%Y%m%d\"\n set switch-logfiles-at 300"); } } } sub detect_znc { my %roots = map { $_ => 1 } grep { -d } ($ENV{ZNC_DATADIR} || '', "$HOME/.znc", ($APPDATA ? "$APPDATA/znc" : ())); for my $root (keys %roots) { # user scope: users//moddata/log//<#channel>/YYYY-MM-DD.log for my $d (glob("$root/users/*/moddata/log/*/*")) { next unless -d $d && basename($d) =~ /^[#&]/; add(app => 'ZNC', channel => basename($d), network => basename(dirname($d)), format => 'energymech', dir => $d, prefix => '', note => ''); } # network scope: users//networks//moddata/log/<#channel>/... for my $d (glob("$root/users/*/networks/*/moddata/log/*")) { next unless -d $d && basename($d) =~ /^[#&]/; (my $net = $d) =~ s{.*/networks/([^/]+)/moddata/log/.*}{$1}; add(app => 'ZNC', channel => basename($d), network => $net, format => 'energymech', dir => $d, prefix => '', note => ''); } # global scope: moddata/log///<#channel>/... for my $d (glob("$root/moddata/log/*/*/*")) { next unless -d $d && basename($d) =~ /^[#&]/; add(app => 'ZNC', channel => basename($d), network => basename(dirname($d)), format => 'energymech', dir => $d, prefix => '', note => ''); } } } # One log file per channel (irssi, WeeChat, HexChat, mIRC ...): the name holds the channel. sub file_candidates { my ($app, $format, $dir, $rx, $network) = @_; return unless -d $dir; opendir(my $dh, $dir) or return; for my $f (sort grep { !/^\./ && -f "$dir/$_" } readdir $dh) { my $chan = $f =~ $rx ? $1 : next; add(app => $app, channel => $chan, network => ($network // ''), format => $format, file => "$dir/$f", note => ''); } closedir $dh; } sub detect_clients { # irssi: ~/irclogs//<#channel>.log (autolog default) for my $n (grep { -d } glob("$HOME/irclogs/*")) { file_candidates('irssi', 'irssi', $n, qr/^([#&][^.]*)\.log$/, basename($n)); } # WeeChat: irc..<#channel>.weechatlog for my $d ("$HOME/.local/share/weechat/logs", "$HOME/.weechat/logs") { file_candidates('WeeChat', 'weechat3', $d, qr/^irc\.[^.]+\.([#&].+)\.weechatlog$/); } # HexChat / XChat: logs//<#channel>.log for my $r ("$HOME/.config/hexchat/logs", "$HOME/.xchat2/xchatlogs", ($APPDATA ? "$APPDATA/HexChat/logs" : ())) { for my $n (grep { -d } glob("$r/*")) { file_candidates('HexChat', 'xchat', $n, qr/^([#&].+)\.log$/, basename($n)) } } # mIRC / AdiIRC on Windows: <#channel>..log or <#channel>.log for my $d (($APPDATA ? ("$APPDATA/mIRC/logs", "$APPDATA/AdiIRC/Logs") : ()), "$HOME/.wine/drive_c/mIRC/logs") { file_candidates('mIRC/AdiIRC', 'mIRC', $d, qr/^([#&][^.]+)(?:\..+)?\.log$/); for my $n (grep { -d } glob("$d/*")) { file_candidates('mIRC/AdiIRC', 'mIRC', $n, qr/^([#&][^.]+)(?:\..+)?\.log$/, basename($n)) } } } # ---- go ----------------------------------------------------------------------------------------- rule(); say_ "pisg setup" . ($DRY ? " (dry run: nothing will be written)" : ''); say_ ""; say_ "pisg turns IRC chat logs into a web page of statistics: who talks most, when the channel is"; say_ "busy, who talks to whom. I will look for logs on this computer, ask a few questions and write"; say_ "the configuration for you. You can stop at any time with Ctrl+C; nothing is changed until the"; say_ "end."; detect_eggdrop(); detect_znc(); detect_clients(); my @chosen; rule(); say_ "Step 1 of 4: which channels do you want statistics for?"; say_ ""; if (@found) { say_ "I found these logs:"; my $i = 0; for my $c (@found) { $i++; my $where = $c->{dir} ? $c->{dir} : $c->{file}; my $n = $c->{dir} ? count_files($c->{dir}, $c->{prefix} // '') . " files" : (-s $c->{file} ? int((-s $c->{file}) / 1024) . " KB" : 'empty'); printf " %2d) %-14s %-16s %-10s %s (%s)\n", $i, $c->{app}, $c->{channel}, $c->{network}, $where, $n; } say_ ""; my $pick = ask("Type the numbers you want, separated by commas (for example 1,3), or 0 to type a folder yourself:", '1'); for my $n (grep { /^\d+$/ && $_ >= 1 && $_ <= @found } split /\s*,\s*/, $pick) { push @chosen, { %{ $found[$n - 1] } } } } else { say_ "I did not find any IRC logs in the usual places."; say_ ""; say_ " * Using a bouncer or a bot? Turn logging on first: eggdrop needs a 'logfile' line, ZNC needs the"; say_ " 'log' module (/msg *status LoadMod log), irssi needs /set autolog on. Then run this again."; say_ " * Already have logs somewhere else? Type the folder below."; } if (!@chosen) { say_ ""; my $where = ask("Folder or file with your logs (leave empty to stop):", ''); if (!length $where) { say_ "Nothing to do. Run this again once you have logs."; exit 0; } $where =~ s/^~(?=\/|$)/$HOME/; if (!-e $where) { say_ "That does not exist: $where"; exit 1; } say_ ""; say_ "Which program wrote them? Formats pisg understands:"; say_ " " . join(', ', @FORMATS); my $fmt = ask("Format:", 'eggdrop'); my $chan = ask("Channel name (for example #mychannel):", '#mychannel'); push @chosen, { app => 'your logs', channel => $chan, network => '', format => $fmt, (-d $where ? (dir => $where, prefix => ask("Only files whose name starts with (empty: all of them):", '')) : (file => $where)), note => '' }; } rule(); say_ "Step 2 of 4: a few details"; say_ ""; my $maintainer = clean(ask("Your name or nick, shown as the maintainer of the page:", $ENV{USER} || $ENV{USERNAME} || 'me')); my $network = clean(ask("Name of the IRC network (for example Undernet, Libera):", $chosen[0]{network} || 'IRC')); say_ ""; say_ "Look of the pages: modern (light and dark, follows your system) midnight amoled terminal default"; my $scheme = clean(ask("Colour scheme:", 'modern')); my $outdir = ask("Folder for the finished pages:", File::Spec->catdir($HERE, 'output')); $outdir =~ s/^~(?=\/|$)/$HOME/; my $landing = @chosen > 1 || yes("Add a front page (index.html) that links to your channel pages?", 1); my $cfg = File::Spec->catfile($HERE, 'pisg.cfg'); my @out; push @out, "# Written by setup.pl on " . strftime('%Y-%m-%d %H:%M', localtime) . ". Every option is explained in pisg.cfg.example."; push @out, qq(), qq(), qq(); push @out, qq() if $landing; push @out, ''; my %usedfile; for my $c (@chosen) { my $slug = lc(clean($c->{channel})); $slug =~ s/^[#&]+//; $slug =~ s/[^a-z0-9._-]+/-/g; $slug ||= 'channel'; $slug .= '-' . (++$usedfile{$slug}) if $usedfile{$slug}++; push @out, '{channel}) . '">'; if ($c->{dir}) { push @out, ' LogDir="' . clean(slash($c->{dir})) . '"'; push @out, ' LogPrefix="' . clean($c->{prefix}) . '"' if length($c->{prefix} // ''); } else { push @out, ' Logfile="' . clean(slash($c->{file})) . '"'; } push @out, ' Format="' . clean($c->{format}) . '"'; push @out, ' Network="' . ($c->{network} && $network eq 'IRC' ? clean($c->{network}) : $network) . '"'; push @out, ' OutputFile="' . clean(slash(File::Spec->catfile($outdir, "$slug.html"))) . '"'; push @out, '', ''; } my $text = join("\n", @out) . "\n"; rule(); say_ "Step 3 of 4: this is the configuration I will write"; say_ ""; say_ " $cfg"; say_ ""; say_ join("\n", map { " $_" } @out); for my $c (@chosen) { say_ " Note for $c->{channel}: $c->{note}\n" if $c->{note} } if ($DRY) { say_ "Dry run: nothing written."; exit 0; } exit 0 unless yes("Write it?", 1); if (-e $cfg) { say_ ""; say_ "There is already a pisg.cfg here."; if (yes("Back it up (pisg.cfg.bak-DATE) and replace it? If not, the new one is saved as pisg.cfg.new", 0)) { my $bak = "$cfg.bak-" . strftime('%Y%m%d-%H%M%S', localtime); rename($cfg, $bak) or do { say_ "Could not back it up: $!"; exit 1 }; say_ " old file kept as $bak"; } else { $cfg .= '.new'; } } make_path($outdir) unless -d $outdir; open(my $out, '>', $cfg) or do { say_ "Could not write $cfg: $!"; exit 1 }; print $out $text; close $out; say_ "Wrote $cfg"; say_ " To use it instead of your current configuration: mv pisg.cfg.new pisg.cfg" if $cfg =~ /\.new$/; if ($landing) { my ($src, $dst) = ("$HERE/site/index.html", File::Spec->catfile($outdir, 'index.html')); if (-f $src && !-e $dst) { require File::Copy; File::Copy::copy($src, $dst) and say_ "Copied the front page to $dst" } } # first run say_ ""; if (yes("Make the first statistics now?", 1)) { say_ "Running pisg (this can take a little while with a lot of logs) ..."; my $perl = $^X; my $rc = system($perl, File::Spec->catfile($HERE, 'pisg'), ($cfg =~ /\.new$/ ? ('-co', $cfg) : ())); if ($rc == 0) { say_ ""; say_ "Done. Your page is in: $outdir"; say_ " " . slash(File::Spec->catfile($outdir, 'index.html')) if $landing; } else { say_ ""; say_ "pisg reported a problem (above). Common causes: the wrong format for these logs, or logs with"; say_ "no timestamps. Run perl setup.pl again and pick another format, or ask on GitHub: https://github.com/PISG/pisg"; } } # scheduling rule(); say_ "Step 4 of 4: keep the statistics up to date"; say_ ""; say_ "pisg makes a fresh page each time it runs. Run it on a schedule so the page stays current."; my $hours = ask("How often, in hours (1, 3, 6 or 12)?", '3'); $hours = 3 unless $hours =~ /^(1|2|3|4|6|8|12|24)$/; if ($WIN) { my $cmd = qq(schtasks /Create /SC HOURLY /MO $hours /TN "pisg" /TR "cmd /c cd /d \\"$HERE\\" && \\"$^X\\" pisg" /F); say_ ""; say_ " $cmd"; if (yes("Create this Windows scheduled task now?", 0)) { system($cmd) } else { say_ " (run the line above in a command prompt when you want it.)" } say_ " The computer must be on for it to run."; } else { my $line = "5 */$hours * * * cd '$HERE' && '$^X' pisg >> pisg_cron.log 2>&1"; say_ ""; say_ " $line"; if (yes("Add this line to your crontab now?", 0)) { my $old = `crontab -l 2>/dev/null` // ''; if ($old =~ /pisg_cron\.log/) { say_ " There is already a pisg line in your crontab; not adding another." } elsif (open(my $c, '|-', 'crontab', '-')) { print $c $old, (length $old && $old !~ /\n\z/ ? "\n" : ''), "$line\n"; close $c; say_ " Added."; } else { say_ " Could not run crontab: $!" } } else { say_ " (add it yourself with: crontab -e )" } } rule(); say_ "Put the pages on the web (free)"; say_ ""; say_ "Your pages are plain files, so any static host works. Good free choices:"; say_ ""; say_ " * GitHub Pages free, simple, and it can publish straight from a git repository."; say_ " 1) create a free account at github.com and a repository named YOURNAME.github.io"; say_ " 2) put the contents of your output folder in it and push"; say_ " 3) your stats are then at https://YOURNAME.github.io/"; say_ " * Cloudflare Pages free, fast everywhere; upload the folder by drag and drop or connect a repository."; say_ " * Netlify free plan; drag the output folder onto app.netlify.com/drop."; say_ " * GitLab Pages free, like GitHub Pages (uses a .gitlab-ci.yml file)."; say_ " * Your own server point Apache or nginx at the output folder."; say_ ""; say_ "Two things to know:"; say_ " * The front page reads channels.json, so it needs a web server. Opening index.html straight from"; say_ " your disk will not list the channels. To try it on your own computer, run this inside the output"; say_ " folder, then open http://localhost:8000/ : python3 -m http.server 8000"; say_ " * The pages show nicknames and a random line from the chat. Tell your channel that stats are"; say_ " published, and use BadUrls, or a private host if that matters to you."; say_ ""; say_ "More: pisg.cfg.example lists every option, docs/pisg-doc.html is the whole manual."; say_ "Change your answers any time by editing pisg.cfg, or run perl setup.pl again.";