summaryrefslogtreecommitdiff
path: root/lib/AspectC
diff options
context:
space:
mode:
Diffstat (limited to 'lib/AspectC')
-rw-r--r--lib/AspectC/Repo.pm140
-rw-r--r--lib/AspectC/Repo/Function.pm55
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.