diff options
Diffstat (limited to 'Master/texmf-dist/source/latex/stex/bin/TexId.pm')
-rw-r--r-- | Master/texmf-dist/source/latex/stex/bin/TexId.pm | 464 |
1 files changed, 464 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/latex/stex/bin/TexId.pm b/Master/texmf-dist/source/latex/stex/bin/TexId.pm new file mode 100644 index 00000000000..d0f28ccbce5 --- /dev/null +++ b/Master/texmf-dist/source/latex/stex/bin/TexId.pm @@ -0,0 +1,464 @@ +# package for handling .tex IDs + +package TexId; + +use File::Basename; +use strict; + +# error messages markers + +use constant ERR => '[X]'; # error can't be fixed + +################### 'public' members ################### + +sub new{ + my ($class, %options) = @_; + my $self = {}; + + @{$self->{ENVIRONMENTS}} = qw(module note omtext example + definition problem proof + solution program); # the environments to look at + + @{$self->{ENV_PREFIXES}} = qw(mod not txt ex def prob pf sol prg); # the prefixes for environments + + + @{$self->{ENV_DEF}} = qw(id); # environment arguments that define new environments + @{$self->{ENV_USAGE}} = qw(use uses for from); # environment arguments that + # specify usage of other environments + + # options for the class + %{$self->{OPTIONS}} = %options; + + # in case \snippath{} is encountered, prepend this to the filename + $self->{OPTIONS}{snippath} = 'snippets/' unless defined $self->{OPTIONS}{snippath}; + + + # show progress while reading data + $self->{OPTIONS}{progress} = 1 unless defined $self->{OPTIONS}{progress}; + + bless ($self, $class); +} + +# check/set list of environments to look at +sub environments{ + my ($self, $new_environments, $new_prefixes) = @_; + if (defined $new_environments and defined $new_prefixes){ + @{$self->{ENVIRONMENTS}} = split(/,/, $new_environments); + @{$self->{ENV_PREFIXES}} = split(/,/, $new_prefixes); + die "Invalid argument combination (both arguments must have same number of elements)" + if $#{$self->ENVIRONMENTS} != $#{$self->ENV_PREFIXES}; + } + else { + return (join(',', @{$self->{ENVIRONMENTS}}), join(',', @{$self->{ENV_PREFIXES}})); + } +} + +# define/read environment definition arguments +sub env_def{ + my ($self, $new_env_def) = @_; + if (defined $new_env_def){ + @{$self->{ENV_DEF}} = split(/,/, $new_env_def); + } + else { + return join(',', @{$self->{ENV_DEF}}); + } +} + +# define/read the environment usage arguments +sub env_usage{ + my ($self, $new_env_usage) = @_; + if (defined $new_env_usage){ + @{$self->{ENV_USAGE}} = split(/,/, $new_env_usage); + } + else { + return join(',', @{$self->{ENV_USAGE}}); + } +} + +# define/read the snippets path +sub snippath{ + my ($self, $new_snippath) = @_; + if (defined $new_snippath){ + $new_snippath.='/' if ($new_snippath !~ /\/$/); + $self->{OPTIONS}{snippath} = $new_snippath; + } + else { + return $self->{OPTIONS}{snippath}; + } +} + + +# check all the definitions and module usages +# in all files referenced by base file +sub parse{ + + my ($self, $basefile) = @_; + + # recursive local function to go through each file + local *run_parse = sub + { + my ($filename) = @_; + + # read current .tex file + print STDERR "Loading $filename...\n" if ($self->{OPTIONS}{progress} == 1); + $filename = $self->load_file_data($filename); + my @text = @{$self->{FILEDATA}}; + my $line_no = 0; + + # go through every line of the read file + # depends on: \requiremodules, \snippath + # ignores \end{document} + + foreach (@text){ + # delete newline character, comments and redundant white space + + $line_no++; + /([^%]*)((%.*)?)/; + $_ = $1; + s/\s+//g; + + # see if an environment that has some arguments is defined + my ($possible_env, $env_args) = (undef, undef); + ($possible_env, $env_args) = ($1, $2) if (/\\begin\{([^\}]+)\}\[([^\]]+)\]/); + + # if it is, search it through the list of environments we want to look at + if (defined $possible_env){ + foreach my $environment(@{$self->{ENVIRONMENTS}}){ + next unless ($environment eq $possible_env); + + # if we found an anvironment we want to look at, + # go through the list of arguments + $env_args = $self->swap_exterior_char(',', ';', $env_args); + foreach (split(/;/, $env_args)){ + # we want arguments of type name=value + next unless /([^=]+)=(.+)/; + my ($arg_name, $arg_value) = ($1, $2); + + # see if the argument defines an environment + foreach my $current_env_arg(@{$self->{ENV_DEF}}){ + next unless ($arg_name eq $current_env_arg); + my @to_add = split(/,/, $arg_value); + push(@{$self->{'DEF'}->{$environment}}, @to_add); + foreach my $added_element(@to_add){ + $self->{'DEF'}->{LOCATION}{$added_element}.=$line_no.':'.$filename."\n"; + } + last; + } + + # see if the argument uses an environment + foreach my $current_env_arg(@{$self->{ENV_USAGE}}){ + next unless ($arg_name eq $current_env_arg); + my @to_add = split(/,/, $arg_value); + push(@{$self->{'USE'}->{$environment}}, @to_add); + foreach my $added_element(@to_add){ + $self->{'USE'}->{LOCATION}{$added_element}.=$line_no.':'.$filename."\n"; + } + last; + } + } + last; + } + } + # reference to another file + if (/\\requiremodules(\[(include|exclude)\])?\{([^\}]+)\}/){ + if (defined $2 && $2 eq 'include'){ + $_ = $3; + $_ = $self->{OPTIONS}{snippath}.$1 if (/\\snippath\{(.+)/); + $_ = $self->{path}.$_; + run_parse($_); + } + } + + # see definition of snippath + $self->snippath($1) if (/\\def\\snippath\#1\{([^\#]+)\#1\}$/); + } + }; + + run_parse($basefile); + +} + +# this is the first checking step to be done +sub check_uniq{ + + my ($self) = @_; + + my $error = 0; + + # sort environment definitions and see whether they are uniquely defined + foreach my $environment(@{$self->{ENVIRONMENTS}}){ + next unless defined $self->{'USE'}->{$environment}; + + my @list1 = sort @{$self->{'DEF'}->{$environment}}; + my @list2 = $self->uniq(@list1); + @{$self->{'DEF'}->{$environment}} = @list2; + + # some environments are defined multiple times + if ($#list1 != $#list2){ + my $j = 0; + for (my $i = 0; $i<=$#list2; $i++){ + my $start_j = $j; + while ($j<=$#list1 && $list1[$j] eq $list2[$i]){ + $j++; + } + if ($j - $start_j != 1){ + print STDERR ERR, " Environment '$list2[$i]' is defined multiple times ", + "within same environment type: \n"; + print STDERR $self->{'DEF'}->{LOCATION}{$list2[$i]}, "\n"; + $error = 1; + } + } + } + } + + # see that all environment references are unique (and sort them) + foreach my $environment(@{$self->{ENVIRONMENTS}}){ + next unless defined $self->{'USE'}->{$environment}; + @{$self->{'USE'}->{$environment}} = sort $self->uniq(@{$self->{'USE'}->{$environment}}); + } + + return $error; +} + +sub check_prefix{ + + my ($self) = @_; + + my $count = $#{$self->{ENVIRONMENTS}}+1; + + for (my $i = 0; $i < $count; $i++){ + my $environment = ${$self->{ENVIRONMENTS}}[$i]; + my $envprefix = ${$self->{ENV_PREFIXES}}[$i]; + next unless defined $self->{'DEF'}->{$environment}; + + foreach my $elem (@{$self->{'DEF'}->{$environment}}){ + + my $proper = undef; + if ($elem =~ /^([^:]+):(.+)/){ + $proper = $envprefix.':'.$2 if $1 ne $envprefix; + } else { + $proper = $envprefix.':'.$elem; + } + + if (defined $proper){ + print STDERR ERR, " $environment '$elem' has no prefix ($envprefix). Add it? [ <y>, n ]"; + my $answer = <STDIN>; + chomp($answer); + if ($answer eq 'y' or $answer eq ''){ + $self->add_change('DEF', $elem, $proper); + } + } + } + } +} + + +sub check_defs{ + my ($self) = @_; + + my $error = 0; + + # combine all definitions + my @defs; + map {push(@defs, @{$self->{'DEF'}->{$_}}) if defined @{$self->{'DEF'}->{$_}}} @{$self->{ENVIRONMENTS}}; + @defs = sort @defs; + + # combine all used environments + my @uses; + map {push(@uses, @{$self->{'USE'}->{$_}}) if defined @{$self->{'USE'}->{$_}}} @{$self->{ENVIRONMENTS}}; + @uses = sort @uses; + + + # for all environments + + foreach my $used_env(@uses){ + # if used environment is not defined + if ($self->find_elem($used_env, @defs) < 0){ + # maybe it is a typo + print STDERR ERR, " '$used_env' was not found. Replace options:\n"; + foreach my $definition(@defs){ + print STDERR "\t$definition\n" if $self->edit_dist($used_env,$definition)<4; + $error = 1; + } + } + } + + return $error; +} + + +sub add_change{ + my ($self, $location, $from, $to) = @_; + if ($self->{$location}->{LOCATION}{$from} =~ /([^:]+):([^\n]+)\n/){ + push(@{$self->{CHANGE}->{$2}}, ($1, $from, $to)); + } +} + +# write the stored changes +sub apply_changes{ + my ($self) = @_; + while (my ($filename, $changes) = each %{$self->{CHANGE}}){ + $filename = $self->load_file_data($filename); + my $count = int(($#{$changes}+1)/3); + for (my $i = 0; $i<$count ; $i++){ + my ($line, $from, $to) = (${$changes}[$i*3]-1, + ${$changes}[$i*3+1], ${$changes}[$i*3+2]); + ${$self->{FILEDATA}}[$line] =~ s/\Q$from/$to/; + } + print STDERR "Writing $filename\n" if ($self->{OPTIONS}{progress} == 1); + $self->write_file_data($filename); + } +} + +sub load_file_data{ + my ($self, $filename) = @_; + + # try to give proper file extension if file is not found + $filename = $self->add_ext($self->drop_ext($filename)) unless -e $filename; + + open(FIN, $filename) or die "Cannot open $filename\n"; + @{$self->{FILEDATA}} = <FIN>; + close(FIN); + + $self->{path} = dirname($filename).'/' unless defined $self->{path}; + + return $filename; +} + +sub write_file_data{ + my ($self, $filename) = @_; + + open(FOUT, ">$filename") or die "Cannot write $filename\n"; + print FOUT @{$self->{FILEDATA}}; + close(FOUT); +} + + +################### 'protected' members ################### + +sub def_env_list{ + my ($self, $env_name) = @_; + return @{$self->{'DEF'}->{$env_name}}; +} + +sub use_env_list{ + my ($self, $env_name) = @_; + return @{$self->{'USE'}->{$env_name}}; +} + + +################### 'private' members ################### + +sub drop_ext{ + my ($self, $filename) = @_; + while ($filename =~ /\.tex$/){ + while ($filename !~ /\.$/ ) { chop($filename); } + chop($filename); + } + return $filename; +} + +sub add_ext{ + my ($self, $filename) = @_; + $filename.='.tex' if $filename !~ /\.tex$/; + return $filename; +} + +# look at $word, and swap all occurances of $char_find with +# $new_char if they are not in a {...} environment + +sub swap_exterior_char{ + my ($self, $char_find, $new_char, $word) = @_; + my @new_word = (); + my $exterior = 0; + foreach (split('', $word)){ + if ($_ eq '{'){ + $exterior++; + next; + } + + if ($_ eq '}'){ + $exterior--; + next; + } + + if ($exterior == 0 && $_ eq $char_find){ + push(@new_word, $new_char); + } + else{ + push(@new_word, $_); + } + } + return join('',@new_word); +} + +# return unique elements from a list +sub uniq{ + my ($self, @list) = @_; + my %seen = (); + my @uniqu = grep { ! $seen{$_} ++ } @list; + return @uniqu; +} + + +# binary search +sub find_elem{ + my ($self, $elem, @list) = @_; + + local *search_elem = sub + { + my ($a, $b) = @_; + my $m = int(($a + $b)/2); + return $m if $list[$m] eq $elem; + return -1 if ($a >= $b); + return ($list[$m] le $elem)?search_elem($m+1,$b):search_elem($a,$m-1); + }; + + return search_elem(0, $#list); +} + +# edit distance between two strings +# insertions, deletions, replacement, transposition +sub edit_dist{ + my ($self, $s1, $s2) = @_; + my $m = length($s1); + my $n = length($s2); + my @w1 = split(//, $s1); + my @w2 = split(//, $s2); + + # add dummy char so we can have nicer indeces + unshift(@w1, '*'); + unshift(@w2, '*'); + + # distances matrix + my @d; + + # initialize + $d[0][0] = 0; + for (my $i = 1; $i <= $m ; $i++) { $d[$i][0] = $i;} + for (my $i = 1; $i <= $n ; $i++) { $d[0][$i] = $i;} + + # compute + for (my $i = 1; $i <= $m ; $i++){ + for (my $j = 1; $j <= $n ; $j++){ + my @possibilities = ($d[$i-1][$j-1] + ($w1[$i] ne $w2[$j]), + $d[$i-1][$j] + 1, $d[$i][$j-1] + 1); + + push(@possibilities, $d[$i-2][$j-2] + 1) + if ($i>1 && $j>1 && $w1[$i] eq $w2[$j-1] && $w1[$i-1] eq $w2[$j]); + + $d[$i][$j] = $self->minimum(@possibilities); + } + } + return $d[$m][$n]; +} + +sub minimum{ + my ($self, @list) = @_; + my $result = shift(@list); + map {$result = $_ if $result ge $_} @list; + return $result; +} + + +1; |