Test for file instruction for DATA entries.

diff --git a/install_cpan_INSTALL_PREPARE_PROJECT_SETUP_FIRST.sh b/install_cpan_INSTALL_PREPARE_PROJECT_SETUP_FIRST.sh
index cea84a0b76d513d3127cb63c2c219d97db6713f4..4fdf9070ef90dbfb0ba95719d8acb2a9505df1db 100755 (executable)
--- a/install_cpan_INSTALL_PREPARE_PROJECT_SETUP_FIRST.sh
+++ b/install_cpan_INSTALL_PREPARE_PROJECT_SETUP_FIRST.sh
@@ -23,6 +23,7 @@ sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(LWP)'
 sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(Text::Levenshtein::XS)'
 sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(Term::Term:)'
 sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(Term::ReadKey)'
+sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(Term::Screen)'
 sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(Exception::Class)'
 sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(Syntax::Keyword::Try)'
 sudo perl -MCPAN -Mlocal::lib -e 'CPAN::install(JSON::XS)'

diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm
index 3efc03e90142f02f82a2e09ec2bd69897aa96fa8..e181bec0ed3d401f9b38a430439e4fb796eed5de 100644 (file)
--- a/system/modules/CNFParser.pm
+++ b/system/modules/CNFParser.pm
@@ -610,6 +610,8 @@ sub doLoadDataFile { my ($self,$e,$v)=@_;
         $v=~s/\s+//g;
         if(! -e $v){
             $path = substr($path, 0, rindex($cnf_file,'/')) .'/'.$v;
+        }else{
+            $path = $v;
         }
         foreach(@files){
             return if $_ eq $path
@@ -624,24 +626,28 @@ sub loadDataFile {  my ($self,$e,$path,$v,$i)=@_;
             read $fh, my $content, -s $fh;
         close   $fh;
         #
-        push @files, $path;
+        push @files, $path;        
         my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs);
-        foreach my $tag (@tags){
-            next if not $tag;
-            my @kv = split /</,$tag;
-            $e = $kv[0];
-            $tag = $kv[1];
-            $i = index $tag, "\n";
-            if($i==-1){
-                $tag = $v = substr $tag, 0, (rindex $tag, ">>");
-            }
-            else{
-                $v = substr $tag, $i+1, (rindex $tag, ">>")-($i+1);
-                $tag = substr $tag, 0, $i;
-            }
-            if($tag eq 'DATA'){
-                $self->doDATAInstructions_($e,$v)
-            }
+        if(@tags>0){
+                    foreach my $tag (@tags){
+                        next if not $tag;
+                        my @kv = split /</,$tag;
+                        $e = $kv[0];
+                        $tag = $kv[1];
+                        $i = index $tag, "\n";
+                        if($i==-1){
+                            $tag = $v = substr $tag, 0, (rindex $tag, ">>");
+                        }
+                        else{
+                            $v = substr $tag, $i+1, (rindex $tag, ">>")-($i+1);
+                            $tag = substr $tag, 0, $i;
+                        }
+                        if($tag eq 'DATA'){
+                           $self->doDATAInstructions_($e,$v)
+                        }
+                    }
+        }else{
+            $self->doDATAInstructions_($e,$content)
         }
 }
 ##
@@ -753,8 +759,8 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
 
     if(not $content){
         open(my $fh, "<:perlio", $cnf_file )  or  die "Can't open $cnf_file -> $!";
-        read $fh, $content, -s $fh;
-        close $fh;
+           read $fh, $content, -s $fh;
+        close   $fh;
         my @stat = stat($cnf_file);
         $self->{CNF_STAT}    = \@stat;
         $self->{CNF_CONTENT} = $CUR_SCRIPT = $cnf_file;
@@ -777,7 +783,7 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
     }
     $self->{CNF_VERSION} = $CNF_VER;
 
-    my $spc =   $content =~ /\n/ ? '(<{2,3}?)(<*.*?>*)(>{2,3})' : '(<{2,3}?)(<*.*?>*?)(>{2,3})$';
+    my $spc =   $content =~ /\n/ ? '(<{2,3}?)(<*.*?>*)(>{2,3})' : '\s*(<{2,3}?)(<*.*?>*?)(>{2,3})\s*$';
     @tags   =  ($content =~ m/$spc/gms);
 
     foreach my $tag (@tags){

diff --git a/tests/test_DATA_FILE_Instruction.cnf b/tests/test_DATA_FILE_Instruction.cnf
new file mode 100644 (file)
index 0000000..8589fc7
--- /dev/null
+++ b/tests/test_DATA_FILE_Instruction.cnf
@@ -0,0 +1,3 @@
+__HAS_HEADER__
+ID`name~
+01`test~

diff --git a/tests/test_DATA_FILE_Instruction.pl b/tests/test_DATA_FILE_Instruction.pl
new file mode 100644 (file)
index 0000000..96f8457
--- /dev/null
+++ b/tests/test_DATA_FILE_Instruction.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+use lib "tests";
+use lib "system/modules";
+
+require TestManager;
+require CNFParser;
+
+use Syntax::Keyword::Try;
+
+my $test = TestManager->new($0);
+my $cnf;
+
+try {
+    ###
+    # Test instance creation.
+    ###
+    die $test->failed() if not $cnf = CNFParser->new();
+    $test->case("Passed new instance CNFParser.");
+    #
+    $test->nextCase();
+    #
+    $test->case("Test FILE instruction loading the data.");
+    my $file = $0;
+    $file =~ s/\.pl$/.cnf/g;
+    $cnf->parse( undef, qq( << TEST <FILE> $file >> ) );
+    my $test_data = $cnf->data()->{TEST};
+    $test->isDefined( "\$test_data", $test_data );
+    my $ptr = $$test_data->{data};
+    $test->evaluate( "\@data size is one record?", 1, scalar(@$ptr) );
+    my @data = @$ptr;
+    $test->evaluate( "\@data[0][0] is 01?",     '01',     $data[0][0] );
+    $test->evaluate( "\@data[0][1] is 'test'?", 'test', $data[0][1] );
+    ###
+    #
+    $test->done();
+    #
+}
+catch {
+    $test->dumpTermination($@);
+    $test->doneFailed();
+}
+
+#
+#  TESTING THE FOLLOWING IS FROM HERE  #
+#