#
#  Teco.pm - Build-process tool for TECO-64 text editor.
#
#  @copyright 2022-2023 Franklin P. Johnston / Nowwith Treble Software
#
#  Permission is hereby granted, free of charge, to any person obtaining a
#  copy of this software and associated documentation files (the "Software"),
#  to deal in the Software without restriction, including without limitation
#  the rights to use, copy, modify, merge, publish, distribute, sublicense,
#  and/or sell copies of the Software, and to permit persons to whom the
#  Software is furnished to do so, subject to the following conditions:
#
#  The above copyright notice and this permission notice shall be included in
#  all copies or substantial portions of the Software.
#
#  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
#  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
#  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
#  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIA-
#  BILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
#  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
#  THE SOFTWARE.
#
################################################################################

package Teco;

use strict;
use warnings;
use version; our $VERSION = '1.0.0';

use base qw( Exporter );
use Carp;
use Exporter qw(import);
use File::Slurp;
use Readonly;

our @EXPORT_OK = qw(teco_read teco_write);

#<<< perltidy: preserve format

my $LEVEL = 1;                  # Default log level

#>>>

Readonly my $WARNING =>
  '///  *** This file is automatically generated. DO NOT MODIFY. ***';

#
#  Verify that we have an input file name for the specified option,
#  that the file exists, is readable, and is a plain file.
#

sub teco_read
{
    my ($file) = @_;

    if ( !$file )
    {
        print "Missing input file name\n";

        exit 1;
    }

    if ( !-e $file )
    {
        print "File $file does not exist\n";

        exit 1;
    }

    if ( !-r $file )
    {
        print "File $file is not readable\n";

        exit 1;
    }

    if ( !-f $file )
    {
        print "File $file is not a plain file\n";

        exit 1;
    }

    return read_file($file);
}

#
#  Translate strings in pattern data and write new file.
#

sub teco_write
{
    my ( $pattern, $file, %changes ) = @_;

    if ( !$file )
    {
        print "Missing output file name\n";

        exit 1;
    }

    $changes{'WARNING NOTICE'} = $WARNING;

    foreach my $key ( sort keys %changes )
    {
        my $target = "/\\\* \\\(INSERT: $key\\\) \\\*/";

        if ( $pattern !~ s/$target/$changes{$key}/ms )
        {
            if (   $file !~ /errors\N{FULL STOP}md/ms
                || $key ne 'WARNING NOTICE' )
            {
                print "Can't find $target in input file\n";

                exit 1;
            }
        }
    }

    print "creating $file\n";

    open my $fh, '>', $file or croak "Can't open $file\n";

    print {$fh} $pattern or croak "Can't print to $file\n";

    close $fh or croak "Can't close $file\n";

    return;
}

1;
