<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#######################################################################################
# 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}}) &amp;&amp; (-e "snippath.def") ) {
	open(SNIPPATHDEF, 'snippath.def');
	my @snlist = &lt;SNIPPATHDEF&gt;;
	close(SNIPPATHDEF); 
	for (my $i = 0 ; $i &lt;= $#snlist; $i++) { chomp($snlist[$i]); }
	%{$options{snippath}} = @snlist; }
    @{$options{snippathList}} = keys(%{$options{snippath}})
	if ($options{snippath} &amp;&amp; %{$options{snippath}});
    $options{debug} = 0;

    bless(\%options, $class); }

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

    local *go = sub {
	my ($location, %param) = @_;    
	my ($tex, $path, @tex_data) = $self-&gt;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-&gt;{verbose};
	run_event('onBeginFile', \%param);

	while ($i&lt;$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} &amp;&amp; 
				     $param{module_args} =~ /id=([^\],]+)/) ? $1 : undef;
		$param{module_nesting}++;
		run_event('onBeginModule', \%param); }
	    
	    if (/\\end\{module\}/) {
		run_event('onEndModule', \%param);
		if ($#{$param{module_stack}} &gt;= 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-&gt;{snippathList}}){
		$self-&gt;{snippath}{$srch_snippath} = $1 
		    if (/\\def\\$srch_snippath\#1\{([^\#]+)\#1\}$/); }
	    
	    if ($self-&gt;{follow} &amp;&amp; (/\\((requiremodules(\[($self-&gt;{requireStatus})\])?)|input|include)\{([^\}]+)\}/)){
		my $req_filename = $5; my $req_spath = ''; my $command = $1;
		my $is_require = ($command =~ /requiremodules/) ? 1 : 0;
		if ($is_require || $self-&gt;{loadInputs}) {
		    foreach my $srch_snippath(@{$self-&gt;{snippathList}}){
			if ($req_filename =~ /\\$srch_snippath\{(.+)/){
			    ($req_spath, $req_filename) = ($self-&gt;{snippath}{$srch_snippath}, $1);
			    last; }}
		    run_event('onRecurse', \%param);
		    if ($self-&gt;{recursion} || !$is_require) {
			go($self-&gt;makeLocation($req_filename, $path, $req_spath), %param); }
		}
	    }
	    run_event('onEveryLine', \%param) if ($param{in_module} || !$self-&gt;{onlyModuleLines});

	    last if (/\\end\{document\}/ &amp;&amp; $self-&gt;{stopAtEnd});
	    $i++;
	}
	run_event('onEndFile', \%param);
	$param{depth}--; return;	
    };
    
    my %param = (pack=&gt;$self, perm=&gt;$self-&gt;{_AUX_DATA}, depth=&gt;0, filecount=&gt;0,
		 in_module=&gt;0, module_nesting=&gt;0);
    run_event('onBegin', \%param);
    go($self-&gt;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-&gt;add_ext($self-&gt;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-&gt;new_ext($filename) unless -e $filename;
    $filename = $filename_ext if $filename_ext &amp;&amp; -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-&gt;{loadedFiles}})
    { return undef if $file eq $filename; }
    
    push(@{$self-&gt;{loadedFiles}}, $filename);
    open(FIN, $filename) or die "Cannot open '$filename'\n";
    my @data = &lt;FIN&gt;;    
    close(FIN);
    
    # find path of current file
    my $path = dirname($filename);
    $path.='/' if ($path ne '');
    
    return ($filename, $path, @data);
}

1;
</pre></body></html>