Home → Repo ^yEzqv → Branch master Files → projects → skapa → create.pl

Mirror of the Rel4tion website/wiki source, view at <http://rel4tion.org>
[[ 🗃 ^yEzqv rel4tion-wiki ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]
Clone

HTTPS: git clone https://vervis.peers.community/repos/yEzqv
SSH: git clone USERNAME@vervis.peers.community:yEzqv
Branches

master
create.pl

#!/usr/bin/perl

# create.pl
# This file is part of Skapa
#
# Copyright (C) 2014 - fr33domlover <fr33domlover@riseup.net>
#
# Skapa 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.
#
# Skapa 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 Skapa. If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;

# -----------------------------------------------------------------------------
# ----------------------------------------------- constants -------------------
# -----------------------------------------------------------------------------

my $TRUE = 1;
my $FALSE = 0;

# -----------------------------------------------------------------------------
# ----------------------------------------------- string utils ----------------
# -----------------------------------------------------------------------------

=item parse_filename

Convert a filename read from a config file into the form expected by the
generation functions. It takes a filename string and returns the converted
filename string.

If the string is "-" it is converted into an empty string. Otherwise, it is
returned as is.

=cut

sub parse_filename
{
	my $filename = shift @_;
	$filename = "" if ($filename eq "-");
	return $filename;
}

# -----------------------------------------------------------------------------
# ----------------------------------------------- config reading --------------
# -----------------------------------------------------------------------------

=item load_config

Load program configuration from the files whose names are given in the first
argument as an array, and write the configuration into the hash, a reference to
which is given as the second argument. The third argument is a boolean "verbose"
which sets whether to report successful operations to stdout. The fourth
argument is a boolean "quiet" which sets whether warnings should be supressed.

The files should be given in reverse priority order, and are then read in the
order of the array. This means later files' configuration will override what was
read earlier, thus "higher priority" files come after "lower priority" ones. For
example, per-user configuration should probably override global system
configuration, thus the user configuration file comes *after* the global system
configuration file in the array.

If a configuration file is not found, a warning is issued and the file is
skipped, proceeding to the next file on the list.

A reference to the hash (i.e. the second argument) is returned on success, and
an empty string is returned on failure.

=cut

sub load_config
{
	my ($filenames, $config, $verbose, $quiet) = @_;
	
	for my $filename (@${filenames})
	{
		my $succ = open my $in, "<", $filename;
		if (! $succ)
		{
			warn "Can't open config file $filename: $!\n" unless $quiet;
			next;
		}
		
		print "Reading config file $filename\n" if $verbose;
		
		$config->{subst_from} = <$in>;
		$config->{subst_to} = <$in>;
		chomp $config->{subst_from};
		chomp $config->{subst_to};
		
		my $reading_out = $FALSE;
		while (my $line = <$in>)
		{
			chomp $line;
			if ($reading_out)
			{
				if ($line eq "")
				{
					warn "Empty output filename found in config file ",
					     $filename, "\n" unless $quiet;
				}
				else
				{
					push @{$config->{"out_filenames"}}, $line;
				}
			}
			else
			{
				if ($line eq "")
				{
					$reading_out = $TRUE;
				}
				else
				{
					push @{$config->{"in_filenames"}}, $line;
				}
			}
		}
		
		my $ret = close $in;
		warn "$in: $!\n" unless ($ret or $quiet);
	}
	
	return $config;
}

=item get_config

Get the value of a configuration variable whose name is given as the second
argument, from the configuration hash, a reference to which is given as the
first argument. Return that value.

An empty string is returned if no value is found, and if the value is empty. If
the value is an array, a reference to it is returned. If the name points to a
subtree of the configuratio hierarchy and not to a value, a hash reference is
returned, pointing to the referred subtree.

The name refers to a path in the configuration hierarchy, where components are
separated by periods. Each component begins with a letter, and must contain
only letters, digits, dashes and undercores. Other names may work, but it isn't
guaranteed. Names are case-sensitive.

=cut

sub get_config
{
	my ($config, $name) = @_;
	my @components = split /\./, $name;
	my $node = $config;
	
	for my $component (@components)
	{
		if (exists $node->{$component})
		{
			$node = $node->{$component};
		}
		else
		{
			$node = "";
			last;
		}
	}
	
	return $node;
}

# -----------------------------------------------------------------------------
# ----------------------------------------------- template generation ---------
# -----------------------------------------------------------------------------

=item stream_template

Write generated output from a template file and a substitution pattern.

This function take an input stream, an output stream, a string to search for and
a string with which to substitute occurences found. It reads the input line by
line, and for each line it generates a new line it appends to the output.

=cut

sub stream_template
{
	my ($in, $out, $subst_from, $subst_to) = @_;
	
	while (my $line = <$in>)
	{
		$line =~ s/$subst_from/$subst_to/g;
		print $out $line;
	}
}

=item generate_template

Generate output from a template file and a substitution pattern.

This function take an input filename, an output filename, a string to search for
and a string with which to substitute occurences found. It reads the input line
by line, and for each line it generates a new line it appends to the output. It
additionally takes a boolean parameter "verbose" which indicates whether log
messages should be printed. They are printed to stdout regardless or the chosen
output file.

If the input filename is empty, input is read from stdin. If the output filename
is empty, output is written to stdout.

If two filenames are specified, they must refer to different files.

=cut

sub generate_template
{
	my ($in_filename, $out_filename, $subst_from, $subst_to, $verbose) = @_;
	
	my $in = \*STDIN;
	my $out = \*STDOUT;
	
	# open files
	if ($in_filename ne "")
	{
		print "Opening input file $in_filename...\n" if $verbose;
		open ($in, "<", $in_filename) or die "Can't open $in_filename: $!";
	}
	if ($out_filename ne "")
	{
		print "Opening output file $out_filename...\n" if $verbose;
		open ($out, ">", $out_filename) or die "Can't open $out_filename: $!";
	}
	
	# print substituted content line by line
	stream_template $in, $out, $subst_from, $subst_to;
	
	# close files
	if ($in_filename ne "")
	{
		print "Closing input file $in_filename...\n" if $verbose;
		close $in or die "$in: $!";
	}
	if ($out_filename ne "")
	{
		print "Closing output file $out_filename...\n" if $verbose;
		close $out or die "$out: $!";
	}
}

=item make_template

Generate output from a template file and a substitution pattern.

This function take an input filename, an output filename, a string to search for
and a string with which to substitute occurences found. It reads the input line
by line, and for each line it generates a new line it appends to the output.

It also takes a boolean "force" parameter which specifies whether to overwrite
in case the filenames are identical.

It additionally takes a boolean parameter "verbose" which indicates whether log
messages should be printed. They are printed to stdout regardless or the chosen
output file.

If the input filename is empty, input is read from stdin. If the output filename
is empty, output is written to stdout.

If two filenames are specified, they must refer to different files.

=cut

sub make_template
{
	my
	(
		$in_filename,
		$out_filename,
		$subst_from,
		$subst_to,
		$force,
		$verbose
	) = @_;
	
	my $overwrite = $force;
	my $ans = "";
	
	# handle case of identical filename
	#TODO different names can link to the same file!
	#if it's practical, use file descriptors or inodes somehow to really tell
	#whether input and output are the same physical file
	if ($in_filename ne ""  &&  $in_filename eq $out_filename)
	{
		# if overwrite wasn't asked by user, ask now
		unless ($overwrite)
		{
			until ($ans eq "y\n"  ||  $ans eq "n\n")
			{
				print "Are you sure you want to overwrite the file? (y/n) ";
				$ans = <STDIN>;
			}
			if ($ans eq "y\n")
			{
				$overwrite = $TRUE;
			}
		}
		
		# if we got green light to overwrite, go for it
		if ($overwrite)
		{
			#TODO maybe reimplement this using a temp file as a proxy,
			#     so that we never need to read whole files into main memory
			#     it also means to reuse the not-same-file code, once we read
			#     the content into the temp file
			# read the whole file in one go
			my $in = \*STDIN;
			my $out = \*STDOUT;
			
			print "Opening file $in_filename...\n" if $verbose;
			open ($in, "<", $in_filename) or die "Can't open $in_filename: $!";
			my @lines = <$in>;
			close $in or print "$in: $!";
		
			# open output file and write substituted lines one by one
			open ($out, ">", $out_filename) or die "Can't open $out_filename: $!";
			foreach my $line (@lines)
			{
				$line =~ s/$subst_from/$subst_to/g;
				print $out $line;
			}
			close $out or print "$out: $!";
		}
		else
		{
			print "Doing nothing.\n";
		}
	}
	else # handle case of different source and target
	{
		generate_template $in_filename,
		                  $out_filename,
		                  $subst_from,
		                  $subst_to,
		                  $verbose;
	}
}

=item make_templates

Generate a set of output templates from a metatemplate file and a single
substitution pattern.

This function a configuration hash. It reads each input line by line, and for
each line it generates a new line it appends to the output.

It also takes a boolean "force" parameter which specifies whether to overwrite
in case the filenames are identical.

It additionally takes a boolean parameter "verbose" which indicates whether log
messages should be printed. They are printed to stdout regardless or the chosen
output file.

=cut

sub make_templates
{
	my ($config, $force, $verbose) = @_;
	
	my $in_filenames = get_config $config, "in_filenames";
	my $out_filenames = get_config $config, "out_filenames";
	my $last = @{$in_filenames} - 1;
	for my $i (0 .. $last)
	{
		my $in_filename = parse_filename $in_filenames->[$i];
		my $out_filename = parse_filename $out_filenames->[$i];
		make_template $in_filename,
		              $out_filename,
		              $config->{subst_from},
		              $config->{subst_to},
		              $force,
		              $verbose;
	}
}

# -----------------------------------------------------------------------------
# ----------------------------------------------- main ------------------------
# -----------------------------------------------------------------------------

sub main
{
	# model
	my $class_header_template =
	{
		file    => "util/templates/MyClass.hpp",
		mapping =>
		{
			'MyClass.hpp'     => 'file_name',
			#'MyProject'       => 'project_name',
			#'Copyleft'        => 'copyright_word',
			#'(C)'             => 'copyright_symbol',
			#'2014'            => 'year',
			'John Doe'        => 'author',
			'jdoe@riseup.net' => 'email',
			'MY_CLASS_HPP_'   => 'header_guard',
			#'myproj'          => 'namespace',
			#'util'            => 'nested_namespace',
			'MyClass'         => 'class_name'
		}
	};
	
	# meta config
	my $prog_name = "skapa";
	my @config_files = (".$prog_name/config",
	                    "/etc/$prog_name.conf",
	                    "~/.$prog_name-config",
	                    ".$prog_name-local/config",
	                    "config");#TODO last file added just for testing
	
	# config
	my $config =
	{
		in_filenames  => [],
		out_filenames => [],
		subst_from    => '!@#$%^&*()',
		subst_to      => 'hello world'
	};
	
	# arguments
	my $force = $FALSE;
	my $verbose = $TRUE;
	my $quiet = $FALSE;
	
	# load configuration from config files
	load_config \@config_files, $config, $verbose, $quiet;
	
	# create template from meta-template
	make_templates $config, $force, $verbose;
	
	# exit
	print "Done.\n" if $verbose;
}

# run the program
main;
[See repo JSON]
Clone

Branches

Tags

create.pl
