#!/usr/bin/perl

#!/usr/bin/perl

############################################################################
###   May be used or extended under the LGPL license                     ###
############################################################################
###   Copyright(c) Fred P. 1998-2003 - All rights reserved.              ###
############################################################################
###   Version 1.0 - Fred - Build 25 sep 2003                             ###
############################################################################
###                                                                      ###
###   DFM2XML : Transform DFM/FRM form files to XML format (XFORM-like)  ###
###                                                                      ###
############################################################################
# http://search.cpan.org/author/GRANTM/XML-Simple-2.09/lib/XML/Simple.pm#OPTIONS
############################################################################

use Data::Dumper;
use XML::Simple; # qw(:strict);
use XML::Ximple;

use strict;

############################################################################
### Global variables definitions                                         ###
############################################################################

use vars qw/
  $infile
  %xml
  $lang
/;

############################################################################
#  http://search.cpan.org/author/JHI/perl-5.8.0/ext/Data/Dumper/Dumper.pm  #
############################################################################
$Data::Dumper::Terse    = 1;
$Data::Dumper::Deepcopy = 1;
#$Data::Dumper::Sortkeys = 1;

sub readFile()
{
  open( IN, "$infile");
  my $lang  = '';
  my $form  = 'jgui:form';
  my $block = $form;
  my $name  = '';
  my $value = '';

  # Get Header
  while( defined( $_ = <IN>) )
  {
    if ( /Begin\s+VB\.Form\s+(\w+)/i ) { $lang = 'VB5';  $xml{ $form  }{ 'name' } = $1; last; }
    if ( /object\s+(\w+):\s+(\w+)/i  ) { $lang = 'BCB5'; $xml{ $form  }{ 'name' } = $1; last; }
  }

  if ( $lang eq 'VB5' ) 
  {
    while( defined( $_ = <IN>) )
    {
      if ( $name && $value ) 
      {
        if ( $block eq $form ) 
        {
          $xml{ $form }{ $name } = $value;
        }
        else
        {
          $xml{ $form }{ $block }{ $name } = $value;
        }
      }

      if ( /Begin\s+VB\.(\w+)\s+(\w+)/i ) 
      { 
        $value = $1;
        $name  = $2;

        $block = lc( $1 );
        $block = 'jgui:'.$block;

        $xml{ $form }{ $block }{ 'type' } = $1; 
        $xml{ $form }{ $block }{ 'name' } = $2; 
        $name  = '';
        $value = '';
        next; 
      }

      if ( /End/i ) 
      { 
        return if ( $block eq $form  );
        $block = $form ; 
        next;
      }

      if ( /Caption\s*=\s*\"?([\'\w\. ]+)\"?/i      ) { $name = 'caption'; $value = $1; next; }
      if ( /ClientHeight\s*=\s*\"?([\'\w\. ]+)\"?/i ) { $name = 'height' ; $value = $1; next; }
      if ( /ClientLeft\s*=\s*\"?([\'\w\. ]+)\"?/i   ) { $name = 'x'      ; $value = $1; next; }
      if ( /ClientTop\s*=\s*\"?([\'\w\. ]+)\"?/i    ) { $name = 'y'      ; $value = $1; next; }
      if ( /ClientWidth\s*=\s*\"?([\'\w\. ]+)\"?/i  ) { $name = 'width'  ; $value = $1; next; }

      if ( /Height\s*=\s*\"?([\'\w\. ]+)\"?/i       ) { $name = 'height' ; $value = $1; next; }
      if ( /Left\s*=\s*\"?([\'\w\. ]+)\"?/i         ) { $name = 'x'      ; $value = $1; next; }
      if ( /Top\s*=\s*\"?([\'\w\. ]+)\"?/i          ) { $name = 'y'      ; $value = $1; next; }
      if ( /Width\s*=\s*\"?([\'\w\. ]+)\"?/i        ) { $name = 'width'  ; $value = $1; next; }
      if ( /TabIndex\s*=\s*\"?([\'\w\. ]+)\"?/i     ) { $name = 'tab'    ; $value = $1; next; }
    }
  }
  elsif( $lang eq 'BCB5' ) 
  {
    while( defined( $_ = <IN>) )
    {
      if ( $name && $value ) 
      {
        if ( $block eq $form ) 
        {
          $xml{ $form }{ $name } = $value;
        }
        else
        {
          $xml{ $form }{ $block }{ $name } = $value;
        }
      }

      if ( /object\s+(\w+):\s+(\w+)/i )
      { 
        $value = $2;
        $name  = $1;
        $block = lc( $2 );
        $block =~ /.(.*)/;
        $block = 'jgui:'.$1;

        $xml{ $form }{ $block }{ 'type' } = $value; 
        $xml{ $form }{ $block }{ 'name' } = $name; 
        $name  = '';
        $value = '';
        next; 
      }

      if ( /End/i ) 
      { 
        return if ( $block eq $form  );
        $block = $form ; 
      }
      
      if ( /Caption\s*=\s*\'?([\w\. ]+)\'?/i          ) { $name = 'caption'       ; $value = $1; next; }
      if ( /Text\s*=\s*\'?([\w\. ]+)\'?/i             ) { $name = 'caption'       ; $value = $1; next; }
      if ( /Height\s*=\s*\'?([\w\. ]+)\'?/i           ) { $name = 'height'        ; $value = $1; next; }
      if ( /Left\s*=\s*\'?([\w\. ]+)\'?/i             ) { $name = 'x'             ; $value = $1; next; }
      if ( /Top\s*=\s*\'?([\w\. ]+)\'?/i              ) { $name = 'y'             ; $value = $1; next; }
      if ( /Width\s*=\s*\'?([\w\. ]+)\'?/i            ) { $name = 'width'         ; $value = $1; next; }
      if ( /TabOrder\s*=\s*\'?([\w\. ]+)\'?/i         ) { $name = 'tab'           ; $value = $1; next; }
      if ( /ItemHeight\s*=\s*\'?([\w\. ]+)\'?/i       ) { $name = 'itemHeight'    ; $value = $1; next; }
      if ( /PageSize\s*=\s*\'?([\w\. ]+)\'?/i         ) { $name = 'pageSize'      ; $value = $1; next; }
      if ( /Color\s*=\s*\'?([\w\. ]+)\'?/i            ) { $name = 'color'         ; $value = $1; next; }
      if ( /Menu\s*=\s*\'?([\w\. ]+)\'?/i             ) { $name = 'menu'          ; $value = $1; next; }
      if ( /Font\.(\w+)\s*=\s*\'?([\[\]\w\. ]+)\'?/i  ) { $name = 'font'.     $1  ; $value = $2; next; }
      if ( /OldCreateOrder\s*=\s*\'?([\w\. ]+)\'?/i   ) { $name = 'oldCreateOrder'; $value = $1; next; }
      if ( /PixelsPerInch\s*=\s*\'?([\w\. ]+)\'?/i    ) { $name = 'pixelsPerInch' ; $value = $1; next; }
      if ( /(\w+)\s*=\s*(\S+\. ]+)/i                  ) { $name = 'unknown'.  $1  ; $value = $2; next; }
    }
  }
  else
  {
    die print "\nUnknown file format. Supply VB5 or C++ Builder 5.5 form definition files.\n\n";
  }
  close( IN );
}

sub main
{
  $infile = $_[0];
  readFile();

  print Dumper \%xml;



  my $xs = new XML::Simple( RootName => 'g', KeepRoot => 1 );
  my $xml_out = $xs->XMLout(\%xml );# [, <options>]);

     $xml_out =~ s/<\/?opt>//g;

  print $xml_out;

}

############################################################################
### Script entry point                                                   ###
############################################################################
main( $ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3] );
exit;

1;
__END__