Pageling/Code/pageling.pl

#!/usr/bin/perl

=encoding utf8

=head1 ABOUT

A basic website assembler, written in Perl 5.

© 2019 Tirifto <tirifto@posteo.cz>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <https://www.gnu.org/licenses/>.

=for REUSE
SPDX-Licence-Identifier: GPL-3.0-or-later

=cut

use v5.22;
use feature 'postderef'; # Postfix dereferencing.
use strict;
use warnings;

=for comment
Below lie the sealed artifacts of UNICODE handling. They were brought in for
blind adherence to noble ideals of character encoding, which turned out to be a
mistake, for many functions of the program were left broken. It would seem one
shouldn't dabble in arcane arts they don't understand well, and leave the magic
of Perl do its tricks. Perhaps one day we shall grow wise, and peel off the seal
once more, to better bend bytes to our will.

=cut

# use utf8;
# binmode STDIN, ':utf8';
# binmode STDOUT, ':utf8';
# binmode STDERR, ':utf8';

use File::Find; # Traverse directory tree.
use Getopt::Long
    qw(:config no_auto_abbrev bundling); # Command line parameters.
use List::Util
    qw(any); # Find item in array.
use Path::Tiny; # Object-oriented handling of files.

my $version = "too low"; # Far too early in development.
my $help = <<'END';
Usage: ./pageling [OPTIONS]

Options:

--config, -c [DIRECTORY]    Set  directory with configuration files.
--help, -h                  Print this help.
--input, -i [DIRECTORY]     Set input directory.
--output, -o [DIRECTORY]    Set output directory.
--verbose, -v               Be more verbose in output.
                                ×1: Verbose.
                                ×2: Very verbose.
                                ×3: Very very verbose.
                                ×4: Debug.
--version,                  Print script name and version.

Report bugs to <tirifto@posteo.cz>.
END

=head1 INITIALISE

=head2 Variables

=head3 Directories

=over

=item

C<$dRootIn> has the root input directory

=item

C<$dRootOut> has the root output directory

=back

=cut

my ($flagHelp, $verbose, $flagVersion) = (0, 0, 0);
my ($dRootIn, $dRootOut, $dConf) = ('', '', '');

GetOptions ("config|c" => \$dConf,
	    "help|h" => \$flagHelp,
	    "input|i=s" => \$dRootIn,
	    "output|o=s" => \$dRootOut,
	    "verbose|v+" => \$verbose,
	    "version" => \$flagVersion)
    or die "Error reading options.\n";

if ($flagHelp) {
    say $help;
    exit;
} elsif ($flagVersion) {
    say "Pageling, version ‘$version’";
    exit;
}

-e $dRootIn
    or die "Input directory ‘$dRootIn’ does not exist";
-e $dRootOut or mkdir $dRootOut
    or die "Couldn't create output directory ‘$dRootOut’";

=head2 Classes

=head3 Pali

Abstract class from which the more specific L</Pali::D> and L</Pali::F> classes
are derived. The objects are implemented as hash tables. They evaluate to their
paths in string context.

=head4 Class attributes

=over

=item %registrations

Absolute (and clean) paths hashed to Pali::F and Pali::D objects. Used to look
up objects in order to preserve order by avoiding the existence of multiple
objects for a single file/directory.

=back

=head4 Object attributes

=over

=item $path

Contains the Path::Tiny object representing the path to the file/directory.

=back

=head4 Methods

=over

=item new

$path (+) → $object

Takes a path to an existing file/directory as a list of arguments, which will
then be handed Path::Tiny to make a path object (so refer to that to see what
forms are permitted). Returns an object of the given class.

=item setPath

$path (+) →|

Makes a new path for the object (via Path::Tiny) from the list of
arguments. Consider not using it if you don't move input files around.

=item getPath

|→ $string

Returns the path to the file/directory in string form.

=item setFOut

$language, $path (+) →|

Sets the ouptut file for the given language code to the given path (via
Path::Tiny).

=item getFout

$language → $path

Returns the path to the output file for the given language code.

=item setTit

$language, $string (+) →|

Sets the title for the given language code to the given string. Multiple strings
will eventually be joined together with spaces in between.

=item getTit

$language → $string

Returns the title for the given language code.

=item addLan

$language →|

Adds the given language code to the file/directory's list of used language
codes. You might want to use this when entering a new language section.

=item getLans

|→ @languages

Returns an array of language codes associated with the file/directory.

=item parent

|→ $object

Returns an object of the file/directory's parent directory.

=item grandparent

|→ $object

Returns an object of the file/directory's parent's parent directory. Remember to
visit it every once in a while!

=back

=cut

{
    package Pali;

    use parent qw(Path::Tiny);

    my %registrations;

    # Make the object stringify to its path.
    use overload (
	q("") => 'getPath'
	);
    
    sub new {
	my ($class, @args) = @_;
	my $self = {path => (Path::Tiny::path @args)->realpath};
	bless $self, $class;
	say "‣‣‣ Making new file of $self!" if $verbose >= 4;
	if (exists $registrations{$self->getPath}) {
	    return $registrations{$self->getPath};
	} else {
	    return $registrations{$self->getPath} = $self;
	}
    }

    sub setPath {
	my ($self, @args) = @_;
	$self->{path} = (Path::Tiny::path @args)->realpath;
    }
	    
    sub getPath {
	my $self = shift;
	return ($self->{path})->stringify;
    }

    sub setFOut {
	my ($self, $lan, @args) = @_;
	$self->{lans}{$lan}{fOut} = (Path::Tiny::path @args)->realpath;
    }

    sub getFOut {
	my ($self, $lan) = @_;
	return $self->{lans}{$lan}{fOut};
    }

    sub setTit {
	my ($self, $lan, @args) = @_;
	$self->{lans}{$lan}{tit} = join " ", @args;
    }

    sub getTit {
	my ($self, $lan) = @_;
	return $self->{lans}{$lan}{tit};
    }

    sub addLan {
	my ($self, $lan) = @_;
	$self->{lans}{$lan} = {};
    }

    sub getLans {
	my $self = shift;
	my @languages = keys $self->{lans}->%*;
	keys $self->{lans}->%*; # Reset iterator.
	return @languages;
    }

    sub parent {
	my $self = shift;
	return Pali::D->new (($self->{path})->parent);
    }

    sub grandparent {
	my $self = shift;
	my $parentPath = ($self->{path})->parent;
	return Pali::D->new ($parentPath->parent);
    }
}


=head3 Pali::D

Pageling directory. Subclass of L</Pali>. Preferably use it for input
directories which have been breathed into existence.

=head4 Methods

=over

=item addNav

$object →|

Takes a Pali file/directory object and adds it to the directory's navigation.

=item getNavs

|→ @navigation

Returns an array of Pali file/directory objects holding the directory's
navigation.

=back

=cut

{
    package Pali::D;

    our @ISA = qw(Pali);

    sub addNav {
	my ($self, $nav) = @_;
	push $self->{navs}->@*, $nav;
    }

    sub getNavs {
	my $self = shift;
	return $self->{navs}->@*;
    }
}

=head3 Pali::F

Pageling file. Subclass of L</Pali>. Preferably use it for input files which
have been breathed into existence.

=head4 Methods

=over

=item markIndex

|→|

Makes the file remember that it is an index file to a directory.

=item isIndex

|→ $boolean

Returns true if the file recalls being an index file to a directory. And, as you
may have guessed, returns false if not.

=back

=cut

{
    package Pali::F;

    our @ISA = qw(Pali);

    sub markIndex {
	my $self = shift;
	$self->{index} = 1;
    }

    sub isIndex {
	my $self = shift;
	return ($self->{index} ? 1 : 0);
    }
}

=head2 Subroutines

=head3 C<readPaliya>

[$CONF FILE] → [\%KEYWORDS ⇒ VALUES]

Takes a Paliya configuration file, parses it, and returns a reference
to all the keywords mapped to values. Dies on wrong formatting.

=cut

sub readPaliya {
    my $fIn = shift @_;
    my $fhIn;
    open ($fhIn, '<', $fIn) or die "Couldn't open ‘$fIn’";

    my %conf;
    my ($key, $value) = ('', '');

    KEY0: while (read ($fhIn, $_, 1) != 0) {
	next KEY0 if /\s/; # W
	if (/(\{|\})/) { # { }
	    die "Keyword can't contain braces in ‘$fIn’";
	} else { # C \
	    $key .= $_;
	  KEY1: while (read ($fhIn, $_, 1) != 0) {
	      if (/(\s|\})/) { # W }
		  die "Wrong character in keyword in ‘$fIn’ after ‘$key’";
	      } elsif (/\{/) { # {
		VALUE: while (read ($fhIn, $_, 1) != 0) {
		    if (/\\/) { # \
			read ($fhIn, $_, 1) or last KEY0;
			$value .= $_;
		    } elsif (/\}/) { # }
			$conf{$key} = $value;
			($key, $value) = ('', '');
			next KEY0;
		    } else { # C W {
			$value .= $_;
			next VALUE;
		    }
		}
	      } else { # C \
		  $key .= $_;
		  next KEY1;
	      }
	  }
	}
    }

    return \%conf;
}

=head2 Input and output directories

Paths to input and output directories are turned into L</Pali::Dir>
objects. Because all other paths are practically going to be derived from these,
it is necessary that we resolve them to remove any relative jumps (‘.’ and
‘..’), lest our chances of success perish in a chaotic maze of indirection.

=cut

$dRootIn = Pali::D->new ($dRootIn);
$dRootOut = Pali::D->new ($dRootOut);
$dConf = ($dConf
	  ? Pali::D->new ($dConf)
	  : Pali::D->new ($dRootIn->getPath, "pageling"));

=head2 Configuration files

Content of the configuration files is read into three variables:
C<%languages>, C<%navigation>, and C<%switcher>.

=cut

my %fConf = (
    'languages' => path ($dConf->getPath, "languages.paliya"),
    'navigation' => path ($dConf->getPath, "navigation.paliya"),
    'switcher' => path ($dConf->getPath, "switcher.paliya"),
);

-e $fConf{languages} or die "Missing language configuration file"
    . " ‘$fConf{languages}’";
-e $fConf{navigation} or die "Missing navigation configuration file"
    . " ‘$fConf{navigation}’";
-e $fConf{switcher} or die "Missing switcher configuration file"
    . " ‘$fConf{switcher}’";

my %languages = %{readPaliya $fConf{languages}};
my %navigation = %{readPaliya $fConf{navigation}};
my %switcher = %{readPaliya $fConf{switcher}};

my @fIn;

find (\&registerFiles, $dRootIn->getPath);

sub registerFiles {
    say "‣‣‣ Examining $_" if $verbose >= 4;
    if (-d || /(.paliya|\#|\~)$/) {
	say "‣‣‣ Not delving into that!" if $verbose >= 4;
	return;
    } else {
	my $f = Pali::F->new ($_);
	$f->markIndex if $f =~ /^index\./;
	push @fIn, $f;
	say "‣‣‣ Got it!" if $verbose >= 4;
    }
}

foreach my $lang (keys %languages) {
    $dRootIn->setFOut ($lang, $dRootOut);
}
keys %languages; # Reset iterator.

say "Processing input files…" if $verbose >=1;

# find (\&firstPass, $dRootIn);

foreach my $fIn (@fIn) {
    say "• File: $fIn" if $verbose >= 2;
    my ($lan, $fil, $tit, $nav) = ('', '', '', ''); # Registered directives
    my ($fOut, $fhIn, $fhOut);
    open $fhIn, '<', $fIn->getPath;
    while (my $line = <$fhIn>) {
	if ($line =~ s/^:::\s*//) { # This is a directive!
	    my ($key, $value) = each %{readPaliya (\$line)};
	    if ($key =~ /^(lan|language|lin|lingvo)$/) {
		($lan, $fil, $tit) = ($value, '', '');
		$fIn->addLan ($lan);

		($fIn->parent)->addLan ($lan) if $fIn->isIndex;
		say "  ◦ Processing language ‘$lan’" if $verbose >= 3;
	    } elsif ($key =~ /^(fil|file|dos|dosiero)$/) {
		$fil = $value if $lan;
		my $parent = $fIn->parent;
		if ($fIn->isIndex) {
		    my $grandparent = $parent->parent;
		    my $fParentOut = path ($grandparent->getFOut ($lan), $fil);
		    $parent->setFOut ($lan, $fParentOut);
		    $fOut = path ($parent->getFOut ($lan), "index.html");
		} else {
		    $fOut = path ($parent->getFOut ($lan), $fil);
		}
		$fIn->setFOut ($lan, $fOut);
		open $fhOut, '>', $fOut or die "Couldn't open ‘$fOut’";
		say "  ◦ Output file set to ‘$fOut’" if $verbose >= 3;
	    } elsif ($key =~ /^(tit|title|titolo)$/) {
		$tit = $value if $lan;
		$fIn->setTit ($lan, $tit);
		say "  ◦ Title set to ‘$tit’" if $verbose >= 3;
	    } elsif ($key =~ /^(nav|navigation|navigilo)$/) {
		$nav = 'yes';
		($fIn->parent)->addNav ($fIn);
		say "  ◦ Added to parent's navigation" if $verbose >= 3;
	    } else {
		say "Unrecognised directive found in ‘$fIn’!";
	    }
	    next;
	} else {
	    if ($fil) {
		print $fhOut $line;
	    }
	}
    }
}