comparison src/gearsTools/update_context.pl @ 97:70eae4b230f2

add update_context.pl
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Thu, 14 Nov 2019 10:14:15 +0900
parents
children d0aea70fe1b0
comparison
equal deleted inserted replaced
96:d5c4016c65b8 97:70eae4b230f2
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Getopt::Std;
5
6 my $interface_file = shift or die "require itnerface file";
7 my $h2context = parse_interface($interface_file);
8 my $context = dump_h2context($h2context);
9 my ($first,$last) = slup_context_h($h2context->{name});
10
11 my %opt;
12 getopts("w" => \%opt);
13
14 if ($opt{w}) {
15 context_write(@{$first},$context,@{$last});
16 } else {
17 context_dump(@{$first},$context,@{$last});
18 }
19
20
21 sub slup_context_h {
22 open my $fh, '<', 'context.h';
23
24 my $data_gear_name = shift;
25
26 my @first_context_headers = ();
27 my @last_context_headers = ();
28
29 while (my $line = <$fh>) {
30 if ( $line =~ /this is necessary for context generator/) {
31 push(@last_context_headers, $line);
32 push(@last_context_headers, <$fh>);
33 last;
34 }
35 if ( $line =~ /struct $data_gear_name/) {
36 print "WARN! $data_gear_name struct already exists\n";
37 exit 1;
38 }
39 push(@first_context_headers, $line);
40 }
41
42 close $fh;
43
44 print "@first_context_headers\n";
45 print "@last_context_headers\n";
46 return (\@first_context_headers,\@last_context_headers);
47 }
48
49 sub parse_interface {
50 my $file_name = shift;
51
52 open my $fh, '<', $file_name;
53
54 my $h2context = {};
55
56 while (my $line = <$fh>) {
57 if ($line =~ /typedef struct (\w+)\s?<.*/) {
58 die "invalied struct name $1" unless $1;
59 $h2context->{name} = $1;
60 next;
61 }
62
63 if ($line =~ m[/\*|//|}]) {
64 next;
65 }
66
67 if ($line =~ /__code (\w+)\(.*/) {
68 push(@{$h2context->{codes}},$1);
69 next;
70 }
71
72 $line =~ s/\s*([\w\s\*]+);\s*/$1/;
73 push(@{$h2context->{data}},$1);
74 }
75
76 close $fh;
77 return $h2context;
78 }
79
80
81 sub dump_h2context {
82 my $h2context = shift;
83 my $context = '';
84 my $space = ' ';
85 #print "${space}struct $h2context->{name} {\n";
86 $context = "${space}struct $h2context->{name} {\n";
87 for my $datum (@{$h2context->{data}}) {
88 #print "${space}${space}$datum; \n";
89 $context .= "${space}${space}$datum; \n";
90 }
91 for my $code (@{$h2context->{codes}}) {
92 #print "${space}${space}enum Code $code;\n";
93 $context .= "${space}${space}enum Code $code;\n";
94 }
95 #print "${space}} $h2context->{name};\n";
96 $context .= "${space}} $h2context->{name};\n";
97 return $context;
98 }
99
100 sub context_dump {
101 for my $line (@_) {
102 print "$line";
103 }
104 }
105
106 sub context_write {
107 open my $fh, '>', "context.h";
108 for my $line (@_) {
109 print $fh "$line";
110 }
111 close $fh;
112 }