changeset 298:07c731e47330

add update_header.pl (uncomplete...)
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 04 Feb 2020 16:51:27 +0900
parents 124c51584208
children 93c8a5805370
files src/gearsTools/update_header.pl
diffstat 1 files changed, 76 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gearsTools/update_header.pl	Tue Feb 04 16:51:27 2020 +0900
@@ -0,0 +1,76 @@
+#!/usr/bibn/env perl
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use DDP {deparse => 1};
+
+my $header_file = shift // croak 'require header file!';
+my ($header_con,$interface_name) = search_slurp_header_file($header_file);
+
+my %cbc_code_names = ( order => 0, codes => {});
+
+while (@ARGV) {
+  face_or_impl = find_codes_from_cbc(shift @ARGV, $interface_name, \%cbc_code_names);
+}
+
+map  { push(@{$cbc_code_names{order_list}}, [$_,$cbc_code_names{codes}->{$_}->{order}])}  
+        sort { $cbc_code_names{codes}->{$a}->{order} <=> $cbc_code_names{codes}->{$b}->{order} } keys %{$cbc_code_names{codes}};
+
+p $header_con;
+p %cbc_code_names;
+
+sub search_slurp_header_file {
+  my $header_file = shift;
+  
+  my %contents;
+  my %order;
+  my $i = 0;
+  my $interface_name;
+
+  open my $fh, '<', $header_file;
+
+  if (<$fh> =~ /struct (\w+)\s*</) {
+    $interface_name = $1;
+  }
+  while (my $line = <$fh>) {
+    chomp $line;
+    if ($line =~ /\A\s*__code (\w+)\(/) {
+      $contents{$1} = $line;
+      $order{$1} = $i;
+      $i++;
+    }
+  }
+  close $fh;
+  my @order_code_names;
+  map  { push(@order_code_names, [$_,$order{$_}])}  sort { $order{$a} <=> $order{$b} } keys %order;
+  return { codes => \%contents, order => \@order_code_names }, $interface_name;
+}
+
+sub find_codes_from_cbc {
+  my ($cbc_file, $inter_name, $ccn) = @_;
+
+  #my $inter_name = $header_type->{interface} // undef;
+  #my $impl_name  = $header_type->{impl} // undef;
+
+
+  open my $fh, '<', $cbc_file;
+  while (my $line = <$fh>) {
+    chomp $line;
+    if ($line =~ /\A\s*__code (\w+)\(/) {
+      my $cg_name = $1;
+      $line =~ s/\s+{\s*/;/;
+      $line =~ s/struct $inter_name/Type/g;
+      $ccn->{codes}->{$cg_name} = { line =>$line, file => $cbc_file, order => $ccn->{order} };
+      $ccn->{order}++;
+    }
+  }
+  close $fh;
+}
+
+sub create_new_header_codes {
+  my ($header_con, $cbc_con) = @_;
+  while (@{$header_con->{order}}) {
+     my ($header_cg_name, $hader_cg_order) = @{$header_con->{order}->[0]};
+  }
+}