Perl code for generating "map" routines from a common template with

supplied type info.

* ktemplate.pm: Code for parsing a command line and writing out a
supplied template with substitutions.
* gen-map.pl: Parameter info and template for "map" type.

git-svn-id: svn://anonsvn.mit.edu/krb5/trunk@19669 dc483132-0cff-0310-8789-dd5450dbe970

diff --git a/src/util/gen-map.pl b/src/util/gen-map.pl
new file mode 100644 (file)
index 0000000..23d9465
--- /dev/null
+++ b/src/util/gen-map.pl
@@ -0,0 +1,111 @@
+#!perl -w
+use ktemplate;
+# List of parameters accepted for substitution.
+@parms = qw(NAME KEY VALUE COMPARE COPYKEY FREEKEY FREEVALUE);
+# Defaults, if any.
+$parm{"COPYKEY"} = "0";
+$parm{"FREEKEY"} = "0";
+$parm{"FREEVALUE"} = "0";
+#
+&run;
+#
+__DATA__
+/*
+ * map, generated from template
+ * map name: <NAME>
+ * key: <KEY>
+ * value: <VALUE>
+ * compare: <COMPARE>
+ * copy_key: <COPYKEY>
+ * free_key: <FREEKEY>
+ * free_value: <FREEVALUE>
+ */
+struct <NAME>__element {
+    <KEY> key;
+    <VALUE> value;
+    struct <NAME>__element *next;
+};
+struct <NAME>__head {
+    struct <NAME>__element *first;
+};
+typedef struct <NAME>__head <NAME>;
+static inline int <NAME>_init (struct <NAME>__head *head)
+{
+    head->first = NULL;
+    return 0;
+}
+static inline void <NAME>_destroy (struct <NAME>__head *head)
+{
+    struct <NAME>__element *e, *e_next;
+    void (*free_key)(<KEY>) = <FREEKEY>;
+    void (*free_value)(<VALUE>) = <FREEVALUE>;
+    for (e = head->first; e; e = e_next) {
+       e_next = e->next;
+       if (free_key)
+           (*free_key)(e->key);
+       if (free_value)
+           (*free_value)(e->value);
+       free(e);
+    }
+    head->first = NULL;
+}
+/* Returns pointer to linked-list entry, or null if key not found.  */
+static inline struct <NAME>__element *
+<NAME>__find_node (struct <NAME>__head *head, <KEY> key)
+{
+    struct <NAME>__element *e;
+    for (e = head->first; e; e = e->next)
+       if (<COMPARE> (key, e->key) == 0)
+           return e;
+    return 0;
+}
+/* Returns pointer to value, or null if key not found.  */
+static inline <VALUE> *
+<NAME>_find (struct <NAME>__head *head, <KEY> key)
+{
+    struct <NAME>__element *e = <NAME>__find_node(head, key);
+    if (e)
+       return &e->value;
+    return 0;
+}
+/* Returns 0 or error code.  */
+static inline int
+<NAME>__copy_key (<KEY> *out, <KEY> in)
+{
+    int (*copykey)(<KEY> *, <KEY>) = <COPYKEY>;
+    if (copykey == 0) {
+       *out = in;
+       return 0;
+    } else
+       return (*copykey)(out, in);
+}
+/* Returns 0 or error code.  */
+static inline int
+<NAME>_replace_or_insert (struct <NAME>__head *head,
+                         <KEY> key, <VALUE> new_value)
+{
+    struct <NAME>__element *e = <NAME>__find_node(head, key);
+    int ret;
+
+    if (e) {
+       /* replace */
+       void (*free_value)(<VALUE>) = <FREEVALUE>;
+       if (free_value)
+           (*free_value)(e->value);
+       e->value = new_value;
+    } else {
+       /* insert */
+       e = malloc(sizeof(*e));
+       if (e == NULL)
+           return ENOMEM;
+       ret = <NAME>__copy_key (&e->key, key);
+       if (ret) {
+           free(e);
+           return ret;
+       }
+       e->value = new_value;
+       e->next = head->first;
+       head->first = e;
+    }
+    return 0;
+}

diff --git a/src/util/ktemplate.pm b/src/util/ktemplate.pm
new file mode 100644 (file)
index 0000000..f5f9ab7
--- /dev/null
+++ b/src/util/ktemplate.pm
@@ -0,0 +1,67 @@
+# -*- perl -*-
+
+sub usage {
+    print STDERR "usage: $0 -oOutputFile PARM=value ...\n";
+    print STDERR "  where acceptable PARM values are:\n";
+    print STDERR "\t", join(' ', @parms), "\n";
+    exit(1);
+}
+
+%parm = ();
+sub run {
+    my $arg;
+    my $outfile;
+    my %allowed_parms = ();
+
+    foreach $arg (@parms) { $allowed_parms{$arg} = 1; }
+
+    foreach $arg (@ARGV) {
+       if ($arg =~ /^-o./) {
+           if (defined $outfile) {
+               die "$0: Output file specified multiple times\n";
+           }
+           $outfile = substr($arg, 2);
+       } else {
+           my @words = split '=', $arg;
+           if ($#words != 1) {
+               print STDERR "$0: $arg : #words = $#words\n";
+               &usage;
+           }
+           if (!defined $allowed_parms{$words[0]}) {
+               print STDERR "$0: Unknown parameter $words[0]\n";
+               &usage;
+           }
+           $parm{$words[0]} = $words[1];
+       }
+    }
+    my $p;
+    my $subst = "";
+    #print "Keys defined: ", join(' ', keys %parm), "\n";
+    foreach $p (@parms) {
+       if (!defined $parm{$p}) {
+           die "$0: No value supplied for parameter $p\n";
+       }
+       # XXX More careful quoting of supplied value!
+       $subst .= "\t\$a =~ s|<$p>|$parm{$p}|go;\n";
+    }
+    $subst = "sub do_substitution {\n"
+       . "\tmy(\$a) = \@_;\n"
+       . $subst
+       . "\treturn \$a;\n"
+       . "}\n"
+       . "1;";
+    eval $subst || die;
+    if (defined $outfile) {
+       open OUTFILE, ">$outfile" || die;
+    } else {
+       print STDERR "$0: No output file specified.\n";
+       &usage;
+    }
+    while (<DATA>) {
+       print OUTFILE &do_substitution($_);
+    }
+    close OUTFILE;
+    exit (0);
+}
+
+1;