← Back to branch summary

~ubuntu-branches/ubuntu/wily/libsereal-encoder-perl/wily

« back to all changes in this revision

Viewing changes to author_tools/update_from_header.pl

  • Committer: Package Import Robot
  • Author(s): Alexandre Mestiashvili, Alexandre Mestiashvili, gregor herrmann
  • Date: 2015-04-29 11:12:18 UTC
  • mfrom: (17.1.6 sid)
  • Revision ID: package-import@ubuntu.com-20150429111218-v3ghc7ck5gcr38fu
Tags: 3.005.001-1
[ Alexandre Mestiashvili ]
* Imported Upstream version 3.005.001
* d/control: cme fix dpkg
* d/copyright: updated debian/* copyright year

[ gregor herrmann ]
* Mark package as autopkgtest-able.

Show diffs side-by-side

added added

removed removed

Lines of Context:
author_tools/update_from_header.pl
4
4
use Data::Dumper;
5
5
my (
6
6
    @meta,
 
7
    %range,                     # base types.
7
8
    %name_to_value,             # just the names in the srl_protocol.h
8
9
    %name_to_value_expanded,    # names from srl_protocol, but with the LOW/HIGH data expanded
9
10
    %value_to_name_expanded,    # values from srl_protocol_expanded, mapping back, note value points at FIRST name
10
11
    %value_to_comment_expanded  # values from srl_protocol_expanded, with comments from file.
11
12
);
12
13
my $max_name_length= 0;
 
14
my %define;
 
15
my %define_is_str;
13
16
 
14
 
sub fill_ranges {
 
17
sub fill_range {
15
18
    my $pfx= shift;
16
19
    $pfx=~s/_LOW//;
17
20
    defined(my $ofs= $name_to_value_expanded{$pfx})
27
30
        $meta[$value]{value}= $value;
28
31
        $meta[$value]{type_name}= $pfx;
29
32
        $meta[$value]{type_value}= $ofs;
 
33
 
 
34
        push @{$range{$pfx}}, $meta[$value];
30
35
        #$meta[$value]{comment}= $value_to_comment_expanded{ $ofs }
31
36
        #    if exists $value_to_comment_expanded{ $ofs };
32
37
 
33
38
        $meta[$value]{masked_val}= $n;
34
39
        $meta[$value]{masked}= 1;
35
40
 
 
41
        #$define{"SRL_HDR_".$name}= $value;
36
42
    }
37
43
    $value_to_comment_expanded{ $name_to_value_expanded{$pfx . "_HIGH"} } = $value_to_comment_expanded{ $ofs };
38
44
}
42
48
 
43
49
    my @fill;
44
50
    while (<$fh>) {
45
 
        if(m!^#define\s+SRL_HDR_(\S+)\s+\(\(char\)(\d+)\)\s*(?:/\*\s*(.*?)\s*\*/)?\s*\z!i) {
46
 
            my ($name, $value, $comment)= ($1, $2, $3);
 
51
        chomp;
 
52
        my $orig= $_;
 
53
        if(m!^#define\s+(SRL_HDR_(\S+))\s+\(\(U8\)(\d+)\)\s*(?:/\*\s*(.*?)\s*\*/)?\s*\z!i) {
 
54
            my ($full_name, $name, $value, $comment)= ($1, $2, $3, $4);
47
55
            $value= 0+$value;
48
56
            $name_to_value{$name}= $value;
49
57
            $name_to_value_expanded{$name}= $value;
51
59
            $value_to_comment_expanded{$value} ||= $comment;
52
60
            push @fill, $name if substr($name, -4) eq '_LOW';
53
61
 
54
 
            if ( $value < 128 ) {
 
62
            if ( $value < 128 && !($name=~/_LOW/ or $name=~/_HIGH/)) {
55
63
                $meta[$value]{name}= $name;
56
64
                $meta[$value]{value}= $value;
57
65
                $meta[$value]{type_name}= $name;
58
66
                $meta[$value]{type_value}= $value;
59
67
                $meta[$value]{comment}= $comment if defined $comment;
60
68
            }
 
69
            $define{$full_name}= $value;
 
70
        } elsif (s!^#define (SRL_\w+)\s+!!) {
 
71
            my $def= $1;
 
72
            s!/\*.*?(?:\*/|$)!!m;
 
73
            s!\(U8\)!!g;
 
74
            s!(SRL_\w+)!
 
75
                $define{$1} // die "Unknown define '$1'";
 
76
            !ge;
 
77
            s!\A\s+!!;
 
78
            s!\s+\z!!;
 
79
            my $val;
 
80
            my $code= "\$val= $_; 1";
 
81
            eval $code or die "Failed to eval $code (from $orig): $@";
 
82
            $define{$def}= $val;
 
83
            $define_is_str{$def}= 1 if /[""]/;
61
84
        }
62
85
    }
63
86
    close $fh;
64
 
    fill_ranges($_) for @fill;
 
87
    fill_range($_) for @fill;
65
88
    foreach my $pfx (keys %name_to_value_expanded) {
66
89
        $max_name_length= length($pfx) if $max_name_length < length($pfx);
67
90
    }
 
91
    #print Data::Dumper->new([\%define, \%define_is_str])->Useqq(1)->Sortkeys(1)->Dump();
68
92
}
69
93
 
70
94
sub open_swap {
81
105
sub replace_block {
82
106
    my ($file,$blob)= @_;
83
107
    my ($in,$out)= open_swap($file);
84
 
    while (<$in>) {
85
 
        print $out $_;
86
 
        last if /^=for autoupdater start/ || /^# start autoupdated section/;
87
 
    }
88
 
    $blob=~s/\s+$//mg;
89
 
    print $out "\n$blob\n\n";
90
 
    while (<$in>) {
91
 
        if (/^=for autoupdater stop/ || /^# stop autoupdated section/) {
92
 
            print $out $_;
93
 
            last;
94
 
        }
95
 
    }
96
 
    while (<$in>) {
97
 
        print $out $_;
 
108
    my $gotit;
 
109
    READ: {
 
110
 
 
111
        while (<$in>) {
 
112
            print $out $_;
 
113
            last if $gotit= (/^=for autoupdater start/ || /^# start autoupdated section/);
 
114
        }
 
115
 
 
116
        unless ($gotit) {
 
117
            warn "didnt find autoupdater start!\n";
 
118
            last READ;
 
119
        }
 
120
 
 
121
        $blob =~ s/[ \t]+$//mg;
 
122
        $blob =~ s/\s+\z//;
 
123
 
 
124
        print $out "\n$blob\n\n";
 
125
 
 
126
        while (<$in>) {
 
127
            if (/^=for autoupdater stop/ || /^# stop autoupdated section/) {
 
128
                print $out $_;
 
129
                $gotit= 0;
 
130
                last;
 
131
            }
 
132
        }
 
133
 
 
134
        if ($gotit) {
 
135
            warn "didnt find autoupdater start!\n";
 
136
            last READ;
 
137
        }
 
138
 
 
139
        while (<$in>) {
 
140
            print $out $_;
 
141
        }
98
142
    }
99
143
    close $out;
100
144
    close $in;
 
145
    return;
101
146
}
102
 
sub update_buildtools {
103
 
    my $dump= Data::Dumper->new([\@meta],['*TAG_INFO_ARRAY'])->Indent(1)->Dump();
 
147
 
 
148
sub update_constants {
 
149
    my $dump= Data::Dumper->new([\@meta],['*TAG_INFO_ARRAY'])->Sortkeys(1)->Useqq(1)->Indent(1)->Dump();
104
150
    $dump =~ s/^(\s*)\{/$1# autoupdated by $0 do not modify directly!\n$1\{/mg;
105
 
    return replace_block(
106
 
        "Perl/shared/inc/Sereal/BuildTools.pm",
107
 
        join "\n",
108
 
            "our (%TAG_INFO_HASH, \@TAG_INFO_ARRAY);",
109
 
            $dump,
110
 
            "\$TAG_INFO_HASH{chr \$_}= \$TAG_INFO_ARRAY[\$_] for 0 .. 127;",
111
 
            "push \@EXPORT_OK, qw(%TAG_INFO_HASH \@TAG_INFO_ARRAY);",
112
 
    )
 
151
    my $defines= Data::Dumper->new([\%define],['*DEFINE'])->Sortkeys(1)->Useqq(1)->Indent(1)->Dump;
 
152
    $defines=~s/^/    /mg;
 
153
 
 
154
    foreach my $mod_suffix (qw(Encoder Decoder)) {
 
155
        replace_block(
 
156
            "Perl/$mod_suffix/lib/Sereal/$mod_suffix/Constants.pm",
 
157
            join "\n",
 
158
                "BEGIN {",
 
159
                $defines,
 
160
                "}",
 
161
                "",
 
162
                "use constant \\%DEFINE;",
 
163
                "push \@EXPORT_OK, keys %DEFINE;",
 
164
                $dump,
 
165
                "\$TAG_INFO_HASH{chr \$_}= \$TAG_INFO_ARRAY[\$_] for 0 .. 127;",
 
166
                "push \@EXPORT_OK, qw(%TAG_INFO_HASH \@TAG_INFO_ARRAY);",
 
167
        )
 
168
    }
113
169
}
114
 
sub update_srl_decoder_h {
115
 
    replace_block("Perl/Decoder/srl_decoder.h",
 
170
 
 
171
sub update_srl_taginfo_h {
 
172
    replace_block("Perl/shared/srl_taginfo.h",
116
173
        join("\n",
117
174
            "* NOTE this section is autoupdated by $0",
118
175
            "*/",
 
176
            "",
119
177
            "static const char * const tag_name[] = {",
120
178
            ( map {
121
179
                my $str= Data::Dumper::qquote(chr($_));
124
182
                    $max_name_length+3, qq("$value_to_name_expanded{$_}") . ($_==127 ? " " : ","), $str, $_, $_, $_
125
183
            } 0 .. 127 ),
126
184
            "};",
 
185
            "",
 
186
            (
 
187
                map {
 
188
                    sprintf "#define SRL_HDR_%-*s %3d",
 
189
                        $max_name_length+3, $_->{name}, $_->{value}
 
190
                } grep { $_->{masked} } @meta
 
191
            ),
 
192
            "",
 
193
            ( map {
 
194
                my $n = $_;
 
195
                my $v = $range{$n};
 
196
                my $c =
 
197
                        join "    \\\n   ",
 
198
                        "#define CASE_SRL_HDR_$n",
 
199
                        join ":    \\\n   ",
 
200
                        map { "case SRL_HDR_$_->{name}" } @$v;
 
201
 
 
202
                $c."\n\n";
 
203
            } sort keys %range ),
 
204
            "",
127
205
            "/*",
128
206
            "* NOTE the above section is auto-updated by $0",
129
207
        )
130
 
    )
 
208
    );
131
209
}
132
210
 
 
211
 
133
212
sub update_JavaSerealHeader {
134
213
    my $declarations = "* NOTE this section is autoupdated by $0 */\n";
135
214
 
136
 
    for my $name (sort { $name_to_value{$a} <=> $name_to_value{$b} } keys %name_to_value) {
 
215
    for my $name (sort { $name_to_value{$a} <=> $name_to_value{$b} || $a cmp $b } keys %name_to_value) {
137
216
        my $byte = $name_to_value{$name};
138
217
        my $decl = sprintf("static final byte SRL_HDR_%-*s = (byte) %3d;", $max_name_length, $name, $byte);
139
218
        $declarations .= sprintf("\t%s /* %3d 0x%02x 0b%08b %s */\n",
172
251
chdir "$git_dir/.."
173
252
    or die "Failed to chdir to root of repo '$git_dir/..': $!";
174
253
read_protocol();
175
 
update_buildtools();
176
 
update_srl_decoder_h();
 
254
update_constants();
 
255
update_srl_taginfo_h();
177
256
update_table("sereal_spec.pod");
178
257
update_table("Perl/shared/srl_protocol.h");
179
258
update_JavaSerealHeader();