view src/parallel_execution/lib/Gears/Util.pm @ 557:1eb2a22ec1e3

tweak
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Mon, 18 Nov 2019 21:22:34 +0900
parents a0b7eb5e58c0
children 8a825fc15817
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_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";
  }
}

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

sub find_interface {
  my ($class, $interface) = @_;
  my $result = '';
  find(
    {
      wanted => sub {
        if ($_ =~ /\/$interface\.h/) {
          $result = $_;
        }
      },
      no_chdir => 1,
    },
    ".");
  return $result;
}

1;