view src/gearsTools/update_context.pl @ 137:7f9dac064c5f

remove dead code at perl scripts
author anatofuz
date Thu, 12 Dec 2019 14:01:06 +0900
parents fb75c5e661c2
children
line wrap: on
line source

#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Std;

use FindBin;
use lib "$FindBin::Bin/lib";
use Gears::Util;

my %opt;
getopts("wc" => \%opt);

my $interface_file = shift or die "require itnerface file";
my $h2context = Gears::Util->parse_interface($interface_file);
my $context = Gears::Util->h2context_str($h2context);

if ($opt{c}) {
  print "$context";
  exit 0;
}

my ($first,$last) = slup_context_h($h2context->{name});

if ($opt{w}) {
  context_write(@{$first},$context,@{$last});
} else {
  context_dump(@{$first},$context,@{$last});
}


sub slup_context_h {
  open my $fh, '<', 'context.h';
  
  my $data_gear_name = shift;

  my @first_context_headers = ();
  my @last_context_headers = ();
  
  while (my $line = <$fh>) {
    if ( $line =~ /union Data end/) {
      push(@last_context_headers, $line);
      push(@last_context_headers, <$fh>);
      last;
    }
    if ( $line =~ /struct $data_gear_name/) {
      print "WARN! $data_gear_name struct already exists\n";
      exit 1;
    }
    push(@first_context_headers, $line);
  }

  close $fh;
  
  #print "@first_context_headers\n";
  #print "@last_context_headers\n";
  return (\@first_context_headers,\@last_context_headers);
}

sub context_dump {
  for my $line (@_) {
    print "$line";
  }
}

sub context_write {
  open my $fh, '>', "context.h";
  for my $line (@_) {
    print $fh "$line";
  }
  close $fh;
}