#!/usr/bin/perl ############################################################# # The Shodor Education Foundation # # Brian Block - 6/21/2006 # # v2j_make_applet.cgi # # create the outfile used to create the applet # # Based on code written by Dave Joiner for Stella2Java # # # # Purpose: v2j_make_applet.cgi uses the same parsing method # # as v2j_make_form.cgi. the goal of this script is to # # create a file that can be read by the applet-creating # # script, written by Dave Joiner and originally intended # # for Stella2Java. # ############################################################# use CGI qw/:standard *table start_ul/; #load standard CGI routines use CGI::Pretty qw( :html3 ); #format html source so it isnt in 1 line #######################################START_DEFINE_CLASSES #///////////////////////////MODEL CONTAINER package MODEL; sub new{ my($type) = shift; my($self) = { "stock" => {}, "flow" => {}, "constant" => {}, "variable" => {} }; our $stock_count; our $flow_count; our $var_count; our $constant_count; bless($self, $type); return($self); } sub print_model_contents{ #used to check that the vensim data is parsed properly and that #the MODEL is built correctly. strictly for debugging purposes. my($self) = shift; my($debug_file) = shift; #parsed_input.txt - used for debugging my ($key); my ($index) = 0; open (PARSEFILE, "> $debug_file"); #DO THIS TYPE OF THING FOR EVERY PROPERTY OF A NODE, AND #FOR EVERY OBJECT TYPE IN A SEPERATE FXN (hash traversals #are random, therefore the $objtype throws some things off). while (($objtype, $obj) = each %$self){ if ($objtype eq 'stock'){ print PARSEFILE "STOCKS:\n"; foreach $key (keys %$obj){ print PARSEFILE "$key = " . $self->{$objtype}->{$key}->{'value'} . " \(" . $self->{$objtype}->{$key}->{'units'} . "\) \n"; } print PARSEFILE "\n\n"; } elsif ($objtype eq 'constant'){ print PARSEFILE "CONSTANTS:\n"; foreach $key (keys %$obj){ print PARSEFILE "$key = " . $self->{$objtype}->{$key}->{'value'} . " \(" . $self->{$objtype}->{$key}->{'units'} . "\) \n"; } print PARSEFILE "\n\n"; } elsif ($objtype eq 'variable'){ print PARSEFILE "AUX VARIABLES:\n"; foreach $key (keys %$obj){ print PARSEFILE "$key = " . $self->{$objtype}->{$key}->{'value'} . " \(" . $self->{$objtype}->{$key}->{'units'} . "\) \n" . "is_lookup= " . $self->{$objtype}->{$key}->{'is_lookup'} . "\n"; } print PARSEFILE "\n\n"; } elsif ($objtype eq 'flow'){ print PARSEFILE "FLOWS:\n"; foreach $key (keys %$obj){ print PARSEFILE "$key = " . $self->{$objtype}->{$key}->{'value'} . " \(" . $self->{$objtype}->{$key}->{'units'} . "\) \n" . "flow_to: " . $self->{$objtype}->{$key}->{'flow_to'} . "\n" . "flow_from: " . $self->{$objtype}->{$key}->{'flow_from'} . "\n" . "is_lookup= " . $self->{$objtype}->{$key}->{'is_lookup'} . "\n"; } print PARSEFILE "\n\n"; } } close(PARSEFILE); } #adds a new variable type to the hashes sub add_stock{ my($self) = shift; my($key) = shift; $self->{'stock'}->{$key} = STOCK->new(); $stock_count += 1; } sub add_flow{ my($self) = shift; my($key) = shift; $self->{'flow'}->{$key} = FLOW->new(); $flow_count += 1; } sub add_constant{ my($self) = shift; my($key) = shift; $self->{'constant'}->{$key} = VENSIM_VARIABLE->new(); $constant_count += 1; } sub add_vensim_variable{ my($self) = shift; my($key) = shift; $self->{'variable'}->{$key} = VENSIM_VARIABLE->new(); $var_count += 1; } #////////////////////////////////////////// #//////////////////////////PARENT CLASS package VENSIM_VARIABLE; sub new{ #constructor my($type) = shift; #pops class name off @_ my($self) = { #stores class data in hash "units" => undef, "value" => undef, "is_lookup" => 0, #bool to see if var is a graph "is_ite" => 0, #bool to see if var is an if-then-else "ites" => [] #array to hold nested if-then-elses }; #$self is a reference to a hash bless($self, $type); #changes type from hash to class name return($self); } #///////////////////////////////////////// #///////////////////////////FLOW CLASS package FLOW; @ISA = (VENSIM_VARIABLE); #inherit methods from parent sub new{ my($type) = shift; my($self) = VENSIM_VARIABLE->new(); #inherit properties from parent $self->{"flow_to"} = "NULL"; $self->{"flow_from"} = "NULL"; bless($self, $type); return($self); } #///////////////////////////////////////// #///////////////////////////STOCK CLASS package STOCK; @ISA = (VENSIM_VARIABLE); sub new{ my($type) = shift; my($initial_value) = shift; #unique property to STOCK my($self) = VENSIM_VARIABLE->new(); $self->{"initial_value"} = undef; bless($self, $type); return($self); } #////////////////////////////////////// package main; #END_DEFINE_CLASSES########################################## ###############################################START_DATA_PARSE $model = new MODEL; #container for all vensim objects #################temp file creation $tmp = "/tmp"; $tmp_num = param("tmp_num"); $tmp_dir = "v2j$tmp_num"; $input_file = "$tmp/$tmp_dir/input.txt"; $output_file = "$tmp/$tmp_dir/inf"; $javac = "/opt/jdk118_v1/bin/javac"; open(OUTFILE, ">$output_file"); #end temp file creation############# open(INFILE, "$input_file") || die "$input_file not found"; @vensim_data = ""; $i=0; while($line = ){ #read input line by line chomp $line; $vensim_data[$i] = $line; $i+=1; } close(INFILE); #@vensim_data stores each line with original spacing/formatting (excluding # the chomped part) #sort through array and format multi-line strings into one line. then, using #different methods, sort the data into the appropriate object. $total_number_of_lines = @vensim_data; for ($i=0; $i<$total_number_of_lines; $i+=1){ $current_line = $vensim_data[$i]; if ($current_line =~ /^\(\d+\)/){ #line starts with: "()" #$current_line format status: original spacing - the only lines that #dont have leading whitespace are ones that start with an object id #with the format "(n)..." where n is the id number $current_line =~ s/^\(\d+\)//; #remove id #so now we know the current line starts with an object name (now that #the id has been removed. the string format currently has a leading space, #an unformated object name (vensim allows all kinds of things). after #another potential space, there's the "=" assignment operator. #the only object type (at least the only one i've seen so far) that #doesnt have an = sign is a named lookup. so check if the line doesnt #have an = sign, and if it doesnt, add one after valid name characters. if ($current_line !~ /\=/){ if ($current_line =~ /^([\w\s]*)/){ $testing = $1; $current_line =~ s/$testing/$testing\=/; } } #split line at the "=" sign to check validity of object name (left hand side) @split_on_equals = split("\=",$current_line); #now split_on_equals contains 2 entries - the first is the unformatted #object name, and the second is the rest of the line $potential_var = shift @split_on_equals; #pops off first element #now test and format the object name: if (!(&is_valid_object_name($potential_var))){ &html_error("$potential_var"); } $potential_var = &format_object_name($potential_var); #now we have a nicely formatted and readable object name. the next #step is to perform similar operations on the equation associated #with this object $current_object_value = shift @split_on_equals; ####EQUATION_BUILDING_START############################# #keep concating following lines, until you reach the line #that starts with 'Units' $current_object_value = &strip_whitespace($current_object_value); $next_line=$vensim_data[$i+=1]; #look at next line #while equation is still being read... while (!($next_line =~ /^\s*Units/)){ $current_object_value = $current_object_value . &strip_whitespace($next_line); $next_line=($vensim_data[$i+=1]); } #remove spaces around operators, but replace them with _ around #object names $current_object_value = &format_value_equation($current_object_value); #################################EQUATION_BUILDING_END### if( &IS_STOCK($current_object_value)){ my $stock_equation = &get_lone_value($current_object_value); my $stock_initial_value = &get_initial_value($current_object_value); my $stock_units = &get_units($next_line); $model->add_stock($potential_var); $model->{'stock'}->{$potential_var}->{'value'} = $stock_equation; $model->{'stock'}->{$potential_var}->{'initial_value'} = $stock_initial_value; $model->{'stock'}->{$potential_var}->{'units'} = $stock_units; } elsif( &IS_CONSTANT($current_object_value)){ my $constant_value = $current_object_value; my $constant_units = &get_units($next_line); $model->add_constant($potential_var); $model->{'constant'}->{$potential_var}->{'value'} = $constant_value; $model->{'constant'}->{$potential_var}->{'units'} = $constant_units; } else{ my $variable_value = $current_object_value; my $variable_units = &get_units($next_line); my $lookup_boolean = 0; #used to see if aux var is a vensim lookup table $model->add_vensim_variable($potential_var); $model->{'variable'}->{$potential_var}->{'value'} = $variable_value; $model->{'variable'}->{$potential_var}->{'units'} = $variable_units; $model->{'variable'}->{$potential_var}->{'is_lookup'} = &IS_LOOKUP($variable_value); $model->{'variable'}->{$potential_var}->{'is_ite'} = &IS_ITE($variable_value); #if a named lookup was found, push its name onto a stack. each aux #var and flow will be checked for instances of this name, which will #mean that those vars/flows are equivalent to a regular lookup. if ($model->{'variable'}->{$potential_var}->{'is_lookup'} == 2){ push @named_lookups, $potential_var; } } } } #after named lookups are found, change the equations to the equivalent #of regular lookups (WITH_LOOKUP) &replace_named_lookups($model, @named_lookups); #search each stock to see what variables it contains and #set those as flows &get_flows($model); #build the outfile based on the parsed data &build_outfile; &html_start; #####################################START_HELPER_FUNCTIONS sub remove_old_temp_files{ my $TIME_ON_SERVER = 1800; #in seconds...1800 sec = 30 min 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 = ){ 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){ #print "\n$filename\n$current_time\n$time_last_modified\n"; &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. $nested_ite_variable_name = shift; my $variable_value = shift; my @tokens; $nested_ite_counter = 0; @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 ($parsed_equations[0] == ""){ shift @parsed_equations; } return @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 @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, ($nested_ite_variable_name . "__" . $nested_ite_counter); $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; @object_names = split(/(\+|\-|\/|\*|\,|\(|\)|\>|\<|\=|\<\=|\>\=)/, $line); my ($fixedline) = ""; foreach (@object_names){ $tempname = &replace_spaces(&strip_whitespace($_)); $fixedline = "$fixedline" . "$tempname$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 $named_lookup (@named_lookups){ foreach $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. $model->{'variable'}->{$variable_name}->{'value'} = "WITH_LOOKUP(($tempvalue),$model->{'variable'}->{$named_lookup}->{'value'})"; $model->{'variable'}->{$variable_name}->{'is_lookup'} = 1; } } delete $model->{'variable'}->{$named_lookup}; #remove the named lookup } } sub FLOW_EXISTS { #checks if the flow is already contained in the #'flow' hash in MODEL my ($key) = shift; my (%flows) = %{%$model->{'flow'}}; foreach $flowname (keys %flows){ if ($flowname eq $key){ return 1; } } 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. my ($self) = shift; my ($flows_in_to, $flows_out_of); my (%stocks) = %{%$self->{'stock'}}; my (%variables) = %{%$self->{'variable'}}; 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) #if flow isnt already in FLOW hash if ($stock_equation =~ /\b$purged_name\b/){ if (!FLOW_EXISTS($variablename)){ $model->add_flow($variablename); $model->{'flow'}->{$variablename}->{'value'} = $variables{$variablename}->{'value'}; $model->{'flow'}->{$variablename}->{'units'} = $variables{$variablename}->{'units'}; #set flag if the flow contains a lookup table $model->{'flow'}->{$variablename}->{'is_lookup'} = &IS_LOOKUP($variables{$variablename}->{'value'}); #set flag if the flow is an if-then-else $model->{'flow'}->{$variablename}->{'is_ite'} = &IS_ITE($variables{$variablename}->{'value'}); delete $model->{'variable'}->{$variablename}; } } #set flow to/from properties based on role in stock equation (+=to -=from) if ($stock_equation =~ /\-\b$purged_name\b/){ $model->{'flow'}->{$variablename}->{'flow_from'} = $stockname } elsif ($stock_equation =~ /\b$purged_name\b/){ $model->{'flow'}->{$variablename}->{'flow_to'} = $stockname } } } } 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;} } ##########END_HELPER_FUNCTIONS############################################### sub build_outfile{ my (%flows) = %{%$model->{'flow'}}; my (%stocks) = %{%$model->{'stock'}}; my (%variables) = %{%$model->{'variable'}}; my (%constants) = %{%$model->{'constant'}}; my ($stock_name, $i); open (OUTFILE, ">>$output_file") || die "couldnt open"; print OUTFILE "TYPE NAME DEFAULT MIN MAX SLIDERSTYLE\n"; $numdisp=0; #stocks... $i = 0; foreach $stock_name (keys %stocks){ print OUTFILE "$stock_name, $i\n"; $slider_option = param("variv$i"); $graph_option = param("vargraph$i"); if ($slider_option ne 'on'){ if ($graph_option ne 'on') {$disp_value = "DISP_FALSE";} else {$disp_value = "DISP_TRUE"; $numdisp++;} $underscored_name = &replace_spaces($stock_name); print OUTFILE "VARFUNC $underscored_name $disp_value\n"; print OUTFILE &is_ifthenelse($stocks{$stock_name}->{'initial_value'}) . "\n"; print OUTFILE "ENDVARFUNC\n"; } else { $slider_default = param("vardef$i"); $slider_min = param("varmin$i"); $slider_max = param("varmax$i"); $slider_style = param("varstyle$i"); #check for valid input if ( ($slider_min eq "") || ($slider_max eq "") || ($slider_default eq "") ){ &html_error("1:stock:$stock_name"); } elsif (!is_digit($slider_min) || !is_digit($slider_max) || !is_digit($slider_default)){ &html_error("1:stock:$stock_name"); } #elsif ($min_value - $max_value == 0.0) { # &html_error("min and max must be different"); } elsif ($slider_default > $slider_max || $slider_default < $slider_min) { &html_error("1:stock:$stock_name"); } #if the user changed the default value #if ($slider_default != $stocks{$stock_name}->{'initial_value'}){ # $def_value = "VARDFUNC" } if ($slider_style eq '1') {$slider_style = "Slider.STYLE_INTEGER";} elsif ($slider_style eq '2') {$slider_style = "Slider.STYLE_LOG";} else {$slider_style = "Slider.STYLE_LINEAR";} if ($graph_option ne 'on') {$disp_value = "DISP_FALSE";} else {$disp_value = "DISP_TRUE"; $numdisp++;} $underscored_name = &replace_spaces($stock_name); print OUTFILE "VAR $underscored_name $slider_default $slider_min " . "$slider_max $slider_style $disp_value \n"; } $i++; } #constants... $i = 0; foreach $constant_name (keys %constants){ if ($constant_name ne "FINAL_TIME" && $constant_name ne "TIME_STEP" && $constant_name ne "INITIAL_TIME"){ $slider_option = param("paramiv$i"); $graph_option = param("paramgraph$i"); if ($slider_option ne 'on'){ if ($graph_option ne 'on') {$disp_value = "DISP_FALSE";} else {$disp_value = "DISP_TRUE"; $numdisp++;} $underscored_name = &replace_spaces($constant_name); print OUTFILE "CONVERTER $underscored_name $disp_value\n"; print OUTFILE &is_ifthenelse($constants{$constant_name}->{'value'}) . "\n"; print OUTFILE "ENDCONVERTER\n"; } else { $slider_default = param("paramdef$i"); $slider_min = param("parammin$i"); $slider_max = param("parammax$i"); $slider_style = param("paramstyle$i"); #check for valid input if ( ($slider_min eq "") || ($slider_max eq "") || ($slider_default eq "") ){ &html_error("1:constant:$constant_name"); } elsif (!is_digit($slider_min) || !is_digit($slider_max) || !is_digit($slider_default)){ print ERR "2"; &html_error("1:constant:$constant_name"); } elsif ($slider_default > $slider_max || $slider_default < $slider_min) { print ERR "3"; &html_error("1:constant:$constant_name"); } if ($slider_style eq '1') {$slider_style = "Slider.STYLE_INTEGER";} elsif ($slider_style eq '2') {$slider_style = "Slider.STYLE_LOG";} else {$slider_style = "Slider.STYLE_LINEAR";} if ($graph_option ne 'on') {$disp_value = "DISP_FALSE";} else {$disp_value = "DISP_TRUE"; $numdisp++;} $underscored_name = &replace_spaces($constant_name); print OUTFILE "RATE $underscored_name $slider_default $slider_min " . "$slider_max $slider_style $disp_value \n"; } $i++; } } #aux vars... $i = 0; foreach $variable_name (keys %variables){ if ($variable_name ne "SAVEPER"){ $slider_option = param("auxiv$i"); $graph_option = param("auxgraph$i"); if ($slider_option ne 'on'){ if ($graph_option ne 'on') {$disp_value = "DISP_FALSE";} else {$disp_value = "DISP_TRUE"; $numdisp++;} $underscored_name = &replace_spaces($variable_name); #if variable is a lookup table if ($variables{$variable_name}->{'is_lookup'} == 1){ print OUTFILE "CONVERTER $underscored_name $disp_value\n"; my $aux_graph_type = param("auxgraphtype$i"); my $graph_var = &parse_lookup($variables{$variable_name}->{'value'}); my $graph_points; my @graph; #format returned is variable:points, so split on : #and assign to appropriate values @graph = split(":", $graph_var); $graph_var = $graph[0]; $graph_points = $graph[1]; #get user-input for graph type if ($aux_graph_type eq '0') { $aux_graph_type = "GRAPH LINE"; } elsif ($aux_graph_type eq '1'){ $aux_graph_type = "GRAPH BOX"; } #print outfile syntax for a graphical function (aka lookup table) print OUTFILE "$aux_graph_type $graph_var $graph_points\n"; } #if variable is a nested if-then-else elsif ($variables{$variable_name}->{'is_ite'} == 1) { my @nested_ites = &parse_ite($variable_name, $variables{$variable_name}->{'value'}); my $ite; my $j = 0; $ite = pop @nested_ites; print OUTFILE "CONVERTER $underscored_name $disp_value\n"; print OUTFILE &is_ifthenelse($ite) . "\n"; foreach $ite (@nested_ites){ print OUTFILE "ENDCONVERTER\n"; print OUTFILE "CONVERTER $underscored_name" . "__" . "$j DISP_FALSE\n"; print OUTFILE &is_ifthenelse($ite) . "\n"; $j++; } } #otherwise... else { print OUTFILE "CONVERTER $underscored_name $disp_value\n"; print OUTFILE &is_ifthenelse($variables{$variable_name}->{'value'}) . "\n"; } print OUTFILE "ENDCONVERTER\n"; } else { $slider_default = param("auxdef$i"); $slider_min = param("auxmin$i"); $slider_max = param("auxmax$i"); $slider_style = param("auxstyle$i"); #check for valid input if ( ($slider_min eq "") || ($slider_max eq "") || ($slider_default eq "") ){ &html_error("1:auxillary variable:$variable_name"); } elsif (!is_digit($slider_min) || !is_digit($slider_max) || !is_digit($slider_default)){ &html_error("1:auxillary variable:$variable_name"); } elsif ($slider_default > $slider_max || $slider_default < $slider_min) { &html_error("1:auxillary variable:$variable_name"); } if ($slider_style eq '1') {$slider_style = "Slider.STYLE_INTEGER";} elsif ($slider_style eq '2') {$slider_style = "Slider.STYLE_LOG";} else {$slider_style = "Slider.STYLE_LINEAR";} if ($graph_option ne 'on') {$disp_value = "DISP_FALSE";} else {$disp_value = "DISP_TRUE"; $numdisp++;} $underscored_name = &replace_spaces($variable_name); print OUTFILE "RATE $underscored_name $slider_default $slider_min " . "$slider_max $slider_style $disp_value \n"; } $i++; } } #flows... $i=0; foreach $flow_name (keys %flows){ my $graph_option = param("flowgraph$i"); if ($graph_option ne 'on') {$disp_value = "DISP_FALSE";} else {$disp_value = "DISP_TRUE"; $numdisp++;} $underscored_name = &replace_spaces($flow_name); print OUTFILE "FLOW $underscored_name $disp_value \n"; print OUTFILE $flows{$flow_name}->{'flow_from'} . " \n"; print OUTFILE $flows{$flow_name}->{'flow_to'} . " \n"; if ($flows{$flow_name}->{'is_lookup'} == 1){ my $flow_graph_type = param("flowgraphtype$i"); my $graph_var = &parse_lookup($flows{$flow_name}->{'value'}); my $graph_points; my @graph; #format returned is variable:points, so split on : #and assign to appropriate values @graph = split(":", $graph_var); $graph_var = $graph[0]; $graph_points = $graph[1]; #get user-input for graph type if ($flow_graph_type eq '0') { $flow_graph_type = "GRAPH LINE"; } elsif ($flow_graph_type eq '1'){ $flow_graph_type = "GRAPH BOX"; } #print outfile syntax for a graphical function (aka lookup table) print OUTFILE " $flow_graph_type($graph_var)$graph_points\n"; print OUTFILE "ENDFLOW \n"; } #if flow value is a nested if-then-else elsif ($flows{$flow_name}->{'is_ite'} == 1) { my @nested_ites = &parse_ite($flow_name, $flows{$flow_name}->{'value'}); my $ite; my $j = 0; $ite = pop @nested_ites; #write flow value with substitutions for nested if-then-elses print OUTFILE " " . &is_ifthenelse($ite) . " \n"; print OUTFILE "ENDFLOW \n"; #write the aux vars that match substitutions in flow equations foreach $ite (@nested_ites){ print OUTFILE "CONVERTER $underscored_name" . "__" . "$j DISP_FALSE\n"; print OUTFILE &is_ifthenelse($ite) . "\n"; print OUTFILE "ENDCONVERTER\n"; $j++; } } #otherwise... else { print OUTFILE " " . &is_ifthenelse($flows{$flow_name}->{'value'}) . " \n"; print OUTFILE "ENDFLOW \n"; } $i++; } #shadow variables... $initial_time = param("inittime"); $final_time = param("finaltime"); $time_step = param("timestep"); print OUTFILE "CONVERTER INITIAL_TIME DISP_FALSE\n$initial_time\nENDCONVERTER\n"; print OUTFILE "CONVERTER FINAL_TIME DISP_FALSE\n$final_time\nENDCONVERTER\n"; print OUTFILE "CONVERTER TIME_STEP DISP_FALSE\n$time_step\nENDCONVERTER\n"; #model options $init_time = param("inittime"); $end_time = param("finaltime"); $time_step = param("timestep"); $ymin = param("ymin"); $ymax = param("ymax"); $title = param("title"); $depLabel = param("depLabel"); print OUTFILE "INITTIME $init_time \n"; print OUTFILE "ENDTIME $end_time \n"; print OUTFILE "TSTEP $time_step \n"; print OUTFILE "YMIN $ymin \n"; print OUTFILE "YMAX $ymax \n"; print OUTFILE "TITLE $title \n"; print OUTFILE "DEPLABEL $depLabel \n"; close (OUTFILE); } sub html_error{ my ($error_string) = shift; my @error_type = split(":", $error_string); print header(-type => 'text/html'); print start_html( -title=>"Vensim2Java - Error", -bgcolor=>"#ffffff"); print h2("
Vensim2Java Error Report
"); if ($error_type[0] == 1){ print table({width=>'60%', align=>'center', cellpadding=>'15', style=>'border:solid;border-collapse:collapse;border-width:2px'}, Tr( td({style=>'background-color:#e5d8b4;'}, "Vensim2Java encountered an error while creating the java applet. The form properties for the $error_type[1]", br, br, "
$error_type[2]
", br, "are invalid. In order to use a slider bar in place of a pre-set value, you must specify the initial, minimum, and maximum values of the slider.If you would like to use the original value for $error_type[2], simply leave the option unchecked.", br,br, "If you cannot find the cause of this error, please visit the bug page for more help, or to submit a bug.") )); } exit; } sub html_start{ print header(-type => 'text/html'); print start_html( -title=>"Vensim2Java - Complete", -bgcolor=>"#ffffff"); `./v2j $output_file $tmp_num >& /dev/null`; $errors = `cd $tmp/$tmp_dir; $javac *.java 2>&1`; if ($errors ne "") { &compile_error(&strip_whitespace($errors)); } `cd $tmp; tar -cvf $tmp_dir.tar $tmp_dir; gzip $tmp_dir.tar`; print h2("
Vensim2Java: View Applet
"); print table({width=>'60%', align=>'center', cellpadding=>'15', style=>'border:solid;border-collapse:collapse;border-width:2px'}, Tr( td({style=>'background-color:#e5d8b4;'}, "Vensim2Java has successfully created an applet based on your Vensim documentation. You can see what your applet looks like in action by checking out the sample page created by Vensim2Java.", br, br, "If you come across any errors or issues, please report it by visiting the bug page. To download the java applet, click on the link below. Please note that these links are not permanent and may be deleted at any time.", br, br, "
Download the Applet", br, "\(\.tar.gz format) "))); } sub compile_error{ my ($error_string) = shift; print start_html( -title=>"Vensim2Java - Error", -bgcolor=>"#ffffff"); print h2("
Vensim2Java Error Report
"); print table({width=>'60%', align=>'center', cellpadding=>'15', style=>'border:solid;border-collapse:collapse;border-width:2px'}, Tr( td({style=>'background-color:#e5d8b4;'}, "Vensim2Java encountered an error while creating the java applet. The java compiler returned with the following errors:", pre(table({align=>'center', cellpadding=>'5', style=>'border:solid;border-collapse:collapse;border-width:1px'}, Tr(td({style=>'background-color:#ece1c4'}, $error_string )))), "Make sure that the equations submitted were copied directly from Vensim and that they are correct.", br, "If you cannot find the cause of this error, please visit the bug page for more help, or to submit a bug.") )); exit; }