summaryrefslogtreecommitdiff
path: root/macros/latex/contrib/stex/bin/Modparse.pm
blob: 2fd732b063d624bf78ca842a6d4ba6ef377af599 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
#######################################################################################
# A module for loading .tex files and feeding the data to the various applications.   #
# Copyright (c) 2005, Ioan Sucan, released under the Gnu General Public License (GPL) #
#                                 see http://www.gnu.org/copyleft/gpl.html            #
# $URL: svn://kwarc.eecs.iu-bremen.de/repos/kwarc/projects/content/bin/Modparse.pm$   # 
# $Date: 2005-09-26 12:44:28 -0500 (Mon, 26 Sep 2005) $ $Rev: 4243 $                  #
#######################################################################################

package Modparse;

use File::Basename;
use File::Path;

# if both snippath and snippathList are specified,
# snippathList is ignored !

# if a default snippath definition file is found 
# (snippath.def) it is used if no snippath is given 
# as argument; 
sub new {
    my ($class, %options) = @_;

    $options{recursion} = 1 unless defined $options{recursion};
    $options{requireStatus} = 'include|exclude' unless defined $options{requireStatus};
    $options{loadInputs} = 1 unless defined $options{loadInputs};
    $options{onlyModuleLines} = 0 unless defined $options{onlyModuleLines};

    if ( !(%{$options{snippath}}) && (-e "snippath.def") ) {
	open(SNIPPATHDEF, 'snippath.def');
	my @snlist = <SNIPPATHDEF>;
	close(SNIPPATHDEF); 
	for (my $i = 0 ; $i <= $#snlist; $i++) { chomp($snlist[$i]); }
	%{$options{snippath}} = @snlist; }
    @{$options{snippathList}} = keys(%{$options{snippath}})
	if ($options{snippath} && %{$options{snippath}});
    $options{debug} = 0;

    bless(\%options, $class); }

sub execute{
    my ($self, $file) = @_;
    
    local *run_event = sub {
	my ($event, $arg) = @_;
	if ($self->{$event}) { $self->{$event}($arg); }
    };

    local *go = sub {
	my ($location, %param) = @_;    
	my ($tex, $path, @tex_data) = $self->readLocation($location);
	return unless @tex_data;
	my $NL = $#tex_data+1;

	$param{filename} = $tex;
	$param{depth}++;
	$param{filecount}++;
	my $i = 0; 

	$param{nextline}   = sub { $tex_data[++$i]; };
	$param{prevline}   = sub { $tex_data[--$i]; };
	$param{rewriteline}= sub { $tex_data[$i] = $_[0]; };

	print "Processing $tex...\n" if $self->{verbose};
	run_event('onBeginFile', \%param);

	while ($i<$NL){
	    $param{original} = $tex_data[$i];
	    $_ = $tex_data[$i]; chomp; /([^%]*)((%.*)?)/;
	    ($param{tex}, $param{comment}) = ($1, $2); $_ = $1;
	    s/\s+//g; $param{simple_tex} = $_;

	    if (/\\begin\{module\}(\[([^\]]*)\])?/) {
		if ($param{in_module}) {
		    push(@{$param{module_stack}}, [$param{module_id}, $param{module_arg}]); }
		$param{in_module} = 1;
		$param{module_args} = $1 ? $2 : undef;
		$param{module_id} = ($param{module_args} && 
				     $param{module_args} =~ /id=([^\],]+)/) ? $1 : undef;
		$param{module_nesting}++;
		run_event('onBeginModule', \%param); }
	    
	    if (/\\end\{module\}/) {
		run_event('onEndModule', \%param);
		if ($#{$param{module_stack}} >= 0) {
		    ($param{module_id}, $param{module_args}) = @{pop(@{$param{module_stack}})};
		} else {
		    $param{in_module} = 0;
		    ($param{module_id}, $param{module_args}) = (undef, undef); }
		$param{module_nesting}--;
	    }
	    
	    foreach my $srch_snippath(@{$self->{snippathList}}){
		$self->{snippath}{$srch_snippath} = $1 
		    if (/\\def\\$srch_snippath\#1\{([^\#]+)\#1\}$/); }
	    
	    if ($self->{follow} && (/\\((requiremodules(\[($self->{requireStatus})\])?)|input|include)\{([^\}]+)\}/)){
		my $req_filename = $5; my $req_spath = ''; my $command = $1;
		my $is_require = ($command =~ /requiremodules/) ? 1 : 0;
		if ($is_require || $self->{loadInputs}) {
		    foreach my $srch_snippath(@{$self->{snippathList}}){
			if ($req_filename =~ /\\$srch_snippath\{(.+)/){
			    ($req_spath, $req_filename) = ($self->{snippath}{$srch_snippath}, $1);
			    last; }}
		    run_event('onRecurse', \%param);
		    if ($self->{recursion} || !$is_require) {
			go($self->makeLocation($req_filename, $path, $req_spath), %param); }
		}
	    }
	    run_event('onEveryLine', \%param) if ($param{in_module} || !$self->{onlyModuleLines});

	    last if (/\\end\{document\}/ && $self->{stopAtEnd});
	    $i++;
	}
	run_event('onEndFile', \%param);
	$param{depth}--; return;	
    };
    
    my %param = (pack=>$self, perm=>$self->{_AUX_DATA}, depth=>0, filecount=>0,
		 in_module=>0, module_nesting=>0);
    run_event('onBegin', \%param);
    go($self->makeLocation($file), %param);
    run_event('onEnd', \%param);
    return;
}


# add a [.tex] extension to the filename
sub add_ext{
    my ($self, $fn, $ext) = @_;
    $ext = '.tex' unless $ext;
    $fn.=$ext if $fn !~ /\Q$ext\E$/;
    $fn; }

# as long as the extension is .tex, drop it
sub drop_ext{
    my ($self, $filename) = @_;
    while ($filename =~ /\.tex$/){
	while ($filename !~ /\.$/ ) { chop($filename); }
	chop($filename); }
    $filename; }

sub new_ext{
    my ($self, $filename, $ext) = @_;
    $self->add_ext($self->drop_ext($filename), $ext); }

# location = pointer to array of strings
# first element is filename; next are possible paths
sub makeLocation{ my $self = shift; return \@_; }

# read a location into an array of strings
# aslo return filename and path to it (just in 
# case some changes were made to it, like adding 
# extension and/or relative paths)
sub readLocation{
    my ($self, $location) = @_;
    
    my ($filename, @paths) = @{$location};    
    # try to add proper extension;
    my $filename_ext = $self->new_ext($filename) unless -e $filename;
    $filename = $filename_ext if $filename_ext && -e $filename_ext;
    
    # try search paths
    if (! -e $filename){
	my $all_p = '';
	foreach my $p(@paths){
	    $all_p .= $p;
	    $filename = $all_p.$filename and last if -e $all_p.$filename;
	    $filename = $p.$filename and last if -e $p.$filename;
	    if ($filename_ext){
		$filename = $all_p.$filename_ext and last if -e $all_p.$filename_ext;
		$filename = $p.$filename_ext and last if -e $p.$filename_ext; }
	}}
    # don't do the same work too many times 
    foreach my $file(@{$self->{loadedFiles}})
    { return undef if $file eq $filename; }
    
    push(@{$self->{loadedFiles}}, $filename);
    open(FIN, $filename) or die "Cannot open '$filename'\n";
    my @data = <FIN>;    
    close(FIN);
    
    # find path of current file
    my $path = dirname($filename);
    $path.='/' if ($path ne '');
    
    return ($filename, $path, @data);
}

1;