view release on metacpan or  search on metacpan

script/phoebe-ctl  view on Meta::CPAN

extension.

B<phoebe-ctl log hits>

If you are using L<App::Phoebe::SpeedBump>, you can find the number of blocked
requests. First, make you you are using the module in your config file:

    use App::Phoebe::DebugIpNumbers;

Make sure you start or start C<phoebe> with C<--log_level=info> or
C<--log_level=debug>. First generate a log file. Better to zip it up and analyse
it elsewhere. This can be pretty big!

    journalctl --unit=phoebe | gzip > phoebe.log.gz

Here's how to see how many requests are blocked:

    zcat phoebe.log.gz | script/phoebe-ctl log hits | head

B<phoebe-ctl log requests [IP number]>

If you are logging IP numbers, this command will offer a little summary. In your
config file, you need the following (or start C<phoebe> with
C<--log_level=debug>):

    package App::Phoebe;
    use Modern::Perl;
    our ($log);
    $log->level('debug');

And you need L<App::Phoebe::DebugIpNumbers>, of course:

    use App::Phoebe::DebugIpNumbers;

Example basic usage, feeding it the journal kept by C<systemd>, giving you the
most active IP numbers:

    journalctl --unit phoebe | phoebe-ctl log hits | head

Giving you a summary of the 20 most popular requests (Gopher selectors, Gemini
URLs, or web requests):

    journalctl --unit phoebe | phoebe-ctl log requests

The same, but limited to a particular IP number:

    journalctl --unit phoebe | phoebe-ctl log requests 201.159.58.193

=cut

package Gemini::Wiki::Control;
use Modern::Perl '2018';
use File::Slurper qw(read_dir read_text write_text);
use Encode qw(encode_utf8 decode_utf8);
use Getopt::Long;
use Pod::Text;
use File::Path qw(remove_tree);
use POSIX qw(round);
use utf8;

binmode(STDOUT, ":utf8");

my $log = 2;
my $dir = "./wiki";
my @sources;
my $target;
my $no_extension;
GetOptions (
  "log=i" => \$log,
  "wiki_dir=s" => \$dir,
  "source=s" => \@sources,
  "target=s" => \$target,
  "no-extension" => \$no_extension, );
@sources = ("") unless @sources;

my $subcommands = {
  "help" => 0,
  "update-changes" => \&update_changes,
  "erase-page" => \&erase_page,
  "html-export" => \&html_export,
  "log" => \&log, };

my $subcommand;
$subcommand = shift(@ARGV) if @ARGV;
die "No subcommand\n" unless $subcommand;
$subcommand = $subcommands->{$subcommand};
die "No known subcommand\n" unless defined $subcommand;
if (not $subcommand) {
  my $parser = Pod::Text->new();
  $parser->parse_file($0);
  exit;
}

$subcommand->(@ARGV);

exit;

sub update_changes {
  my %pages;
  my $now = time;
  $pages{decode_utf8($_)} = modified("$dir/page/$_.gmi") for map { s/\.gmi$//; $_ } grep /\.gmi$/, read_dir("$dir/page");
  say "Read " . scalar(keys %pages) . " pages" if $log >= 3;
  say join("\n", map { $_ . "\t" . $pages{$_} } sort keys %pages) if $log >= 4;
  my %files;
  $files{decode_utf8($_)} = modified("$dir/file/$_") for read_dir("$dir/file");
  say "Read " . scalar(keys %files) . " files" if $log >= 3;
  say join("\n", map { $_ . "\t" . $files{$_} } sort keys %files) if $log >= 4;
  my %revisions;
  my %changes;
  for (split /\n/, read_text "$dir/changes.log") {
    my ($ts, $id, $revision) = split(/\x1f/);
    $revisions{$id} = $revision;
    if ($revision) {
      $changes{$id} = $ts;
    } else {
      $changes{$id . "\x1c"} = $ts;
    }
  };
  say "Read " . scalar(keys %changes) . " changes" if $log >= 3;
  say join("\n", map { $_ . "\t" . $changes{$_} } sort keys %changes) if $log >= 4;
  open(my $fh, ">>:encoding(UTF-8)", "$dir/changes.log") or die "Cannot write $dir/changes.log: $!";