#Simple Invocation, the database exists:
txt2mdb.wsf XXSUM.XDS c:\temp\xxum.mdb "EK"  c:\satnt\xxsum.e

#simply the same:
txt2mdb.wsf XXSUM c:\temp\xxum.mdb EK c:\satnt\xxsum.e

#Create the Database from an empty one <recordSpec>.mdb:
txt2mdb.wsf XXSUM new:c:\temp\xxum.mdb EK c:\satnt\xxsum.e

#if the name of the empty database differs from the recordSpec:
txt2mdb.wsf OLAP_1 neu:OLAP:c:\temp\xxum.mdb O1 c:\satnt\olap.txt

##</code><code>##

 Input-File:
 -------------
 730112200;12345;XXX;F999087
 
 recordSpec:
 -----------------
 <?xml version="1.0" encoding="ISO-8859-1"?>
 <record kind="csv" separator=";">
 	<ignore regex="(^$|^[ \t]+$|^[ \t]*#)/" />
 	<field name="ANR"  > $_ =~ s/00$//; </Field>
 	<field name="VKNR"   />
 	<filler              >
 	<field name="fbpos"  />
</datensatz>

##</code><code>##

 Inputfile:
 -------------
 #Arztnr;VKNR;fbpos
 730112200---01234----F999087
 
 recordSpec:
 -----------------
 
 <?xml version="1.0" encoding="ISO-8859-1"?>
 <record kind="csv" separator=";">
 	<ignore regex="(^$|^[ \t]+$|^[ \t]*#)/" />
 	<field name="Arztnr" pack="A7" />
 	<filler              pack="X5" />
 	<field name="VKNR"   pack="A5" />
 	<filler              pack="X4" />
 	<field name="fbpos"  pack="A7" />
</datensatz>

##</code><code>##

 Inputfile:
 -------------
 ...
 ...
 Arzt: 73011220
 ...

 ...

 K 012345\tF999087
 ...
 
 
 recordSpec:
 -----------------
 
<?xml version="1.0" encoding="ISO-8859-1"?>
<record kind="special">
	<special>
	<![CDATA[

		# remember Arztnr
		if ( /^Arzt: ([0-9]{7})/ )
		{
      $satz{"ArztNr"}=$1;
    }

		# record is fully read
		if ( /^K ([0-9]{5})\t([A-Z][0-9]{6})/ )
		{
			# remember VKNR and fbpos 
			$satz{"VKNR"}  = $1;
			$satz{"fbpos"} = $2;

			# write record
			&update();
			
			# Important!: reset data for next record
			%record=();
		}
	]]>
	</special>
</record>

##</code><code>##

<job id="PERLandVBS">

	<script language="VBScript">

		dim Fields()
		dim Constants()
		dim Constants_init
		dim Constants_values()
		dim jet
		dim db
		dim rs
		
		function openDatabase (Database, Table)
				on error resume next

				set jet = CreateObject ("DAO.DBEngine.36")
				if Err.Description <> "" then openDatabase = Err.Description: exit function
				
				
				set db  = jet.OpenDatabase(Database)
				if Err.Description <> "" then openDatabase = Err.Description: exit function

				set rs  = db.OpenRecordset(Table)
				if Err.Description <> "" then openDatabase = Err.Description: exit function
				
				openDatabase = 1
		end function
		
		function closeDatabase ()
				on error resume next
				
				rs.Close
				if Err.Description <> "" then closeDatabase = Err.Description: exit function
				
				db.Close
				if Err.Description <> "" then closeDatabase = Err.Description: exit function
				
				closeDatabase = 1
		end function


		sub rememberFields (Names)
			
			redim preserve Fields(Ubound(Names))
			
			for i=0 to Ubound(Names)
				Fields(i) = Names(i)
			next
		
		end sub		

		sub rememberConstant (name, wert)

			'WScript.Echo ("rememberConstant " & name & " -> " & wert)
			'
			
			if ( Constants_init ) then
				redim preserve Constants(Ubound(Constants))
				redim preserve Constants_values(Ubound(Constants))
			else
				redim Constants (0)
				redim Constants_values(0)
				Constants_init = 1
			end if
			
			Constants(Ubound(Constants)) = name
			Constants_values(Ubound(Constants)) = wert
		
		end sub		
	
		
		function importFields (values)
			on error resume next
			dim i
			
			rs.AddNew
			if Err.Description <> "" then importFields = Err.Description: exit function
			
			dim Fieldname
			
			for i=0 to UBound(values)
				
				Fieldname = Fields(i)
				
				if values(i) <> "" then
					rs.fields(Fieldname).value = values(i)
					if Err.Description <> "" then importFields = Err.Description & " (" & Fields(i) & ": " & values(i) & ")" : exit function
				end if
			
			next
			
			if Constants_init then
				for i=0 to UBound(Constants)
					if Constants(i) <> "" then
						rs.fields(Constants(i)).value = Constants_values(i)
						if Err.Description <> "" then importFields = Err.Description & " (" & Fields(i) & ": " & values(i) & ")" : exit function
					end if

				next
			end if
			
			rs.Update
			if Err.Description <> "" then importFields = Err.Description: exit function
			
			importFields = 1
			
		end function
		
	</script>
   
	<script language="PerlScript">
		use strict;

		use XML::Parser;
		use Unicode::String qw ( utf8 );
		use Data::Dumper;
		
		DESTROY {}
		
		our $VERSION = '0.3';
		
		wshprint ("TXT2DB Version $VERSION\n");

		use Win32::API;
		use File::Copy;
		
		Win32::API->Import( "winmm.dll", "LONG timeGetTime()" );
		
		my @PATH;
		for ( keys %ENV )
		{
			if ( /^path$/i )
			{
				@PATH = split ";", $ENV{$_};
				last;
			}
		}
		
		wshdie 
		(
			"Too less arguments:\n" .
			"invocation: cscript.exe txt2db.wsf <recordSpec> <[new[:template]:]Database> <Table> <file1..n>\n"
		) if $main::WScript->Arguments->Count < 3;
		
		my $recordSpec = $main::WScript->Arguments(0);
		wshdie ("No recordSpec specified!\n") unless defined $recordSpec;
		my $frecordSpec = findxds ( $recordSpec );
		
		my $Database        = $main::WScript->Arguments(1);
		wshdie ("No Database specified!\n") unless defined $Database;
		$Database = finddb ( $Database );
		
		my $Table          = $main::WScript->Arguments(2);
		wshdie ("No Table specified!\n") unless defined $Table;
		
		my @files;
		my $packstr;

		for (my $i=3; $i<$main::WScript->Arguments->Count;$i++)
		{
			 push @files, $main::WScript->Arguments($i);
		}
		
		wshdie ("No files specified for import !\n") unless @files;
		
		my $kind;
		my $separator;
		my @Fields;
		my @Constants;
		my @ignore;
		my $ret;
		my $lines_file  = 0;
		my $records_file  = 0;
		my $saetze_gesamt = 0;
		my $specialcode = "";
		my %satz;
		my $firstupdate = 1; 
		
		my $startzeit;
		my $laufzeit;
		my $timeLeft;
		my $pzeit;
		
		my $bytes_gesamt = 0;
		my $bytes_gelesen = 0;

		&event ("read recordSpec");
		read_recordSpec();
	

		for my $k ( @Constants ) 
		{
			my @dup = grep { (not defined $_->{'filler'}) && ($_->{'name'} eq $k->{'name'}) } @Fields;
			
			if ( scalar @dup > 0 )
			{
				wshdie ("Constant '$k->{'name'}' already declared as Field!\n");
			}
			
			&rememberConstant ($k->{name}, $k->{wert});
		}		
		
		if ( $specialcode )
		{
			$specialcode .= "\n}";
			eval $specialcode;
		}
		
		wshdie ("Error compiling <special>-code: $@") if $@;
		
		&event ("open Database <$Database>, Table: <$Table>");
		$ret = openDatabase($Database, $Table);
		wshdie ("Error opening Database: $ret\n") unless $ret == 1;
		
		rememberFields ( [ map { $_->{name} } grep { not defined $_->{'filler'} } @Fields ] ); 
				
		&event ("starting Import...");
		$startzeit = timeGetTime() / 1000;
		
		import();

		&event ("close Database");		
		$ret = closeDatabase();
		wshdie ("Error closing the Database: $ret\n") unless $ret == 1;
		
		&event ("end Import");		

		sub read_recordSpec
		{
			my $parser = new XML::Parser (Style=>'Subs',Handlers => {Char=>\&code});

			$parser->parsefile ($frecordSpec);

			if ( $kind eq "fix" )
			{
				wshdie ("Error reading recordSpec: specified \"separator\" along with kind=\"fix\"!\n")
					if $separator;
				wshdie ("Error reading recordSpec: No fields specified!\n") unless @Fields;
			}
			elsif ( $kind eq "csv" )
			{
				wshdie ("Error reading recordSpec: No \"separator\" specified!\n")
					unless $separator;
				wshdie ("Error reading recordSpec: no Fields specified!\n") unless @Fields;
			}
			elsif ( $kind eq "special" )
			{
			}			
			else
			{
				wshdie ("Error reading recordSpec: Unknown value for für \"kind\"!\n");
				
			}
		}

		sub field
		{
			my $expat = shift;
			my $Field = utf8(shift)->latin1;
			my %attribute = map { utf8($_)->latin1 } @_;

			wshdie ("Error reading recordSpec: No fieldname specified!\n") unless defined $attribute{'name'};

			if ( $kind eq "fix" )
			{
				wshdie ("Error reading recordSpec: No Attribute \"pack\" specified ($attribute{'name'})!\n") unless defined $attribute{'pack'};
			}

			$packstr.= $attribute{'pack'};
			
			push @Fields, \%attribute;
		}
		
		sub filler
		{
			my $expat = shift;
			my $Field = utf8(shift)->latin1;
			my %attribute = map { utf8($_)->latin1 } @_;

			if ( $kind eq "fix" )
			{
				wshdie ("Error reading recordSpec: No Attribute \"pack\" specified ($attribute{'name'})!\n") unless defined $attribute{'pack'};
				$packstr.= $attribute{'pack'};
			}
			
			if ( $kind eq "csv" )
			{
				push @Fields, { filler => 1 };
			}

		}

		sub record
		{
			my $expat = shift;
			my $Field = utf8(shift)->latin1;
			my %attribute = map { utf8($_)->latin1 } @_;

			$kind     = lc($attribute{kind})         if defined $attribute{kind};
			$separator = qr/$attribute{separator}/ if defined $attribute{separator};
		}

		sub ignore
		{
			my $expat = shift;
			my $Field = utf8(shift)->latin1;
			my %attribute = map { utf8($_)->latin1 } @_;

			my $re = qr/$attribute{regex}/;
			push @ignore, $re;
		}

		sub code
		{
			my $expat = shift;
			my $text = utf8(shift)->latin1;
			
			return if $text =~ /^$/;
			return if $text =~ /^[ \t\n]+$/ms;
			
			my @context = $expat->context;
			
			if ( $context[-1] =~ /^special$/i )
			{
				&specialc ($text);
			}
			else
			{
				$Fields[-1]->{code} .= $text;
			}
		}
		
		
		sub specialc
		{
			my $text = shift;
			
			$specialcode = "\$specialcode = sub { \$_ = \$_[0]; " unless $specialcode;
			$specialcode .= "$text";
		}
		
		sub constant
		{
			my $expat = shift;
			shift;
			my %attribute = map { utf8($_)->latin1 } @_;
			
			wshdie ("Error reading recordSpec: No Attribute \"name\" specified!\n") unless defined $attribute{'name'};
			wshdie ("Error reading recordSpec: No Attribute \"value\" specified ($attribute{'name'})!\n") unless defined $attribute{'wert'};
			
			my $ts = $main::WScript->StdIn;
			
			if ( $attribute{'wert'} =~ /!([^!]+)!$/ )
			{
				my $a = "";
				while ( $a eq "" )
				{
					wshprint ("Enter constant value ($attribute{'name'}):");
					$a = $ts->ReadLine();
					chomp $a;
					
					if ( $attribute{"match"} )
					{
						$a = "" unless $a =~ m/$attribute{"match"}/;
					}
				}
				
				$attribute{'wert'} = $a;
			}
			
			push @Constants, \%attribute;
		}

		sub import
		{
			$saetze_gesamt = 0;
			
			for my $Field ( @Fields )
			{
				if  ( $Field->{'code'} )
				{
					my $code = "\$Field->{'code'}=sub { \$_=\$_[0]; $Field->{code}; return \$_; }";
					eval $code;
					wshdie ("Error reading recordSpec: Error in Usercode: $@\n") if $@;
				}
			}
			
			for ( @files )
			{
				for ( glob ($_) )
				{
					$bytes_gesamt += (stat $_)[7];
				}
			}			

			for ( @files )
			{
				$records_file = 0;
				$lines_file = 0;
				
				for ( glob ($_) )
				{
					import_file ($_);
				}
			}
		}

		my $i;
		
		sub import_file
		{
			my $file = shift;
			$pzeit = timeGetTime()/1000;
			
			%satz = ();
			
			&event ("open file <$file>");
			
			open IN, $file or wshdie ("Import-Error: Cannot open <$file>!\n");

			while ( my $line = <IN> )
			{
				$lines_file++;
				

				$bytes_gelesen += length($line);
				
				chomp ($line);
				
				my $no = 0;
				
				for ( @ignore )
				{
					$no = 1, next if $line =~ $_;
				}

			
				next if $no;
				
				
				
				my @f;

				if ( $kind eq "fest" )
				{
					$records_file++;
					$saetze_gesamt++;
					
					eval
					{
						@f = unpack ($packstr, $line);
					};
					
					wshdie ("Error using unpack: $@") if $@;
				}
				elsif ( $kind eq "special" )
				{
					chomp $line;
					my $s = &$specialcode ($line) || 0;
					$records_file+=$s;
					$saetze_gesamt+=$s;
				}
				else
				{
					$records_file++;
					$saetze_gesamt++;
				
					@f = split ($separator, $line);
				}

				if ( timeGetTime() / 1000 > int($pzeit) + 5 )
				{
						
					$laufzeit = (timeGetTime() / 1000) - $startzeit;
					$timeLeft = (($bytes_gesamt/$bytes_gelesen) * $laufzeit) - $laufzeit;
					&event ( sprintf ("%.2f", ($bytes_gelesen/$bytes_gesamt) * 100), "% imported, (", ft (int($timeLeft)), " minutes left).");
					$pzeit = timeGetTime()/1000;
				}
				
				next if $kind eq "special";

				my $j = 0;

				for my $Field ( @Fields )
				{
					my $sub = $Field->{'code'};
					$f[$j] = &$sub ($f[$j]) if $sub;
					
					if ( defined $Field->{filler} )
					{
						$f[$j] = undef;
					}
					
					$j++;
					
				}
				
				my $r = importFields ([grep { defined $_ } @f]);
				wshdie ("Error writing record: $r in line $lines_file\n") unless $r == 1;

			}
			
			&event ("close file <$file>, $records_file records imported.");
			
			close IN;
		}
		
		
		
		sub update
		{
			my @f;
		
			if ( $firstupdate )
			{
				$firstupdate = 0;
				my $f = [ sort keys %satz ];
				
				rememberFields ($f);
			}
			
			
			for ( sort keys %satz )
			{
				push @f, $satz{$_};
			}
			
			my $r = importFields (\@f);
			wshdie ("Error writing record: $r in line $lines_file\n") unless $r == 1;
			
		}
		
		sub status
		{
			my $laufzeit;
			my $percent;
			

			return (timeLeft => $timeLeft, percent => $percent);
		}
	
		sub findxds
		{
			my $recordSpec = shift;
			$recordSpec =~ s/\.xds$//i;

			my $e = "";

			for ( "./", @PATH)
			{
				$e = "$_/xds/$recordSpec.xds" if -f "$_/xds/$recordSpec.xds" && -e "$_/xds/$recordSpec.xds";
			}

			wshdie ("recordSpec '$recordSpec' not found!\n") unless $e ;

			return $e;

		}
		
		sub finddb
		{
			my $Database = shift;
			my $sb;
			my $e;
			
			if ( $Database =~ /^new:([^:]+:)?(.+)$/ )
			{
				if ( $1 )
				{
					
					$sb = $1;
					$Database = $2;
					$sb =~ s/:$//;
				}
				else
				{
					
					$sb = $recordSpec;
					$Database = $2;
				}
				
				for ( "./", @PATH)
				{
					if ( -f "$_/mdb/$sb.mdb" && -e "$_/mdb/$sb.mdb" )
					{
						if ( -e "$Database" )
						{
							wshdie ("Database \"$Database\" existiert bereits!\n");
						}
						else
						{
							copy "$_/mdb/$sb.mdb", "$Database";
							last;
						}
					}
				}
			}

			wshdie ("Database '$Database' not found!\n") unless -e $Database;

			return $Database;

		}		

		sub wshdie
		{
			my $message = join "", @_;
			
			unless ( $message =~ /\n$/ms )
			{
				my @caller = caller;
				$message .= " in Module $caller[0] line $caller[2]!";
			}
			
			wshprint ($message);
			$main::WScript->Quit (-1);
			exit;
		}
		
		sub wshprint
		{
			$main::WScript->Echo ( join ("", @_) );
		}
		
		sub ft
		{
			my $t = $_[0];
			my $m = int($t / 60);
			my $s = $t-($m*60);
			return sprintf("%2d", $m) . ":" . sprintf("%2d", $s);
		}
		
		sub event
		{
			my @t = localtime;
			wshprint (sprintf("%02d", $t[2]) .  ":" . sprintf("%02d", $t[1]) . ":" . sprintf("%02d", $t[0]) . " ". join ("", @_) );
		}