#!/usr/local/bin/perl
# -*- perl -*-
######################################################################
# CereaUtils.pm -- Utilities for the cerea module system
# Copyright (c) 2006 Tero Kivinen
# All Rights Reserved.
######################################################################
#         Program: CereaUtils.pm
#	  $Source: /home/cereacvs/cvsroot/cerea2/perllib/CereaUtils.pm,v $
#	  Author : $Author: kivinen $
#
#	  (C) Tero Kivinen 2006 <kivinen@iki.fi>
#
#	  Creation          : 18:56 Oct 25 2006 kivinen
#	  Last Modification : 22:19 tammi 22 2007 smbkivinen
#	  Last check in     : $Date: 2007/01/22 20:23:39 $
#	  Revision number   : $Revision: 1.6 $
#	  State             : $State: Exp $
#	  Version	    : 1.186
#	  Edit time	    : 62 min
#
#	  Description       : Utilities for the cerea module system
#
#	  $Log: CereaUtils.pm,v $
#	  Revision 1.6  2007/01/22 20:23:39  kivinen
#	  	Removed sef and pfx files from the file list (i.e. they are
#	  	not copied to module anymore, they are now part of the hak
#	  	pak).
#	
#	  Revision 1.5  2006/11/01 22:48:00  kivinen
#	  	Fixed writing module to $output not to $Opt::module.
#	
#	  Revision 1.4  2006/10/25 20:40:07  kivinen
#	  	Fixed debug prints to be more clear.
#	
#	  Revision 1.3  2006/10/25 20:37:11  kivinen
#	  	Added check that we do not initialize verbose if it set on the
#	  	config file.
#	
#	  Revision 1.2  2006/10/25 19:26:38  kivinen
#	  	New version.
#	
#	  Revision 1.1  2006/10/25 18:50:24  kivinen
#	  	New version of libraries. Initial versions of the import
#	  	and export utilities.
#	
#	  $EndLog$
#
#
######################################################################
# initialization

require 5.6.0;
package CereaUtils;
use strict;
use Carp;
use Pod::Usage;
use File::Glob ':glob';
use Getopt::Long;
eval("use Archive::Zip qw( :ERROR_CODES :CONSTANTS );");
use Erf;
use ErfRead;

######################################################################
# get_version()
#
# Reads the program version and fills in the $Prog::program,
# $Prog::revision, $Prog::save_version, $Prog::edit_time, and
# $Prog::version

sub get_version {
    open(PROGRAM, "<$0") || die "Cannot open myself from $0 : $!";
    undef $/;
    $Prog::program = <PROGRAM>;
    $/ = "\n";
    close(PROGRAM);
    if ($Prog::program =~ /\$revision:\s*([\d.]*)\s*\$/i) {
	$Prog::revision = $1;
    } else {
	$Prog::revision = "?.?";
    }
    
    if ($Prog::program =~ /version\s*:\s*([\d.]*\.)*([\d]*)\s/mi) {
	$Prog::save_version = $2;
    } else {
	$Prog::save_version = "??";
    }
    
    if ($Prog::program =~ /edit\s*time\s*:\s*([\d]*)\s*min\s*$/mi) {
	$Prog::edit_time = $1;
    } else {
	$Prog::edit_time = "??";
    }
    
    $Prog::version = "$Prog::revision.$Prog::save_version.$Prog::edit_time";
    $Prog::progname = $0;
    $Prog::progname =~ s/^.*\///g;
}

######################################################################
# read_config($config, $homedotrc)
#
# First check if the $homedotrc is found from the users home directory.
# If so read it in and parse the options specified there. After that
# see if the $config file exists and if so read it in and parse it.
#
# Config files have format of
# 
# Keyword
# Keyword=value
# Keyword="value"
#
# Lines can be concatenated by adding \ to the end of line.
# If there is whitespaces before \ or in the beginning of next line
# then all that whitespace is replaced with single space. If there is
# no whitespace then no whitespace is added.
# If the text contains \n or \t then they are replaced with newline
# and tab respectively.
#
# If no value is given then $Opt::keyword is set to 1. Otherwise
# the value is stored to the variable $Opt::keyword, where keyword
# is converted to lowercase.
# Whitespace before and after "=" is removed, and one set of " is also
# removed. Whitespace at the end of the line is also removed.

sub read_config {
    my($config, $homedotrc) = @_;

    read_rc_file($config);
    if (defined($ENV{'HOME'})) {
	read_rc_file("$ENV{'HOME'}/$homedotrc");
    }
}

######################################################################
# read_rc_file($filename)
#
# Reads rc file

sub read_rc_file {
    my($file) = @_;
    my($next, $space);
    
    if (open(RCFILE, "<$file")) {
	while (<RCFILE>) {
	    chomp;
	    while (/\\$/) {
		$space = 0;
		if (/\s+\\$/) {
		    $space = 1;
		}
		s/\s*\\$//g;
		$next = <RCFILE>;
		chomp $next;
		if ($next =~ s/^\s+//g) {
		    $space = 1;
		}
		if ($space) {
		    $_ .= " " . $next;
		} else {
		    $_ .= $next;
		}
	    }
	    if (/^\s*([a-zA-Z0-9_]+)\s*$/) {
		eval('$Opt::' . lc($1) . ' = 1;');
	    } elsif (/^\s*([a-zA-Z0-9_]+)\s*=\s*\"([^\"]*)\"\s*$/) {
		my($key, $value) = ($1, $2);
		$value =~ s/\\n/\n/g;
		$value =~ s/\\t/\t/g;
		eval('$Opt::' . lc($key) . ' = $value;');
	    } elsif (/^\s*([a-zA-Z0-9_]+)\s*=\s*(.*)\s*$/) {
		my($key, $value) = ($1, $2);
		$value =~ s/\\n/\n/g;
		$value =~ s/\\t/\t/g;
		eval('$Opt::' . lc($key) . ' = $value;');
	    }
	}
	close(RCFILE);
    }
}

######################################################################
# @files = get_file_names($top);
#
# Get file names to be processed.

sub get_file_names {
    my($top) = @_;
    my($dir, @files);

    foreach $dir ('creatures', 'dialogs', 'encounters',
		  'generic-scripts', 'items', 'other-scripts',
		  'placeables', 'sounds', 'triggers',
		  'visuals') {
	push(@files, bsd_glob($top . "/" . $dir . "/*"));
    }
    @files = grep { /\.(ut[ceipst]|dlg|nss|upe)$/ &&
			-f $_; } @files;

    if (defined($Opt::include_regexp)) {
	@files = grep { m/$Opt::include_regexp/; } @files;
    }
    if (defined($Opt::exclude_regexp)) {
	@files = grep { !m/$Opt::exclude_regexp/; } @files;
    }
    return @files;
}

######################################################################
# parse_options(%extra_options);
#
# Parse generic options including extra options.

sub parse_options {
    my(@extra_options) = @_;
    
    Getopt::Long::Configure("no_ignore_case");
    if (!defined($Opt::verbose)) {
	$Opt::verbose = 0;
    }
    
    if (!GetOptions(@extra_options,
		    "config=s" => \$Opt::config,
		    "verbose|v+" => \$Opt::verbose,
		    "help|h" => \$Opt::help,
		    "module|m=s" => \$Opt::module,
		    "include|I=s" => \$Opt::include_regexp,
		    "exclude|E=s" => \$Opt::exclude_regexp,
		    "version|V" => \$Opt::version) || defined($Opt::help)) {
	&Pod::Usage::pod2usage(0);
	exit(0);
    }

    if (defined($Opt::version)) {
	print("\u$Prog::progname version $Prog::version by Tero Kivinen.\n");
	exit(0);
    }

    while (defined($Opt::config)) {
	my($tmp);
	$tmp = $Opt::config;
	undef $Opt::config;
	if (-f $tmp) {
	    read_rc_file($tmp);
	} else {
	    die "Config file $Opt::config not found: $!";
	}
    }
    if (!defined($Opt::module)) {
	die "Mandatory module parameter not given";
    }
}

######################################################################
# %erf = read_module($Opt::module)
#
# Read module in, in case it is .mod file, read it from there, in
# case it is directory add each files to erf. 

sub read_module {
    my($module) = @_;
    my($erf);
    
    print("Reading $module...\n") if ($Opt::verbose > 1);
    
    if (-d $module) {
	my($file, @files);
	print("Reading directory $module...\n") if ($Opt::verbose);
	$erf = new Erf;
	@files = bsd_glob($module . "/*");
	$erf->file_type("DIR ");
	foreach $file (@files) {
	    print("Found file $file...\n") if ($Opt::verbose > 2);
	    $erf->new_file($file);
	}
    } else {
	print("Reading $module...\n") if ($Opt::verbose);
	$erf = ErfRead::read('filename' => $module);
    }
    if (!defined($erf)) {
	die "Could not read module $module";
    }

    printf("Finished reading $module, %d resources\n",
	   $erf->resource_count()) if ($Opt::verbose);
    return $erf;
}

######################################################################
# write_module($Opt::module, $erf)
#
# Write module back, in case it is .mod file, it will write it with .mod.new
# first, then rename the old module to .mod.old and then rename the
# new module to .mod. In case it is directory add
# write modified files back to disk. 

sub write_module {
    my($module, $erf) = @_;
    my($resources);
    
    print("Writing $module...\n") if ($Opt::verbose > 1);
    
    if (-d $module) {
	my($i, $file);

	print("Writing directory $module...\n") if ($Opt::verbose);
	$resources = 0;
	for($i = 0; $i < $erf->resource_count; $i++) {
	    next if (!$erf->resource_has_data($i));
	    $resources++;
	    $file = $module . "/" . $erf->resource_reference($i) . "." .
		$erf->resource_extension($i);
	    print("Writing file $file...\n") if ($Opt::verbose > 2);
	    open(FILE, ">$file")
		|| die "Cannot write $file : $!";
	    binmode(FILE);
	    print(FILE $erf->resource_data($i));
	    close(FILE);
	}
    } else {
	print("Writing $module.new...\n") if ($Opt::verbose);
	&ErfWrite::write($erf, 'filename' => $module . ".new");
	rename($module, $module . ".old") ||
	    die "Rename of old failed: $!";
	rename($module . ".new", $module) ||
	    die "Rename of new failed: $!";
	$resources = $erf->resource_count();
    }
    printf("Finished writing $module, wrote %d resources\n",
	   $resources) if ($Opt::verbose);
    return $erf;
}

1;

######################################################################
# EOF
######################################################################

__END__

=head1 NAME

CereaUtils - Perl Module to provide utility functions 

=head1 ABSTRACT

This module contains all kind of utility functions for the generic use. 

=head1 B<get_version>

=head2 DESCRIPTION

Find the program version and fill in the B<$Prog::program>,
B<$Prog::revision>, B<$Prog::save_version>, B<$Prog::edit_time>, and
B<$Prog::version>.

=over 4

=head2 USAGE

get_version();

=back

=head1 B<read_config>

=head2 DESCRIPTION

First check if the $homedotrc is found from the users home directory.
If so read it in and parse the options specified there. After that
see if the $config file exists and if so read it in and parse it.

Config files have format of

=over 4
 
	Keyword
	Keyword=value
	Keyword="value"
	Keyword = "  value \
                     continuation value   "

=back

Lines can be concatenated by adding \ to the end of line.
If there is whitespaces before \ or in the beginning of next line
then all that whitespace is replaced with single space. If there is
no whitespace then no whitespace is added.
If the text contains \n or \t then they are replaced with newline
and tab respectively.

If no value is given then $Opt::keyword is set to 1. Otherwise
the value is stored to the variable $Opt::keyword, where keyword
is converted to lowercase.

Whitespace before and after "=" is removed, and one set of " is also
removed. Whitespace at the end of the line is also removed.

=over 4

=head2 USAGE

read_config(I<$config>, I<$homedotrc>);

=back

=head1 B<read_rc_file>

=head2 DESCRIPTION

Read the config file in and parse it. 

Config files have format of

=over 4
 
	Keyword
	Keyword=value
	Keyword="value"
	Keyword = "  value \
                     continuation value   "

=back

Lines can be concatenated by adding \ to the end of line.
If there is whitespaces before \ or in the beginning of next line
then all that whitespace is replaced with single space. If there is
no whitespace then no whitespace is added.
If the text contains \n or \t then they are replaced with newline
and tab respectively.

If no value is given then $Opt::keyword is set to 1. Otherwise
the value is stored to the variable $Opt::keyword, where keyword
is converted to lowercase.

Whitespace before and after "=" is removed, and one set of " is also
removed. Whitespace at the end of the line is also removed.

=over 4

=head2 USAGE

read_rc_file(I<$file>);

=back

=head1 B<get_file_names>

=head2 DESCRIPTION

Returns array of file names to be processed. This only includes known
nwn file types from the known directories. 

=over 4

=head2 USAGE

@files = get_file_names(I<$top>);

=back

=head1 B<parse_options>

=head2 DESCRIPTION

Parse generic options. Hash of extra options can also be given, and
those are passed to the GetOptions packege.

=over 4

=head2 USAGE

parse_options(I<%extra_opts>);

=back

=head1 SEE ALSO

Gff(3), GffRead(3), and GffWrite(3).

=head1 AUTHOR

Tero Kivinen <kivinen@iki.fi>.

=head1 HISTORY

Created to do module cvs handling for the cerea2 persistent world. 

=cut