view src/parallel_execution/lib/Gears/Util.pm @ 556:a0b7eb5e58c0

add Gears::Util module
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Mon, 18 Nov 2019 21:00:11 +0900
parents
children 1eb2a22ec1e3
line wrap: on
line source

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

sub parse {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);
  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) = @_;
  my $ir  = {};

  _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[//|}]);

    if ($line =~ /__code (\w+)\(.*/) {
      push(@{$ir->{codes}},$1);
      next;
    }

    $line =~ s/\s*([\w\s\*]+);\s*/$1/;
    push(@{$ir->{deta}},$1);
  }

  return $ir;
}

sub _file_checking {
  my $file_name = shift;
  unless (-f $file_name) {
    croak "invalid filepath :$file_name\n";
  }
}

1;