#########################################
#    The Shodor Education Foundation    #
#                                       #
#        Brian Block - 7/20/2006        #
#         V2JHelperFunctions.pm         #
#                                       #
# purpose: module for vensim2java that  #
#    contains many helper functions     #
#    used by both v2j_make_form.pl and  #
#    v2j_make_applet.pl.                #
#########################################

use strict;     #helps track down global variables, which should be minimized

package V2JHelperFunctions;   #declares a separate namespace for the module

require Exporter;	#used to export functions to other perl scripts

our @ISA = qw/Exporter/;
our @EXPORT = qw(remove_old_temp_files rm is_valid_object_name
			       format_object_name IS_ITE parse_ite recursive_ite
			       is_ifthenelse get_offset format_value_equation
			       IS_CONSTANT get_units get_lone_value get_initial_value
			       strip_whitespace purge_whitespace IS_STOCK parse_lookup
			       IS_LOOKUP replace_named_lookups FLOW_EXISTS get_flows
			       replace_spaces is_digit is_even get_number_of_objects);

#the 'export tags' hash stores functions to export based on a certain call.
#currently, v2j is the only thing using this file, so its no different
#than just doing the regular 'use'. however, its possible in the future
#that several *2j's could all have their helper functions together (in the
#case that some overlapped).

our %EXPORT_TAGS = (
		    'v2j' => [qw/remove_old_temp_files rm is_valid_object_name
			       format_object_name IS_ITE parse_ite recursive_ite
			       is_ifthenelse get_offset format_value_equation
			       IS_CONSTANT get_units get_lone_value get_initial_value
			       strip_whitespace purge_whitespace IS_STOCK parse_lookup
			       IS_LOOKUP replace_named_lookups FLOW_EXISTS get_flows
			       replace_spaces is_digit is_even get_number_of_objects/]
		    );


#####################################START_HELPER_FUNCTIONS
sub remove_old_temp_files{
#this is the v2j cleanup function - it deletes any models that have been
#in the temp folder for over an hour.
	my $TIME_ON_SERVER = 3600;   #in seconds...3600 sec = 1 hour
	my ($line, $filename, $time_last_modified, $file_loc);
	my $tmp = "/tmp";
	my $dir_contents = "/$tmp/dir_contents.txt";
	system "ls -l /tmp/ > $dir_contents";
	open(INFILE, "$dir_contents");

	my $current_time = time();

	while($line = <INFILE>){
    	chomp($line);
    	$line =~ m/\d\d:\d\d (.*)/;
    	$filename = $1;
	
    	if ($filename =~ /^v2j.*/){
    	    $file_loc = "/$tmp/$filename";
    	    $time_last_modified = (stat($file_loc))[9];
    	       #the stat fxn returns an array of variables containing
    	       #information on the given file...the 9th element is the
    	       #last time the variable was modified
	
	        if (($current_time - $time_last_modified) > $TIME_ON_SERVER){
    	        &rm($filename);
    	    }
    	}
	}
}

sub rm{
#system remove command
    my $name = shift;
    system "rm -rf /tmp/$name";
}

sub is_valid_object_name{
#returns false if object name has any chars besides alphanumeric, underscore,
#or whitespace
	my ($tempname) = shift;
	if ($tempname =~ /[^\w\s]/){
    	return 0;
	}
	return 1; 
}

sub format_object_name{
#input: unformatted string that passes the validity test
#actions: strip leading and trailing spaces, then replace
#any spaces remaining with underscores
    my ($tempname) = shift;

    #delete lead/trailing whitespace
    $tempname = &strip_whitespace($tempname);

    #swap remaining spaces with _
    $tempname =~ s/\s+/_/g;
    
    return $tempname;
}

sub IS_ITE{
#boolean function that returns true if a variable starts with vensim's 
#if-then-else syntax
	my ($line) = shift;
	if ($line =~ m/^IF_THEN_ELSE/i){
		return 1;
	}
	else {return 0};
}

sub parse_ite{
#this function is the precursor to parsing nested if-then-elses. it splits
#up a variable's value, then passes the tokens to recursive_ite, which actually
#handles the nested if-then-elses.
	$V2JHelperFunctions::nested_ite_variable_name = shift;
	my $variable_value = shift;
	my @tokens;
	$V2JHelperFunctions::nested_ite_counter = 0;
	@V2JHelperFunctions::parsed_equations = "";
	
	while ($variable_value =~ /\)\)/){       #split stacked parens (e.g. ite((mod(1,2)))
  		$variable_value =~ s/\)\)/\),\)/g;   #   would become ite(,(mod(1,2),),) - this
	}                               		 #   allows the offset to be checked with each paren
	while ($variable_value =~ /\(\(/){
		$variable_value =~ s/\(\(/\(,\(/g;
	}

	@tokens = split(/\,/, $variable_value);

	&recursive_ite(1, @tokens);
	if ($V2JHelperFunctions::parsed_equations[0] == ""){
		shift @V2JHelperFunctions::parsed_equations;
	}
	return @V2JHelperFunctions::parsed_equations;
}

sub recursive_ite{
#this function steps through a value (split up into tokens) and matches
#segments based on parentheses. if an if-then-else is found nested inside another,
#it makes an entirely new variable and places a reference to that variable
#inside the outer if-then-else. this allows for future implementation of
#individual manipulation of each if-then-else (e.g. with sliders). note that
#this feature is not yet implemented, but it will be easier to do later on.
    my $offset = shift;
    my @toks = @_;
    my $ite = shift @toks;

    while (&get_offset($ite) != 0){         #while the parentheses dont even out...
    
		if ($toks[0] =~ /^IF_THEN_ELSE\(/){		#start a new instance if nested
			@toks = &recursive_ite(1,@toks);	#  ite is found.
		}
		elsif ($toks[0] eq ""){		#if splitting results in a comma next to another comma,
			shift @toks;            #an empty token is created. this removes it.
		}
		else{
		    $ite = $ite . "," . (shift @toks);  #keep concating the string if everything
		}              							#  checks out.
	}
    
    $ite =~ s/,+/,/g;		#get rid of the commas that were previously added 
	$ite =~ s/\(,/\(/g;		#  for easier parsability.
	$ite =~ s/,\)/\)/g; 
    push @V2JHelperFunctions::parsed_equations, $ite;		#this "static" array holds each if-then-else found
    
    #after an if-then-else is found, push a reference to it as the next token
    unshift @toks, ($V2JHelperFunctions::nested_ite_variable_name . "__" . $V2JHelperFunctions::nested_ite_counter);
    $V2JHelperFunctions::nested_ite_counter++;
    return @toks;
}

sub is_ifthenelse{
#this function checks if the given string contains vensim syntax
#for if-then-else and parses it to the appropriate inf file
#syntax. i wanted to have this done when the other string 
#formatting features were applied, but the spaces in the name
#caused errors later on. therefore, it is called on each
#objects 'value' when the outfile is built
	my ($line) = shift;
	my ($parsed_token_counter) = 0;    #used to put parsed tokens in the right spot
	my (@tokens,@parsed_tokens);
	my ($i);
	
	if ($line =~ /^IF_THEN_ELSE\(/i){
		$line =~ s/^IF_THEN_ELSE\(//i;  #remove leading marker
		$line =~ s/\)$//; #remove trailing parenthesies
		
		@tokens = split(/\,/, $line);  #split on each comma
		$i = 0;
		
		#rebuild based on balancing parentheses
		while ($i < @tokens){

        	$line = $tokens[$i];
        	$i++;
        	while (&get_offset($line) != 0){
        	    $line = $line . "," . $tokens[$i];
        	    $i++;
        	}

        	$parsed_tokens[$parsed_token_counter] = $line;
        	$parsed_token_counter++;
    	}
    	
    	$line = "IF $parsed_tokens[0] then $parsed_tokens[1] ELSE $parsed_tokens[2]";
    }
    return $line;
}

sub get_offset{
#keeps track of balanced parentheses. 
#i.e.: () = 0, (() = 1, ())) = -2.
    my ($string) = shift;
    my ($offset);

    while ( $string =~ /(\(|\))/g ) {
        if ($1 =~ /\(/) {$offset++;}
        elsif ($1 =~ /\)/) {$offset--;}
    }
    return $offset;
}

sub format_value_equation{
#this function gets the value of a stock/flow/auxvar in equation format
#and filters out the object names, removing unnecesary whitespace and
#replacing spaces in variable names with underscores
	my($line) = shift;
	my @object_names;
	my $formatted_name;
	
	@object_names = split(/(\+|\-|\/|\*|\,|\(|\)|\>|\<|\=|\<\=|\>\=)/, $line);
	my ($fixedline) = "";
	
	foreach (@object_names){
    	$formatted_name = &replace_spaces(&strip_whitespace($_));
    	$fixedline = "$fixedline" . "$formatted_name$1";
    }
    
    return $fixedline;
}

sub IS_CONSTANT{
#this function checks the syntax of an objects value.
#if it contains anything besides numbers, decimals, "e",
#+, -, or ^, then return false. otherwise return true
    my ($line) = &purge_whitespace(shift);
    if ($line =~ /[^\d\.e\+\-\^]/){
		return 0;
    }
    else{
    	return 1;
    }
}

sub get_units {
#if the line starts with "Units:" (as per the vensim
#syntax), then it contains the units associated with
#the vensim object.
    my ($line) = &purge_whitespace(shift);
    $line =~ s/^Units\://;
    return $line;
    
}

sub get_lone_value {
#input: value of a stock...returns just the equation (initial value excluded)
	my ($line) = shift;
	$line =~ s/^INTEG\(//i;
	$line =~ s/\,.*//;
	
	return $line;
}

sub get_initial_value {
#input: value of a stock where the initial value is separated from
#the equation by a comma...return numerical value after comma
    my ($line) = shift;
    $line =~ s/^[^,]*,//;    #remove everything up to first comma
    $line =~ s/\)\Z//;   #remove trailing ')'

    return $line;
}

sub strip_whitespace {
#removes leading and trailing whitespace
    my ($line) = @_;
    chomp $line;
    $line =~ s/\A\s+//g;
    $line =~ s/\s+\Z//g;
    return $line;
}

#removes all whitespace
sub purge_whitespace {
    my ($line) = @_;
    chomp $line;
    $line =~ s/\s+//g;
    return $line;
}

sub IS_STOCK {
#input: string (line with digit tag at start).
#it seems that the function INTEGR() is specific to
#stocks - that is, if "INTEG(" immediately follows
#the first "=" sign, the object in question is a stock

    my $sample_line = shift;  #pop string off @_
    
    if ( $sample_line =~ /^INTEG ?\(/ ){
		return 1;
    }
    else { return 0; }
}

sub parse_lookup{
#input: string containing the value of an aux var
#the format of a "lookup" parameter in vensim is 
# WITH LOOKUP(variable,([(xmin,ymin)-(xmax,ymax)],(x1,y1),(x2,y2)...))
# this fxn returns a string of the format
# variable:(x1,y1),(x2,y2)...

    my $line = shift;
    my ($varname, $datapoints);

    #remove lookup function call
    $line =~ s/^WITH_LOOKUP\(//;
    $line =~s/\)$//;

    #matches the variable for lookup and assigns to varname
    #then matches the datapoints, which are located after the
    #range syntax [(xmin,ymin)-(xmax,ymax)]
    
    #           -var-     --------------------------range syntax------------------  -points-
    $line =~ m/([^,]*),.*\[\(\d+[\d\.]*\,\d+[\d\.]*\)\-\(\d+[\d\.]*\,\d+[\d\.]*\)\],(.*)\)$/;
    
    $varname = "\(" . $1 . "\)"; #add parentheses in case of equation
    $datapoints = $2;
    return $varname . ":" . $datapoints;
}

sub IS_LOOKUP{
#input: string containing the value of an aux var.
#checks to see if it starts with "WITH_LOOKUP(" and
#returns an appropriate boolean value.
#
#named lookups are like lookup templates - they contain a table with no
#values to apply the dataset to. the syntax starts with the data range 
#[(xmin,ymin)-(xmax,ymax)]. if this is found, return 2.

    my $line = shift;

    if ($line =~ /^WITH_LOOKUP\(/){
        return 1;
    }
    elsif ($line =~ /^\(\[\(\d+[\d\.]*\,\d+[\d\.]*\)\-\(\d+[\d\.]*\,\d+[\d\.]*\)\]/ ){
    	return 2;
    }
    else {return 0;}
}

sub replace_named_lookups{
#the array @named_lookups contains a list of the named lookup id's. this
#function scans every variable and looks for each of the names. if one is found,
#change the value to use a WITH_LOOKUP using the values from the named lookup
	my $self = shift;
	my @named_lookups = @_; 

	my (%variables) = %{%$self->{'variable'}};
	my $tempvalue;
	
	foreach my $named_lookup (@named_lookups){
		
		foreach my $variable_name (keys %variables){
			$tempvalue = $named_lookup;		#tempvalue = the named lookup id
			
			if ($variables{$variable_name}->{'value'} =~ /^$tempvalue\((.*)\)/){
				$tempvalue = $1;			#tempvalue = the equation the lookup
											#table applies to.
				
				$self->{'variable'}->{$variable_name}->{'value'} = 
					"WITH_LOOKUP(($tempvalue),$self->{'variable'}->{$named_lookup}->{'value'})";
				$self->{'variable'}->{$variable_name}->{'is_lookup'} = 1;
			}
		}
		delete $self->{'variable'}->{$named_lookup};	#remove the named lookup
	}
	return $self;
}

sub FLOW_EXISTS {
#this fxn accepts a reference to a hash table containing the
#flows and a target name. it checks if the name is already contained in the
#'flow' hash from MODEL.
	open (FLOWEXISTS, ">>/tmp/flowexist.txt");
	my $hashreference = shift;
	my $key = shift;
	my $flowname;
	
	my %flows = %$hashreference;   #dereference hashreference
	
	foreach $flowname (keys %flows){
		print FLOWEXISTS "does $flowname equal $key?  ";
		if ($flowname eq $key){
			print FLOWEXISTS "yes!\n";
			return 1;
		}
	}
	print FLOWEXISTS "no!\n";
	close FLOWEXISTS;
	return 0;
}

sub get_flows{
#the purpose of this function is to see which 'variables' are in which 'stocks'
#but not part of the 'initial value'. the theory is that, in order to determine
#which of the remaining variables are flows and which are aux vars, any involved
#in the equation of a STOCK are flows, and any involved in the initialization
#are aux vars...seems to hold true so far.
	open (FLOWCHECK, ">/tmp/flowcheck.txt");
	my ($self) = shift;
	my ($flows_in_to, $flows_out_of);
	my (%stocks) = %{%$self->{'stock'}};
	my (%variables) = %{%$self->{'variable'}};
	my (%flows); 
	
	
	my ($stockname, $stock, $variablename, $purged_name, $stock_equation);
	my $q;
	while (($stockname, $stock) = each %stocks){
		foreach $variablename (keys %variables){
			$purged_name = quotemeta &purge_whitespace($variablename);
			$stock_equation = $stock->{'value'};
			$stock_equation =~ s/\,.*//;    #remove stuff after comma (initialization)
			
			
			%flows = %{%$self->{'flow'}};		#update current flow status
			
			#if flow isnt already in updated hash...
			if ($stock_equation =~ /\b$purged_name\b/){
				if (!FLOW_EXISTS(\%flows, $variablename)){
					$self->add_flow($variablename);
					$self->{'flow'}->{$variablename}->{'value'} = $variables{$variablename}->{'value'};
					$self->{'flow'}->{$variablename}->{'units'} = $variables{$variablename}->{'units'};
					
					#set flag if the flow contains a lookup table
					$self->{'flow'}->{$variablename}->{'is_lookup'} = 
						&IS_LOOKUP($variables{$variablename}->{'value'});
					
					#set flag if the flow is an if-then-else
					$self->{'flow'}->{$variablename}->{'is_ite'} = 
						&IS_ITE($variables{$variablename}->{'value'});
					
					delete $self->{'variable'}->{$variablename};
				}
			}
			
			#set flow to/from properties based on role in stock equation (+=to -=from)
			if ($stock_equation =~ /\-\b$purged_name\b/){
				$self->{'flow'}->{$variablename}->{'flow_from'} = $stockname;
				
			}
			elsif ($stock_equation =~ /\b$purged_name\b/){
				$self->{'flow'}->{$variablename}->{'flow_to'} = $stockname;
			}
		}
	}
	return $self;
}

sub replace_spaces{
#this functions replaces any spaces
#with underscores
	my ($replace_my_spaces) = shift;
	
	$replace_my_spaces =~ s/\s+/\_/g;
	return $replace_my_spaces;
	
}

sub is_digit{
#boolean function takes in a string and verifies if it contains only digits
#and decimals
	my ($check_me) = shift;
	
	#check if variable is made of only digits
	if ($check_me =~ /^\d*\.?\d+$/) {return 1;}
	else {return 0;}
	
}

sub is_even{
#this function is used when creating the form. every other element
#should have a different color, and this fxn helps track when to switch.
	my $n = shift;
	if ($n % 2 == 0) {return 1;}
	else {return 0;}
}

sub get_number_of_objects{
#returns the total number of vensim objects used in equations
	my $self = shift;

	my (%flows) = %{%$self->{'flow'}};
	my (%stocks) = %{%$self->{'stock'}};
	my (%variables) = %{%$self->{'variable'}};
	my (%constants) = %{%$self->{'constant'}};
	my $n;
	
	$n = keys(%flows) + keys(%stocks) + keys(%variables) + keys(%constants);
	
	return $n;
}
##########END_HELPER_FUNCTIONS###############################################