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


line stmt bran cond sub pod time code
1             package QML::File;
2 1     1   24729 use strict;
  1         2  
  1         41  
3 1     1   5 use warnings;
  1         2  
  1         26  
4 1     1   922 use IO::File;
  1         12222  
  1         185  
5 1     1   9 use base qw(Class::Accessor);
  1         2  
  1         1022  
6              
7             our $VERSION = 0.01;
8              
9             QML::File->mk_ro_accessors(qw(name objectType id));
10              
11             sub new {
12 1     1 1 883 my ( $class, $file ) = @_;
13 1         9 my $fileHandle = IO::File->new( $file, "r" );
14 1         147 my ($name) = $file =~ /([^\.\\\/]+)\.qml$/;
15              
16 1         12 my $self = bless {
17             fileHandle => $fileHandle,
18             name => $name,
19             imports => [],
20             objectType => '',
21             id => {},
22             propertyDeclarations => [],
23             signalDeclarations => [],
24             javaScriptFunctions => [],
25             objectProperties => [],
26             childObjects => []
27             }, $class;
28              
29 1         4 $self->_parse;
30              
31 1         3 return $self;
32             }
33              
34             sub _parse {
35 1     1   2 my ($self) = @_;
36              
37 1         1 my $isInComment;
38             my $isInFunction;
39 0         0 my $isInChildObject;
40 1         2 my $braceLevel = 0;
41 1         2 my $lineNum = 0;
42              
43 1 50       8 if ( !$self->{fileHandle} ) {
44 0         0 print "ERROR: Could not open $self->{name}\n";
45 0         0 return;
46             }
47              
48 1         30 my @lines = $self->{fileHandle}->getlines;
49 1         88 foreach my $line (@lines) {
50 38         39 $lineNum++;
51              
52             # Trim leading and trailing whitespace
53 38         67 $line =~ s/^\s+//;
54 38         68 $line =~ s/\s+$//;
55              
56             # Comment
57 38 50       62 next if ( $line =~ /^\/\// );
58              
59             # Long Comment
60 38 100       62 $isInComment = 1 if ( $line =~ /\/\*/ );
61 38 100       53 if ($isInComment) {
62 4 100       8 $isInComment = 0 if ( $line =~ /\*\// );
63 4         5 next;
64             }
65              
66             # FileSystemImport
67 34         39 my ($filename) = $line =~ /import\s+"([^"]+)"/;
68 34 50       47 if ( defined $filename ) {
69 0         0 push @{ $self->{imports} },
  0         0  
70             { filename => $filename, line => $line, lineNum => $lineNum };
71             }
72              
73             # LibraryImport
74 34         35 my ($importId) = $line =~ /import\s+([\w\d_\.]+)/;
75 34 100       49 if ( defined $importId ) {
76 2         3 push @{ $self->{imports} },
  2         8  
77             { name => $importId, line => $line, lineNum => $lineNum };
78             }
79              
80             # ObjectDeclaration
81 34 100       61 if ( !$self->{objectType} ) {
82 4         8 my ($type) = $line =~ /^([\w\d_\.]+)/;
83 4 100 100     17 if ( defined $type && $type ne 'import' ) {
84 1         13 $self->{objectType} =
85             { name => $type, line => $line, lineNum => $lineNum };
86             }
87             }
88              
89 34 100       53 if ( $braceLevel == 1 ) {
90              
91             # PropertyDeclaration
92 20         25 my ( $propertyType, $identifier ) =
93             $line =~ /^property\s+([\w\d_]+)\s+([\w\d_]+)/;
94 20 100       25 if ( defined $propertyType ) {
95 1         1 push @{ $self->{propertyDeclarations} },
  1         4  
96             {
97             type => $propertyType,
98             name => $identifier,
99             line => $line,
100             lineNum => $lineNum
101             };
102             }
103              
104             # SignalDeclaration
105 20         24 my ($signalName) = $line =~ /^signal\s+([\w\d_]+)/;
106 20 100       31 if ( defined $signalName ) {
107 1         2 push @{ $self->{signalDeclarations} },
  1         25  
108             { name => $signalName, line => $line, lineNum => $lineNum };
109             }
110              
111             # JavaScriptFunctions
112 20         23 my ($functionName) = $line =~ /^function\s+([\w\d_]+)/;
113 20 100       33 if ( defined $functionName ) {
114 2         3 push @{ $self->{javaScriptFunctions} },
  2         7  
115             { name => $functionName, line => $line, lineNum => $lineNum };
116 2         2 $isInFunction = 1;
117             }
118              
119             # ObjectProperties
120 20         40 my ($propertyName) = $line =~ /^([\w\d_\.]+)\s*:/;
121 20 100       34 if ( defined $propertyName ) {
122 8         6 push @{ $self->{objectProperties} },
  8         32  
123             { name => $propertyName, line => $line, lineNum => $lineNum };
124              
125             # ID
126 8 100       21 if ( !defined $self->{id}->{name} ) {
127 1         4 my ($id) = $line =~ /^id\s*:\s*([\w\d_\.]+)/;
128 1 50       3 if ( defined $id ) {
129 1         4 $self->{id} =
130             { name => $id, line => $line, lineNum => $lineNum };
131             }
132             }
133             }
134              
135             # Child objects
136 20         29 my ($childType) = $line =~ /^([\w\d_\.]+)\s*\{/;
137 20 100       40 if ( defined $childType ) {
138 1 50       5 next if $childType =~ /^anchors|font$/;
139 1         1 push @{ $self->{childObjects} },
  1         12  
140             { type => $childType, line => $line, lineNum => $lineNum };
141             }
142             }
143              
144             # Curly braces
145 34         45 $braceLevel += ( $line =~ tr/\{// );
146 34         44 $braceLevel -= ( $line =~ tr/\}// );
147             }
148             }
149              
150             sub imports {
151 1     1 1 5 my ($self) = @_;
152 1         1 return @{ $self->{imports} };
  1         4  
153             }
154              
155             sub propertyDeclarations {
156 1     1 1 1807 my ($self) = @_;
157 1         2 return @{ $self->{propertyDeclarations} };
  1         4  
158             }
159              
160             sub signalDeclarations {
161 1     1 1 378 my ($self) = @_;
162 1         2 return @{ $self->{signalDeclarations} };
  1         4  
163             }
164              
165             sub javaScriptFunctions {
166 1     1 1 549 my ($self) = @_;
167 1         1 return @{ $self->{javaScriptFunctions} };
  1         5  
168             }
169              
170             sub objectProperties {
171 1     1 1 392 my ($self) = @_;
172 1         2 return @{ $self->{objectProperties} };
  1         7  
173             }
174              
175             sub childObjects {
176 1     1 1 485 my ($self) = @_;
177 1         2 return @{ $self->{childObjects} };
  1         4  
178             }
179              
180             1;
181             __END__