package AspectC::Repo; use strict; use warnings; use 5.020; use List::Util qw(first); use XML::LibXML; our $VERSION = '0.00'; my @source_loc_kind = (qw(none definition declaration)); my @function_kind = ( qw(unknown non_member static_non_member member static_member virtual_member pure_virtual_member conctructor destructor virtual_destructor pure_virtual_destructor) ); my @pointcut_kind = (qw(normal virtual pure_virtual)); my @variable_kind = (qw(unknown non_member static_non_member member static_member)); my @advice_code_kind = (qw(before after around)); my @advice_code_context = (qw(none type obj type_obj vars type_vars obj_vars type_obj_vars)); my @cv_qualifiers = (qw(none const volatile const_volatile)); sub new { my ( $class, %opt ) = @_; my $self = \%opt; $self->{xml} = XML::LibXML->load_xml( location => '../kratos/src/repo.acp' ); bless( $self, $class ); $self->parse_xml; return $self; } sub parse_xml { my ($self) = @_; my $xml = $self->{xml}; for my $node ( $xml->findnodes('/ac-model/files/TUnit | /ac-model/files/Header') ) { my $filename = $node->getAttribute('filename'); my $id = $node->getAttribute('id'); if ( defined $id ) { $self->{files}[$id] = $filename; } else { say STDERR "repo.acp: File ${filename} has no ID"; } } for my $node ( $xml->findnodes('/ac-model/root/Namespace[@name="::"]/children/Class') ) { my $class = {}; my $class_name = $node->getAttribute('name'); my $id = $node->getAttribute('id'); my @bases; my @functions; my @sources; if ( my $base_str = $node->getAttribute('bases') ) { @bases = split( qr{ }, $base_str ); } for my $source ( $node->findnodes('./source/Source') ) { push( @sources, { file => $self->{files}[ $source->getAttribute('file') ], kind => $source_loc_kind[ $source->getAttribute('kind') ], } ); } $class->{name} = $class_name; $class->{id} = $id; $class->{sources} = [@sources]; for my $fnode ( $node->findnodes('./children/Function') ) { my $name = $fnode->getAttribute('name'); my $id = $fnode->getAttribute('id') // q{?}; my $kind = $fnode->getAttribute('kind'); my $result_type = q{?}; my @args; if ( my $typenode = ( $fnode->findnodes('./result_type/Type') )[0] ) { $result_type = $typenode->getAttribute('signature'); } #print "$id $name $kind $result_type <- "; for my $argnode ( $fnode->findnodes('./arg_types/Type') ) { push( @args, $argnode->getAttribute('signature') ); } #say join( q{, }, @args ); } $self->{class}{$class_name} = $class; } for my $node ( $xml->findnodes( '/ac-model/root/Namespace[@name="::"]/children/Variable') ) { my $sig_node = ( $node->findnodes('./type/Type') )[0]; my $kind = $node->getAttribute('kind'); my $name = $node->getAttribute('name'); my $signature = $sig_node->getAttribute('signature'); if ( $variable_kind[$kind] eq 'non_member' ) { $self->{class_instance}{$signature} = $name; } } return $self; } sub get_class_path_prefix { my ( $self, $class_name ) = @_; my $header = first { $_->{kind} eq 'definition' } @{ $self->{class}{$class_name}{sources} }; $header = $header->{file}; $header =~ s{ \. h $ }{}x; return $header; } sub get_class_instance { my ( $self, $class_name ) = @_; return $self->{class_instance}{$class_name}; } 1;