#!/usr/bin/perl
#
# Simple string substitution in a file
#
# Copyright Bill MacAllister, Inc. 2016

use Carp;
use File::Slurp;
use Getopt::Long;
use Pod::Usage;
use strict;

my $opt_debug;
my $opt_help;
my $opt_manual;

##############################################################################
# Subroutines
##############################################################################

# ----------------------------------------------------------------------------
# Utility subroutines

sub dbg {
    my ($txt) = @_;
    prt("DEBUG:$txt\n");
    return;
}

sub prt {
    my ($t) = @_;
    print $t or die "ERROR: problem writing to STDOUT\n";
    return;
}

sub trim {
    my ($t) = @_;
    $t =~ s/^\s+//xms;
    $t =~ s/\s+$//xms;
    return $t;
}

# ----------------------------------------------------------------------------
# Reads in a set of subtitution specifications from a file and returns
# a hash containing the substitutions.

sub read_subs {
    my ($filename) = @_;
    my $subs_filename = $filename . '.conf';
    if (!-e $subs_filename) {
        prt("ERROR: can find file $subs_filename");
        pod2usage(-verbose => 0);
    }
    open(my $fh, '<', $subs_filename)
      or croak("ERROR: problem opening $subs_filename");
    my %subs;
    while (<$fh>) {
        chomp;
        my $inline = $_;
        if ($inline =~ /#/ || length($inline) == 0) {
            next;
        }
        if ($inline =~ /=/) {
            my ($target, $value) = split /=/, $inline, 2;
            $subs{ trim($target) } = trim($value);
        }
    }
    close $fh;
    return \%subs;
}

# ----------------------------------------------------------------------------
# Read and a template file, perform substitutions, write out new file

sub read_and_write {
    my ($filename, $subs_ref) = @_;
    my %subs = %{$subs_ref};

    my $tmpl_filename = $filename . '.tmpl';
    if (!-e $tmpl_filename) {
        prt("ERROR: can find file $tmpl_filename");
        pod2usage(-verbose => 0);
    }
    my $tmpl_content = read_file($tmpl_filename);
    for my $target (sort keys %subs) {
        my $value = $subs{$target};
        my $tar   = $target;
        if ($target !~ /^%%.*?%%$/) {
            $tar = '%%' . $target . '%%';
        }
        $tmpl_content =~ s{$tar}{$value}xmsg;
    }
    open(my $fh, '>', $filename)
      or croak("ERROR: problem writing to $filename");
    print $fh $tmpl_content;
    close $fh;
    return;
}

##############################################################################
# Main routine
##############################################################################

GetOptions(
    'debug'  => \$opt_debug,
    'help'   => \$opt_help,
    'manual' => \$opt_manual
);

# Flush output immediately
$| = 1;

my $filename = shift;

# help the poor souls out
if ($opt_help || !$filename) {
    pod2usage(-verbose => 0);
}
if ($opt_manual) {
    pod2usage(-verbose => 2);
}

my $subs_ref = read_subs($filename);
read_and_write($filename, $subs_ref);

exit;

__END__

=head1 NAME

str-replace - template driven string replacement

=head1 SYNOPSIS

str-replace <filename> [--debug] [--help] [--manual]

=head1 DESCRIPTION

This script creates a new file given a template and a set of string
substitutions.  The script reads substitution specifications from
<filename>.conf and reads the template from <filename>.tmpl.  The file
written is <filename>.

The configuration file is a simple target=newvalue format.  The target
is used to form the search string %%target%%.  The target can be
specified in the configuration file with or without the prefix and
suffix.  All occurrances of the target are replaced including multiple
targets per line.

=head1 OPTIONS

=over 4

=item --debug

Generate debugging messages.

=item --help

A short help message.

=item --manual

The complete documentation.

=back

=head1 AUTHOR

Bill MacAllister <bill@ca-zephyr.org>

=head1 COPYRIGHT

This software was developed for use at Shelter Cove.  All rights
reserved 2016.

=cut
