gecko-dev/tools/wizards/new-from-template.pl

#!/usr/bin/perl
#
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is mozilla template processor.
#
# The Initial Developer of the Original Code is
# Netscape Communications Corporation.
# Portions created by the Initial Developer are Copyright (C) 1997-1999
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
#
# ***** END LICENSE BLOCK *****

use strict;
use FileHandle;
use Getopt::Std;

my $pnm = $0;
my $description_var = "template_description";

my %opts;
getopts ("t:o:fdh?", \%opts);

if ($opts{"?"}) {
    usage();
}

my $vars_file = $opts{"t"} || usage();
my $out_dir = $opts{"o"} || "nft-results/";
if (!($out_dir =~ /\/$/)) {
    $out_dir = $out_dir . "/";
}

my @dereferences_in_progress = ();
my %vars;

$vars{"top_wizard_dir"} = {
                           value => "./",
                           processed => 1
                          };

if ($opts{"h"}) {
    load_vars_file($vars_file);
    show_description();
    exit 0;
}

if (-d $out_dir) {
    if ($opts{"f"}) {
        if ($opts{"d"}) {
            `rm -rf $out_dir`;
        }
    } elsif ($opts{"d"}) {
        die "$pnm: bad option: -d (delete output directory, recusive) can " .
          "only be used with -f (force.)\n";
    } else {
        die "$pnm: output directory ($out_dir) exists: use the -f (force) " .
          "option to continue anyway.  Files in the output directory with the " .
          "same name as template files will be overwritten.\n";
    }
}

load_vars_file($vars_file);
process_all_vars ();
process_template_dir (get_var("template_dir", $pnm), $out_dir);

exit 0;

sub usage () {
    print STDERR
      "Usage: $pnm -t <template-file> [-o <output-dir>]\n" .
      "            [-f[d]] [-h] [-?]\n" .
      "\n" .
      " -t FILE       The template to use.\n" .
      " -o DIRECTORY  The directory to write results to.\n" .
      " -f            Force overwriting of files in the output directory.\n" .
      " -d            Recursively delete the output directory before starting\n" .
      "               (requires -f.)\n" .
      " -h            Display description of the selected template.  Template\n" .
      "               will not be processed.\n" .
      " -?            Display this message.\n";

    exit 1;

}

sub show_description () {
    my $desc = get_var_with_default ($description_var);

    if ($desc) {
        print "Description of $vars_file:\n\n$desc\n\n";
    } else {
        print "Template file $vars_file contains no description.\n";
    }

}

sub process_template_dir {
    my ($from_dir, $to_dir) = @_;

    print "Processing template files $from_dir -> $to_dir\n";

    if (!( -d $to_dir)) {
        print "mkdir $to_dir\n";
        mkdir $to_dir;
    }
    
    my @dirs = get_subdirs($from_dir);
    my $dir;
    foreach $dir (@dirs) {
        process_template_dir ("$from_dir$dir/", "$to_dir$dir/");
    }

    my @files = get_files($from_dir);
    my $file;
    foreach $file (@files) {
        my $to_file = get_var_with_default ("filename:$file", $file,
                                            "rename target for file $file");
        open (TO,  ">$to_dir$to_file") || die "Couldn't open $to_dir$to_file\n";
        print TO process_file ("$from_dir$file");
        close TO;
    }
}

sub load_vars_file {
    my ($filename) = @_;
    my $fh = new FileHandle;

    $fh->open ($filename) || die ("Couldn't open vars file $filename\n");

    my $line;
    my $line_no = 1;
    my $continue_line;
    my $var_name = "";
    my $var_value = "";

    while ($line = <$fh>) {
        chomp($line);
        if ($continue_line) {
            # continuation of previous line
            $line =~ /^(.*)(\\)?$/;
            $var_value .= $1;
            $continue_line = $2 ? 1 : 0;
        } elsif ($line =~ /^\s*([\w\:\-]+)\s*=\s*(.*)$/) {
            # var=value line
            $var_name = $1;
            $var_value = $2;
            if ($var_value =~ /\\$/) {
                $continue_line = 1;
                $var_value .= "$var_value\n";
            } else {
                $continue_line = 0;
            }
        } elsif ($line =~ /^include\s*\"(.*?)\"\s*$/i) {
            # include line
            load_vars_file(process_string($1, "$filename, line $line_no"));
        } elsif ($line =~ /^rename\s*\(\s*\"(.*?)\"\s*,\s*\"(.*?)\"\s*\)\s*$/i) {
            # rename line
            $var_name = "filename:$1";
            $var_value = $2;
        } elsif ($line =~ /^(\s*\#.*)?$/) {
            # comment or blank line, ignore
            $var_name = "";
        } else {
            die ("Huh?\nFile: $filename, Line: $line_no\n$line\n");
        }

        if ($var_name && !$continue_line) {
            if ($var_name ne $description_var ||
                $filename eq $vars_file) {
                # don't set the description unless it's comming from the
                # main template file.
                $vars{$var_name} = {
                                    value => $var_value,
                                    processed => 0
                                   };
            }
        }
        ++$line_no;
    }

    close ($fh);
}

sub get_var_with_default {
    my ($var_name, $default, $source) = @_;
    my $c = $vars{$var_name};

    #print "getting var $var_name\n";

    if (!$c) {
        return $default;
    }
        
    if (!$c->{"processed"}) {
        if (grep(/^$var_name$/, @dereferences_in_progress)) {
            die "Circular reference to $var_name while processing $source\n";
        }
        push (@dereferences_in_progress, $var_name);
        my $val = $c->{"value"};
        if ($val =~ /^\s*file\s*\(\s*\"(.*)\"\s*\)\s*$/i) {
            # get value from a file
            #print "loading $1\n";
            $c->{"value"} = process_file (process_string($1, $source));
        } elsif ($val =~ /^eval\s*\(\s*\"(.*)\"\s*\)\s*$/i) {
            # get value from a perl eval() call
            my $eval_str = process_string ($1, $source);
            $c->{"value"} = eval ($eval_str);
        } else {
            $c->{"value"} = process_string ($val, "variable $var_name");
        }
        $c->{"processed"} = 1;
        if (pop(@dereferences_in_progress) ne $var_name) {
            die "Internal error: dereference stack mismatch.";
        }
    }

    return $c->{"value"};
}

sub get_var {
    my ($var_name, $source) = @_;
    my $c = $vars{$var_name};
    my $default;

    #print "getting var $var_name\n";

    if (!$c) {
        if ($var_name =~ /filename:(.+)/i) {
            $default = $1;
        } else {
            die ("Undefined variable $var_name referenced in $source\n");
        }
    }
        
    return get_var_with_default ($var_name, $default, $source);
    
}

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

    #print "processing $file\n";
    open (FROM, "$file") || die "Couldn't open $file\n";
    my @contents = <FROM>;
    my $results = process_string (join ("", @contents), "file $file");
    close FROM;

    return $results;
}

sub process_string {
    my ($str, $source) = @_;

    my @lines = split(/\n/, $str, -1);
    my $i;
    for $i (0 .. $#lines) {
        @lines[$i] = process_single_line_string ($lines[$i],
                                                 "$source, line " . ($i + 1));
    }
    return join ("\n", @lines);
}

sub process_single_line_string {
    my ($str, $source) = @_;
    my $start_pos = index ($str, '${');
    if ($start_pos == -1) {
        return $str;
    }
    my $end_pos = -1;
    my $str_len = length ($str);

    #print "processing string '$str'\n";

    my $result_str = substr($str, 0, $start_pos);

    while ($start_pos != -1 && $start_pos != $str_len) {
        $start_pos += 2;
        $end_pos = index ($str, "}", $start_pos);

        if ($end_pos == -1) {
            $end_pos = $start_pos;
        } else {
            my $var_name = substr ($str, $start_pos, $end_pos - $start_pos);
            $result_str .= get_var ($var_name, $source);
        }
        $start_pos = index ($str, '${', $end_pos);
        if ($start_pos == -1) {
            $start_pos = $str_len;
        }
        $result_str .= substr ($str, $end_pos + 1, $start_pos - $end_pos - 1);
    }

    return $result_str;
}

sub process_all_vars {
    # calling get_var on all variables causes them all to be dereferenced.
    # useful for flushing out undefined variables.
    my $var_name;
    
    foreach $var_name (keys(%vars)) {
        my $var_value = get_var ($var_name);
        #print "var name $var_name is $var_value\n";
    }
}

#
# given a uuid, return it in a format suitable for #define-ing
#
sub define_guid {
    my ($uuid) = @_;

    $uuid =~ /([a-f\d]+)-([a-f\d]+)-([a-f\d]+)-([a-f\d]+)-([a-f\d]+)/i;
    my $uuid_out = "{ /* $uuid */         \\\n" .
                   "     0x$1,                                     \\\n" .
                   "     0x$2,                                         \\\n" .
                   "     0x$3,                                         \\\n";

    my @rest =  ( "0x" . substr ($4, 0, 2), "0x" . substr ($4, 2, 2) );
    my $i = 0;
    while ($i < length ($5)) {
        push (@rest, "0x" . substr ($5, $i, 2));
        $i += 2;
    }

    my $rv = $uuid_out;
    $rv .= "    {" . join (", ", @rest) . "} \\\n";
    $rv .= "}\n";

    return $rv;
}

#
# given a directory, return an array of all the files that are in it.
#
sub get_files {
    my ($subdir) = @_;
    my (@file_array, @subdir_files);
    
    opendir (SUBDIR, $subdir) || die ("couldn't open directory $subdir: $!");
    @subdir_files = readdir(SUBDIR);
    closedir(SUBDIR);
    
    foreach (@subdir_files) {
        my $file = $_;
        if (!($file =~ /[\#~]$/) && -f "$subdir$file") {
            $file_array[$#file_array+1] = $file;
        }
    }
    
    return @file_array;
}

#
# given a directory, return an array of all subdirectories
#
sub get_subdirs {
    my ($dir)  = @_;
    my @subdirs;
    
    if (!($dir =~ /\/$/)) {
        $dir = $dir . "/";
    }
        
    opendir (DIR, $dir) || die ("couldn't open directory $dir: $!");
    my @testdir_contents = readdir(DIR);
    closedir(DIR);
    
    foreach (@testdir_contents) {
        if ((-d ($dir . $_)) && ($_ ne 'CVS') && (!($_ =~ /^\..*/))) {
            @subdirs[$#subdirs + 1] = $_;
        }
    }

    return @subdirs;
}