File Coverage

blib/lib/QML/File.pm

Criterion	Covered	Total	%
statement	90	95	94.7
branch	31	36	86.1
condition	3	3	100.0
subroutine	12	12	100.0
pod	7	7	100.0
total	143	153	93.4

package QML::File;
use strict;
use warnings;
use IO::File;
use base qw(Class::Accessor);

our $VERSION = 0.01;

QML::File->mk_ro_accessors(qw(name objectType id));

sub new {
    my ( $class, $file ) = @_;
    my $fileHandle = IO::File->new( $file, "r" );
    my ($name) = $file =~ /([^\.\\\/]+)\.qml$/;

    my $self = bless {
        fileHandle           => $fileHandle,
        name                 => $name,
        imports              => [],
        objectType           => '',
        id                   => {},
        propertyDeclarations => [],
        signalDeclarations   => [],
        javaScriptFunctions  => [],
        objectProperties     => [],
        childObjects         => []
    }, $class;

    $self->_parse;

    return $self;
}

sub _parse {
    my ($self) = @_;

    my $isInComment;
    my $isInFunction;
    my $isInChildObject;
    my $braceLevel = 0;
    my $lineNum    = 0;

    if ( !$self->{fileHandle} ) {
        print "ERROR: Could not open $self->{name}\n";
        return;
    }

    my @lines = $self->{fileHandle}->getlines;
    foreach my $line (@lines) {
        $lineNum++;

        # Trim leading and trailing whitespace
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;

        # Comment
        next if ( $line =~ /^\/\// );

        # Long Comment
        $isInComment = 1 if ( $line =~ /\/\*/ );
        if ($isInComment) {
            $isInComment = 0 if ( $line =~ /\*\// );
            next;
        }

        # FileSystemImport
        my ($filename) = $line =~ /import\s+"([^"]+)"/;
        if ( defined $filename ) {
            push @{ $self->{imports} },
              { filename => $filename, line => $line, lineNum => $lineNum };
        }

        # LibraryImport
        my ($importId) = $line =~ /import\s+([\w\d_\.]+)/;
        if ( defined $importId ) {
            push @{ $self->{imports} },
              { name => $importId, line => $line, lineNum => $lineNum };
        }

        # ObjectDeclaration
        if ( !$self->{objectType} ) {
            my ($type) = $line =~ /^([\w\d_\.]+)/;
            if ( defined $type && $type ne 'import' ) {
                $self->{objectType} =
                  { name => $type, line => $line, lineNum => $lineNum };
            }
        }

        if ( $braceLevel == 1 ) {

            # PropertyDeclaration
            my ( $propertyType, $identifier ) =
              $line =~ /^property\s+([\w\d_]+)\s+([\w\d_]+)/;
            if ( defined $propertyType ) {
                push @{ $self->{propertyDeclarations} },
                  {
                    type    => $propertyType,
                    name    => $identifier,
                    line    => $line,
                    lineNum => $lineNum
                  };
            }

            # SignalDeclaration
            my ($signalName) = $line =~ /^signal\s+([\w\d_]+)/;
            if ( defined $signalName ) {
                push @{ $self->{signalDeclarations} },
                  { name => $signalName, line => $line, lineNum => $lineNum };
            }

            # JavaScriptFunctions
            my ($functionName) = $line =~ /^function\s+([\w\d_]+)/;
            if ( defined $functionName ) {
                push @{ $self->{javaScriptFunctions} },
                  { name => $functionName, line => $line, lineNum => $lineNum };
                $isInFunction = 1;
            }

            # ObjectProperties
            my ($propertyName) = $line =~ /^([\w\d_\.]+)\s*:/;
            if ( defined $propertyName ) {
                push @{ $self->{objectProperties} },
                  { name => $propertyName, line => $line, lineNum => $lineNum };

                # ID
                if ( !defined $self->{id}->{name} ) {
                    my ($id) = $line =~ /^id\s*:\s*([\w\d_\.]+)/;
                    if ( defined $id ) {
                        $self->{id} =
                          { name => $id, line => $line, lineNum => $lineNum };
                    }
                }
            }

            # Child objects
            my ($childType) = $line =~ /^([\w\d_\.]+)\s*\{/;
            if ( defined $childType ) {
                next if $childType =~ /^anchors|font$/;
                push @{ $self->{childObjects} },
                  { type => $childType, line => $line, lineNum => $lineNum };
            }
        }

        # Curly braces
        $braceLevel += ( $line =~ tr/\{// );
        $braceLevel -= ( $line =~ tr/\}// );
    }
}

sub imports {
    my ($self) = @_;
    return @{ $self->{imports} };
}

sub propertyDeclarations {
    my ($self) = @_;
    return @{ $self->{propertyDeclarations} };
}

sub signalDeclarations {
    my ($self) = @_;
    return @{ $self->{signalDeclarations} };
}

sub javaScriptFunctions {
    my ($self) = @_;
    return @{ $self->{javaScriptFunctions} };
}

sub objectProperties {
    my ($self) = @_;
    return @{ $self->{objectProperties} };
}

sub childObjects {
    my ($self) = @_;
    return @{ $self->{childObjects} };
}

1;
__END__