7
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
11
# $Id: Parser.pm,v 1.6 2004/04/08 17:03:43 wbluhm Exp $ RCS identification
20
my $class = ref($proto) || $proto;
27
#######################
28
# Class method: parse #
29
#######################
33
my ($self,@parameters) = @_;
34
my ($file,$dict,$options);
37
$file = shift @parameters unless $#parameters;
38
while ($_ = shift @parameters) {
39
$file = shift @parameters if /-file/;
40
$dict = shift @parameters if /-dict/;
41
$options = shift @parameters if /-options/;
44
my ($d, $s, $c, $i); # data and save blocks
46
my ($n, $m); # loop counters
49
my (@entries, $entry);
50
my (@cats_in_loop, @items_in_loop);
51
my ($line_nums_ref, $flags_ref, $tokens_ref);
53
my $token; # Here, "token" shall mean an item name (e.g. _atom.id),
54
# or an item value, (5 examples: 1 value 'a value' . ? )
55
# or a value over several lines delimited by semicolons.
57
$d = 'untitled'; # default (if no data block)
58
$s = '-'; # default (if not in save block)
60
$debug = 1 if ( $options =~ /d/ );
61
$log =1 if ( $options =~ /l/ );
68
print STDERR "tokenizing complete file\n" if ( $log );
70
($line_nums_ref, $flags_ref, $tokens_ref) = STAR::Parser->_all_tokens(-file=>$file);
72
### check integrity of token list -- pre-parsing check ###
73
# this had not been implemented yet, but
74
# would now have to be a class method in STAR::Parser
77
print STDERR "Start of tokens\n";
78
foreach $n (0.. $#$tokens_ref) {
79
print STDERR "next token: ",$$flags_ref[$n],
80
" ",$$tokens_ref[$n],"\n";
82
print STDERR "End of tokens\n";
85
# default data block (if no data_ in file, e.g. for ERF files)
87
$entry = STAR::DataBlock->new;
88
$entry->file_name($file);
90
$entry->title('untitled');
91
$entry->starting_line(1);
92
push @entries, $entry;
99
until ( (shift @$flags_ref) eq 'eof' ) {
101
$token = shift @$tokens_ref;
102
print STDERR "next token: $token\n" if ($debug);
104
if ( $token =~ /^data_(.*)/ ) { #data block
107
$s = '-'; # default (if not in save block)
108
print STDERR "New data block: $token\n" if ($debug);
110
# create new "entry object" (DataBlock or Dictionary)
111
# ---------------------------------------------------
114
$entry = STAR::Dictionary->new;
115
$entry->type('dictionary');
118
$entry = STAR::DataBlock->new;
119
$entry->type('data');
121
$entry->file_name($file);
123
$entry->starting_line( shift @$line_nums_ref ); # next data block line number
124
push @entries, $entry;
126
print STDERR "parsing ",$entry->{TITLE},"\n" if ( $log );
131
if ( $token =~ /^save_(\S+)/ ) { #save block
133
print STDERR "save block: $s\n" if ($debug);
135
elsif ( $token =~ /^save_$/ ) { #end of save block
139
if ( $token =~ /^loop_/ ) { #loop block
141
print STDERR "started loop\n" if ($debug);
142
$flag = shift @$flags_ref;
143
$token = shift @$tokens_ref;
147
while ( $flag eq 'i' ) { # need to check for $flag since _something could have
148
# also been a value (in quotes)
150
if ( $token =~ /^(_\S+?)\.\S+/ ) { # DDL2: _category.item
153
else { # DDL1: no notion of category
156
print STDERR "token (item) in loop: ", "$token\n" if ($debug);
157
push @cats_in_loop, $c;
158
push @items_in_loop, $token;
159
$flag = shift @$flags_ref;
160
$token = shift @$tokens_ref;
164
until ( $flag ) { #if it's NOT a value, it's got a flag
166
foreach $n (0..$#items_in_loop) {
167
print STDERR "token (value) in loop: ",
168
"$token\n" if ($debug);
169
$entry->{DATA}{$d}{$s}{$cats_in_loop[$n]}
170
{$items_in_loop[$n]}[$m]
172
$flag = shift @$flags_ref;
173
if ( $flag && ( $n < $#items_in_loop ) ) {
174
die "fatal parsing error in category $cats_in_loop[$n]\n";
176
$token = shift @$tokens_ref;
181
print STDERR "finished loop\n" if ($debug);
182
print STDERR "last token (to be recycled): ",
183
"$token\n" if ($debug);
185
# the last token was out of 'loop_'
186
# and needs to be recycled at the top
187
unshift @$flags_ref, $flag;
188
unshift @$tokens_ref,$token;
191
elsif ( $token =~ /^_\S+/ ) {
193
if ( $token =~ /^(_\S+?)\.\S+/ ) { # DDL2: _category.item
196
else { # DDL1: no notion of category
199
$flag = shift @$flags_ref;
201
die "fatal parsing error in category $c\n";
203
$token = shift @$tokens_ref; #this one must be a value!
204
print STDERR "next token (value): ",
205
"$token\n" if ($debug);
206
$entry->{DATA}{$d}{$s}{$c}{$i}[0] = $token;
210
if ($#entries > 0) { # if there is more than one entry
211
shift @entries; # discard the default "untitled" entry
214
# add ending line number attributes
218
foreach $entry ( @entries ) {
219
push @ending_lines, ( $entry->starting_line() - 1 );
222
shift @ending_lines; # first one didn't make sense
223
push @ending_lines, ( shift @$line_nums_ref ); # last one is last line number
225
foreach $entry ( @entries ) {
226
$entry->ending_line( shift @ending_lines );
230
foreach $entry ( @entries ) {
231
print STDERR $entry->get_attributes;
239
#####################################
240
# Private class method: _all_tokens #
241
#####################################
243
# This method was moved from DataBlock to Parser in version 0.58
247
my ($self, @parameters) = @_;
250
$file = shift @parameters unless $#parameters;
251
while ($_ = shift @parameters) {
252
$file = shift @parameters if /-file/;
256
my ($lines, $token, $rest);
257
my (@line_nums, @flags, @tokens);
259
open (IN, "<$file") or die "Can't open file $file";
262
if ($multi_flag == 1) {
264
$multi_flag=0; #one value (w/o semicolons)
266
push @tokens, $lines; #no flag
267
$_ = $1; # continue with rest of line
268
# closing semicolon does not have to be on line by itself
271
$multi_flag=0; #one value (w/o semicolons)
273
push @tokens, $lines; #no flag
277
$lines .= $_; #append
281
elsif ( /^;(.*)/s ) {
282
$multi_flag=1; #start
283
$lines = $1; #newline still on
291
/^\s*(["'])(.*?)\1\s(.*)/s; #stuff in quotes is one token
292
push @flags, ''; #it's a value, so no flag
296
elsif ( /^\s*(\S+)(.*)/s ) { #one token
299
push @tokens, $token;
302
unless ( $token =~ /_/ ) {
303
push @flags, ''; #without '_' certainly a value
306
if ( $token =~ /^_/ ) {
307
push @flags, 'i'; #item
309
elsif ( $token =~ /^loop_/ ) { #loop
312
elsif ( $token =~ /^save_/ ) { #save
315
elsif ( $token =~ /^data_/ ) { #data
317
push @line_nums, $.; # next data block line number
320
push @flags, ''; #an unquoted value with '_'
326
push @flags, 'eof'; # 'eof' added as last flag
327
# thus there should always be one more flag
328
push @line_nums, $. ; # last line number
332
return (\@line_nums, \@flags, \@tokens);
336
#######################################
337
# Private class method: _find_entries #
338
#######################################
340
# This method has been obsoleted in version 0.58.
341
# Since 0.58, files are no longer pre-parsed
342
# for data blocks, since it does not allow
343
# for proper functional assignment of all
353
STAR::Parser - Perl extension for parsing STAR compliant files (with no
358
This documentation refers to version 0.59 of this module.
364
($data) = STAR::Parser->parse('1fbm.cif');
366
($dict) = STAR::Parser->parse(-file=>'mmcif_dict',
368
-options=>'l'); #logs activity
372
STAR::Parser is one of several related Perl modules for parsing
373
STAR compliant files (such as CIF and mmCIF files). Currently,
374
these modules include STAR::Parser, STAR::DataBlock, STAR::Dictionary,
375
STAR::Writer, STAR::Checker, and STAR::Filter.
377
STAR::Parser is the parsing module, with the class method parse
378
for parsing any STAR compliant files or dictionaries, as long
379
as they do B<not> contain nested loops (i.e., only B<one> level of
381
Upon parsing of a file, an array of DataBlock objects is returned (one
382
for each data_ entry in the file).
384
STAR::DataBlock contains object methods for these objects.
385
STAR::DataBlock is automatically accessible through STAR::Parser.
386
Upon parsing of a dictionary (indicated with the C<-dict=E<gt>1> parameter),
387
an array of Dictionary objects is returned. STAR::Dictionary is a sub-class
390
The methods of this module and the accompanying modules
391
(STAR::DataBlock, STAR::Checker, etc.) support
392
"named parameters" style for passing arguments. If
393
only one argument is mandatory, then it may be passed in either a
394
"named parameters" or "unnamed parameters" style, for example:
396
@objs = STAR::Parser->parse( -file=>$file, -options=>'d' ); #debugging
398
@objs = STAR::Parser->parse( -file=>$file ); #no options
399
or: @objs = STAR::Parser->parse( $file );
405
Usage: @objs = STAR::Parser->parse(-file=>$file[,
407
-options=>$options]);
409
or: @objs = STAR::Parser->parse($file);
413
1) @objs = STAR::Parser->parse('1fbm.cif');
418
($data) = STAR::Parser->parse('1fbm.cif');
420
2) @objs = STAR::Parser->parse('7files.txt');
421
foreach $obj (@objs) {
422
# do something, see STAR::DataBlock
425
3) @objs = STAR::Parser->parse(-file=>'mmcif_dict',
427
-options=>'l'); #logs activity
430
This method first searches the file and creates a DataBlock object
431
for each data_ identifier found in the file. If no data_ identifier
432
is found, then only one DataBlock object
433
will be created (with C<$d='untitled'>,
434
see below). If parse is invoked with the C<-dict=E<gt>1> option,
435
then a Dictionary object is created for each data_ identifier found.
437
Next, the method populates
438
the data structure of each DataBlock or Dictionary object.
439
The parsed data may be queried or accessed by
440
object methods of the STAR::DataBlock and STAR::Dictionary modules.
441
See the documentation for STAR::DataBlock and STAR::Dictionary.
443
The method always returns an array of objects, even if it contains only
444
one object (if there is only one data_ block in the file).
446
Internally, the parsed data is stored in a multidimensional
447
hash with keys for data blocks (C<$d>), save blocks (C<$s>),
448
categories (C<$c>), and items (C<$i>).
449
For a file, C<$s> will always be C<'-'>, since there are no
450
save blocks in files.
451
For a dictionary, C<$s> will be C<'-'> outside of save_ blocks,
452
and C<'CATEGORY'> or C<'_item'> inside save_CATEGORY or save__item blocks
453
(capitalization depends on the user's dictionary.)
454
If a file is parsed that contains no data_ identifier, then C<$d> becomes
455
C<'untitled'>. C<$c> refers to a category, such as _atom_site and
456
C<$i> refers to an item, such as _atom_site.id.
458
The method may be invoked with an $options string. These options
459
are the following letters which may be concatenated in any order:
461
d writes debugging output to STDERR
462
l writes program activity log to STDERR
466
This module provides no error checking of files or objects,
467
either against the dictionary, or otherwise. While
468
the module is applicable to parsing either a
469
file or a dictionary, dictionary
470
information is not currently used in the parsing
471
of files. So, for example, information about
472
parent-child relationships between items is not
473
present in a DataBlock object. Functionality related to these
474
issues is being provided in additional modules such as STAR::Checker,
479
Wolfgang Bluhm, mail@wbluhm.com
481
=head2 Acknowledgments
483
Thanks to Phil Bourne, Helge Weissig, Anne Kuller, Doug Greer,
484
Michele Bluhm, and others for support, help, and comments.
488
A full copyright statement is provided with the distribution
489
Copyright (c) 2000 University of California, San Diego
493
STAR::DataBlock, STAR::Dictionary.
added
removed
0CPAN/STAR-Parser-0.59/lib/STAR/Parser.pm
