view src/gearsTools/lib/Gears/Util.pm @ 110:8c7c1ea49f21

impl auto gen context tools
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Wed, 27 Nov 2019 21:21:42 +0900
parents b84aac4ab529
children b9df8ea87b42
line wrap: on
line source

package Gears::Util;
use strict;
use warnings;
use Carp qw/croak/;
use File::Find;

sub parse {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);
  return $ir;
}

sub parse_code_verbose {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name,1);
  return $ir;
}

sub parse_interface {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);
  
  unless ($ir->{name}) {
    croak 'invalid struct name';
  }
  return $ir;
}


sub parse_impl {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);

  unless ($ir->{isa} && $ir->{name}) {
    croak 'invalid struct name';
  }
  return $ir;
}

sub _parse_base {
  my ($file,$code_verbose) = @_;
  my $ir  = {};

  Gears::Util->file_checking($file);
  open my $fh, '<', $file;
  my $line = <$fh>;

  if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) {
    die "invalied struct name $1" unless $1;
    $ir->{name} = $1;

    if ($2 =~ m|\s*impl\s*([\w+]+)\s*{|) {
      $ir->{isa} = $1;
    }
  }

  while ($line = <$fh>) {
    if ($line =~ m|\s*/\*|) {
      while ( $line !~ m|\*/|) {
        $line = <$fh>;
        next;
      }
      next;
    }
    next if ($line =~ /^\s+$/);
    next if ($line =~ m[^//]);
    next if ($line =~ m[^\}\s*$ir->{name};]);

    if ($line =~ m|__code (\w+)\(([()\.\*\s\w,_]+)\)|) {
      $line = "enum Code $1;\n";
    }

    push(@{$ir->{content}},$line);
  }

  return $ir;
}

sub file_checking {
  my ($class, $file_name) = @_;
  unless (-f $file_name) {
    croak "invalid filepath :$file_name\n";
  }
}

sub slup {
  my ($class,$file) = @_;
  open my $fh, '<', $file;
  local $/;
  my $f = <$fh>;
  return $f;
}

sub find_header {
  my $class = shift;
  my $header_name = shift;

  my $find_path = shift // ".";
  my $header_file = '';

  find(
    {
      wanted => sub {
        if ($_ =~ /\/$header_name\.h/) {
          $header_file = $_;
        }
      },
      no_chdir => 1,
    },
    $find_path);
  return $header_file;
}

sub find_headers_path {
  my $class = shift;
  my $find_path = shift // ".";

  my @files;
  find( { wanted => sub { push @files, $_ if /\.h/ }, no_chdir => 1 }, $find_path);

  return \@files;
}

sub h2context_str {
  my ($class, $h2context) = @_;
  my $context = '';
  my $space = '    ';

  $context =  "${space}struct $h2context->{name} {\n";
  my $content_space;
  if (exists $h2context->{content}){
    my @chars = split //, $h2context->{content}->[0];
    for my $w (@chars) {
      last if ($w !~ /\s/);
      $content_space .= $w;
    }
  }

  unless (defined $content_space) {
    $content_space = "";
  }

  for my $c (@{$h2context->{content}}) {
    $c =~ s/$content_space//;
    $context .= "${space}${space}$c";
  }
  $context .= "${space}} $h2context->{name};\n";
  return $context;
}

1;