From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001
From: Erlang/OTP <otp@erlang.org>
Date: Fri, 20 Nov 2009 14:54:40 +0000
Subject: The R13B03 release.

---
 lib/kernel/src/inet_dns_record_adts.pl | 180 +++++++++++++++++++++++++++++++++
 1 file changed, 180 insertions(+)
 create mode 100644 lib/kernel/src/inet_dns_record_adts.pl

(limited to 'lib/kernel/src/inet_dns_record_adts.pl')

diff --git a/lib/kernel/src/inet_dns_record_adts.pl b/lib/kernel/src/inet_dns_record_adts.pl
new file mode 100644
index 0000000000..b1d8fab939
--- /dev/null
+++ b/lib/kernel/src/inet_dns_record_adts.pl
@@ -0,0 +1,180 @@
+#! /usr/bin/env perl
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# 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.
+# 
+# %CopyrightEnd%
+#
+use strict;
+
+# Generate ADT (Abstract Data Type) access and generation functions
+# for internal records.
+# 
+# The following defines which ADT function sets that will be generated
+# and which record fields that will be exponated.
+#
+# (FunctionBaseName => [RecordName, FieldName ...], ...)
+my %Names = ('msg' => ['dns_rec', 'header', 'qdlist',
+		       'anlist', 'nslist', 'arlist'],
+	     'dns_rr' => ['dns_rr', 'domain', 'type', 'class', 'ttl', 'data'],
+	     'dns_rr_opt' => ['dns_rr_opt', 'domain', 'type',
+			      'udp_payload_size', 'ext_rcode', 'version',
+			      'z', 'data'],
+	     'dns_query' => ['dns_query', 'domain', 'type', 'class'],
+	     'header' => ['dns_header', 'id', 'qr', 'opcode', 'aa', 'tc',
+			  'rd', 'ra', 'pr', 'rcode']);
+# The functions are defined in the __DATA__ section at the end.
+
+# Read in __DATA__ and merge lines.
+my $line = '';
+my @DATA;
+my @INDEX;
+while(<DATA>) {
+    chomp;
+    $line .= $_;
+    unless ($line =~ s/\\$//) {
+	if ($line =~ s/^[+]//) {
+	    push(@INDEX, $line);
+	} else {
+	    push(@DATA, $line);
+	}
+	$line = '';
+    }
+}
+
+$" = ',';
+$\ = "\n";
+while( my ($Name, $r) = each(%Names)) {
+    # Create substitutions for this Name
+    my ($Record, @Fields) = @{ $r };
+    my @FieldMatchValues;
+    my @FieldValueTuples;
+    my @Values;
+    my $n = $#{ $r };
+    for my $i ( 1 .. $n ) {
+	push(@FieldMatchValues, "$Fields[$i-1]=V$i");
+	push(@FieldValueTuples, "{$Fields[$i-1],V$i}");
+	push(@Values, "V$i");
+    }
+    # "@FieldMatchValues" = "field1=V1,field2=V2"...",fieldN=VN"
+    # "@FieldMatchTuples" = "{field1,V1},{field2,V2}"...",{fieldN,VN}"
+    # "@Values" = "V1,V2"...",VN"
+    my @D = @DATA;
+    foreach my $line (@D) {
+	my $m = 1;
+	# For leading * iterate $n times, otherwise once
+	$line =~ s/^\s*[*]// and $m = $n;
+	for my $i ( 1 .. $m ) {
+	    # For this iteration - substitute and print
+	    my $Value = "V$i";
+	    my $SemicolonDot = ";";
+	    $SemicolonDot = "." if $i == $m;
+	    my @ValuesIgnoreValue = @Values;
+	    $ValuesIgnoreValue[$i-1] = '_';
+	    # "$Value" = "V1" or "V2" or ... "VN"
+	    # "@ValuesIgnoreValue" = "_,V2"...",VN"
+	    #                     or "V1,_"...",VN"
+	    #                     or ... "V1,V2"...",_"
+	    $_ = $line;
+	    s/FieldMatchValues\b/@FieldMatchValues/g;
+	    s/FieldValueTuples\b/@FieldValueTuples/g;
+	    s/Field\b/$Fields[$i-1]/g;
+	    s/Name\b/$Name/g;
+	    s/Record\b/$Record/g;
+	    s/ValuesIgnoreValue\b/@ValuesIgnoreValue/g;
+	    s/Values\b/@Values/g;
+	    s/Value\b/$Value/g;
+	    s/[;][.]/$SemicolonDot/g;
+	    s/->\s*/->\n    /;
+	    print;
+	}
+    }
+}
+for my $i ( 0 .. $#INDEX ) {
+    my $line = $INDEX[$i];
+    if ($line =~ s/^[*]//) {
+	while( my ($Name, $r) = each(%Names)) {
+	    my ($Record) = @{ $r };
+	    $_ = $line;
+	    s/Name\b/$Name/g;
+	    s/Record\b/$Record/g;
+	    s/->\s*/->\n    /;
+	    print;
+	}
+    } else {
+	print $line;
+    }
+}
+
+# Trailing \ will merge line with the following.
+# Leading * will iterate the (merged) line over all field names.
+# Sub-words in the loop above are substituted.
+__DATA__
+
+%%
+%% Abstract Data Type functions for #Record{}
+%%
+%% -export([Name/1, Name/2,
+%%          make_Name/0, make_Name/1, make_Name/2, make_Name/3]).
+
+%% Split #Record{} into property list
+%%
+Name(#Record{FieldMatchValues}) -> \
+    [FieldValueTuples].
+
+%% Get one field value from #Record{}
+%%
+*Name(#Record{Field=Value}, Field) -> \
+    Value;
+%% Map field name list to value list from #Record{}
+%%
+Name(#Record{}, []) -> \
+    [];
+*Name(#Record{Field=Value}=R, [Field|L]) -> \
+    [Value|Name(R, L)];.
+
+%% Generate default #Record{}
+%%
+make_Name() -> \
+    #Record{}.
+
+%% Generate #Record{} from property list
+%%
+make_Name(L) when is_list(L) -> \
+    make_Name(#Record{}, L).
+
+%% Generate #Record{} with one updated field
+%%
+*make_Name(Field, Value) -> \
+    #Record{Field=Value};
+%%
+%% Update #Record{} from property list
+%%
+make_Name(#Record{FieldMatchValues}, L) when is_list(L) -> \
+    do_make_Name(L, Values).
+do_make_Name([], Values) -> \
+    #Record{FieldMatchValues};
+*do_make_Name([{Field,Value}|L], ValuesIgnoreValue) -> \
+    do_make_Name(L, Values);.
+
+%% Update one field of #Record{}
+%%
+*make_Name(#Record{}=R, Field, Value) -> \
+    R#Record{Field=Value};.
+
++%% Record type index
++%%
++*record_adts(#Record{}) -> Name;
++record_adts(_) -> undefined.
-- 
cgit v1.2.3