diff options
Diffstat (limited to 'lib/AspectC')
-rw-r--r-- | lib/AspectC/Repo.pm | 140 | ||||
-rw-r--r-- | lib/AspectC/Repo/Function.pm | 55 |
2 files changed, 195 insertions, 0 deletions
diff --git a/lib/AspectC/Repo.pm b/lib/AspectC/Repo.pm new file mode 100644 index 0000000..6f59117 --- /dev/null +++ b/lib/AspectC/Repo.pm @@ -0,0 +1,140 @@ +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; diff --git a/lib/AspectC/Repo/Function.pm b/lib/AspectC/Repo/Function.pm new file mode 100644 index 0000000..a7edae2 --- /dev/null +++ b/lib/AspectC/Repo/Function.pm @@ -0,0 +1,55 @@ +package AspectC::Repo::Function; + +use strict; +use warnings; +use 5.020; + +our $VERSION = '0.00'; + +sub new { + my ( $class, %opts ) = @_; + + my $self = {}; + + return bless( $self, $class ); +} + +1; + +__END__ + +=head1 NAME + +=head1 SYNOPSIS + +=head1 VERSION + +version + +=head1 DESCRIPTION + +=head1 METHODS + +=over + +=back + +=head1 DIAGNOSTICS + +=head1 DEPENDENCIES + +=over + +=back + +=head1 BUGS AND LIMITATIONS + +=head1 SEE ALSO + +=head1 AUTHOR + +Copyright (C) 2016 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + + 0. You just DO WHAT THE FUCK YOU WANT TO. |