140 |
my $lines = join '', $self->file->getlines; |
my $lines = join '', $self->file->getlines; |
141 |
# deal with comments FIRST |
# deal with comments FIRST |
142 |
# single-line comments (starting with '#') |
# single-line comments (starting with '#') |
143 |
$lines =~ s/(?<!\\)\#.*$//gm; |
#$lines =~ s/(?<!\\)\#(.*)$//gm; |
144 |
# multi-line comments (c-style, /* comment */) |
# multi-line comments (c-style, /* comment */) |
145 |
$lines =~ s/(?<!\\)\/\*.*?(?<!\\)\*\///gs; |
$lines =~ s/(?<!\\)\/\*.*?(?<!\\)\*\///gs; |
146 |
|
my $comm = ''; |
147 |
|
my $prev_is_comm = 0; |
148 |
|
|
149 |
foreach (split( /\n/, $lines )) |
foreach (split( /\n/, $lines )) |
150 |
{ |
{ |
151 |
if (/^\s*\:(\w+)\:\s*(\S+.*)\s*$/) # style def |
if (/^#(.*)$/) # comment |
152 |
{ |
{ |
153 |
$self->style($1 => $2); |
$comm .= "$1\n"; |
154 |
} |
$prev_is_comm = 1; |
155 |
elsif (/^\s*(\w+)(?:\((\w+)\))?\:\s*$/) # table |
} |
156 |
{ |
elsif ($prev_is_comm and /^(\s*)$/) |
157 |
my $name = $1; |
{ |
158 |
$table = Zot::Table->new($name); |
$comm .= "$1\n"; |
159 |
$self->table($name => $table); |
} |
160 |
|
else |
161 |
|
{ |
162 |
|
if (/^\s*\:(\w+)\:\s*(\S+.*)\s*$/) # style def |
163 |
|
{ |
164 |
|
$self->style($1 => $2); |
165 |
|
} |
166 |
|
elsif (/^\s*(\w+)(?:\((\w+)\))?\:\s*$/) # table |
167 |
|
{ |
168 |
|
my $name = $1; |
169 |
|
$table = Zot::Table->new($name); |
170 |
|
$self->table($name => $table); |
171 |
|
$table->comment('__main__' => $comm); |
172 |
|
$comm = ''; |
173 |
|
$table->parent($2) |
174 |
|
if defined $2; |
175 |
|
} |
176 |
|
elsif (/^\s*\:(\w+)\:\s*$/) # style usage |
177 |
|
{ |
178 |
|
$table->add_style($1); |
179 |
|
} |
180 |
|
elsif (/^\s*(\w+[\*\+]{0,2})\s*(?:(..)\s*(\w+)|\((.*)\))?\s*$/) # anything else |
181 |
|
{ |
182 |
|
my ($field, $rel_type, $to_table, $datatype) = ($1, $2, $3, $4); |
183 |
|
|
184 |
$table->parent($2) |
$table->comment($field => $comm); |
185 |
if defined $2; |
$comm = ''; |
|
} |
|
|
elsif (/^\s*\:(\w+)\:\s*$/) # style usage |
|
|
{ |
|
|
$table->add_style($1); |
|
|
} |
|
|
elsif (/^\s*(\w+[\*\+]{0,2})\s*(?:(..)\s*(\w+)|\((.*)\))?\s*$/) # anything else |
|
|
{ |
|
|
my ($field, $rel_type, $to_table, $datatype) = ($1, $2, $3, $4); |
|
186 |
|
|
187 |
if ($to_table) |
if ($to_table) |
188 |
{ |
{ |
189 |
if ($rel_type eq '->') |
if ($rel_type eq '->') |
190 |
{ |
{ |
191 |
# rels are relegated until we've finished parsing |
# rels are relegated until we've finished parsing |
192 |
# the whole thing. |
# the whole thing. |
193 |
$rels{$table->name}{$field} = $to_table; |
$rels{$table->name}{$field} = $to_table; |
194 |
} |
} |
195 |
else |
else |
196 |
{ |
{ |
197 |
warn "unknown relation kind '$rel_type'"; |
warn "unknown relation kind '$rel_type'"; |
198 |
} |
} |
199 |
} |
} |
200 |
else |
else |
201 |
{ |
{ |
202 |
$table->pkey($field) |
$table->pkey($field) |
203 |
if ($field eq 'id'); |
if ($field eq 'id'); |
204 |
$table->attr($field => ( $datatype || '*** UNDEF ***' )); |
$table->attr($field => ( $datatype || '*** UNDEF ***' )); |
205 |
} |
} |
206 |
} |
} |
207 |
|
$prev_is_comm = 0; |
208 |
|
} |
209 |
} |
} |
210 |
|
|
211 |
foreach my $t (keys %rels) |
foreach my $t (keys %rels) |