#!/usr/bin/perl -w
my ($f, $tags);
#$home="C:/Projects/Visual Basic/Translator";
$home="/mnt/win_c/Projects/Visual Basic/Translator";

# Tags that contain text information
@tag_list = ('Caption', 'Text', 'ToolTipText');
@ignore_list = ('VB.Frame', 'VB.PictureBox', 'VB.Menu');
@enumerate_list = ('Tabs', 'Panels');

%replace_prop = ('ColumnHeader' => 'ColumnHeaders');


#$tags = "Caption|Text|ToolTipText";
$tags = join("|", @tag_list); $tags=~s/\./\\./g;
$ignore = join("|", @ignore_list); $ignore=~s/\./\\./g;
$enumerate_prop = join("|", @enumerate_list); $enumerate_prop =~ s/\./\\./g;


# Object types that need to be ignored in the stack
#$ignore = "VB\.Frame|VB\.PictureBox|VB\.Menu";

# Pairs of elements to replace
#%replace_prop = ('ColumnHeader' => 'ColumnHeaders');

#$enumerate_prop = "Tabs|Panels";
$first_file = "$home/frmLanguage.frm";

$|=1;
#$/ = "\015\012";
@ARGV=($first_file,@ARGV);
$count=0;

foreach $f (@ARGV) {
		
	
	if ($count==0) {
		analyze_file($f,"_language");
	} else {
		analyze_file($f);
	}
	$count++;
}
if (@ARGV) {
	print "[_dynamic_data]\n";
	print "\t# This place is for text contained in the source code.\n";
	print "\t# \$0 to \$9 are special sequences that will be replaced\n";
	print "\t# with text or data\n";

	print "\n";
}

sub analyze_file {
	my ($file, $section_name)=@_;
	my ($version, $line, @object, $obj);
	my (%out, $max_len, $form_name);
	my ($temp, $type, $name, $key);
	
	$max_len=0;
	$line = "";
	
	open FILE, "< $file" || die "Can't open $file";
	$version=<FILE>;

	unless ($version && $version =~ m/VERSION (5.00|6.00)/) {
		warn "$file is not a form file, or it's a wrong version";
		return;
	}
	
	while($line=<FILE>) {
		chomp $line;
		
		($name, $type) = objname($line);
		if ($name) {
			if ($type && $type =~ m/^$ignore$/) {
				# Mark ignored object
				$name="<$name>";
			}			
			push(@types,$type);
			if ($#types > 0 && defined($types[$#types-1]) && $types[$#types-1]=~/^$enumerate_prop$/) {
								
				if ($#counts < $#types) {
					push(@counts,1);
				} else {
					$counts[$#counts]++;
				}
				$name="(".$counts[$#counts].")";
			} else {
				push(@counts,undef);
			}
			
			push(@object, $name);
			$form_name = $name unless $form_name;
			
			$obj = get_object_path(@object);
		} elsif ($line =~ m/^\s*End/) {			
			pop(@object);		
			pop(@types);
			pop(@counts);	
			last unless @object; # Exit when finished with form code			
			$obj = get_object_path(@object);
		} else {
			# Parse 'tag = value'
			$line =~ m/^\s*(.*?)\s*=\s*(.*)$/;
			($tag, $value)=(trim($1),trim($2));
			
			if ($tag && defined($value)) {
				$key = $obj ne "" ? "$obj.$tag" : $tag;
				if ($tag =~ m/^${tags}$/) {
					#warn "\t".$obj;
					
					#if ($obj ne "") {
					#$out{"$obj.$tag"} = $value;
					#} else {
					#	$out{$tag} = $value;
					#}
					
					$out{$key} = $value;
					
					if ($max_len < length($obj.$tag)+1) {
						$max_len = length($obj.$tag)+1;
					}
					
				}

				if ($tag eq "Index") {
					foreach $temp (@tag_list) {
						if ( exists $out{$obj.".$temp"} ) {					
							$out{$obj."($value).$temp"}=$out{$obj.".$temp"};
							delete $out{$obj.".$temp"};
						}
					}
				}
			}
		}
	}	
	close FILE;
	$form_name= $section_name if $section_name;
	
	print "[$form_name]\n";
	foreach $tag (sort keys(%out)) {
		print "\t$tag" . " " x ($max_len-length($tag)) . " = " . $out{$tag} . "\n";
	}

	print "\n";
	
}

sub objname {
	# Analyzes a Begin/BeginProperty and returns
	# the name of the object it refers to
	
	my ($line)=@_;
	my ($type, $name);
	my ($key);
	
	$type="";
	if ($line =~ m/Begin\s(.*?)\s(.*?)$/) 
	{
		($type, $name) = (trim($1),trim($2));
	} elsif ($line =~ m/BeginProperty\s(.*?)\s.*?$/ ){						
		$name=trim($1);
		foreach $key (keys(%replace_prop)) {
			$name=~s/^$key/$replace_prop{$key}/;
		}
		$type=$name;
	} else {
		return (undef,undef);
	}
		
	return ($name, $type);
}

sub trim {
	my ($p)=@_;
	for ($p) {	
		s/^\s+//;		
		s/\s+$//;		
	}
	
	return $p;
}

sub get_object_path {
	# Joins stack entries removing ignored items
	# This won't remove the ignored item if it's the
	# last one on the stack. For example:
	#
	# frmMain.Frame1.Label.Caption = "Hello"
	# 
	# is changed into 'Label1.Caption = "Hello"', but:
	#
	# frmMain.Frame1.Caption = "World"
	#
	# is changed into 'Frame1.Caption = "World"'
	
	my (@stack)=@_;
	my ($ret, $elem, $count, $not_first);
	
	$ret="";
	$count=0;
	foreach $elem (@stack) {
		if ($elem =~ /^<.*>$/) {
			if ($count != $#stack) {
				$elem="" 
			} else {
				$elem=~s/>//g;
				$elem=~s/<//g;	
			}
		}
		
		if ($count && $elem) {			
			$ret.="." if $not_first;
			$ret.=$elem;
			$not_first=1;
		}
		
		$count++;
	}
	
	#$ret=~s/\.\((.*?)\)\./\(\1\)\./g;
	$ret=~s/\.\(/\(/g;
	return trim($ret);
	
}


#sub get_filename {
#	my ($name)=@_;
#	return $1 if ($name =~ m/.*?\/([^\/]*)$/);
#	return $name;
#}
