language/data-io/data-reader.at

dnl PSPP - a program for statistical analysis.
dnl Copyright (C) 2017 Free Software Foundation, Inc.
dnl
dnl This program is free software: you can redistribute it and/or modify
dnl it under the terms of the GNU General Public License as published by
dnl the Free Software Foundation, either version 3 of the License, or
dnl (at your option) any later version.
dnl
dnl This program is distributed in the hope that it will be useful,
dnl but WITHOUT ANY WARRANTY; without even the implied warranty of
dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
dnl GNU General Public License for more details.
dnl
dnl You should have received a copy of the GNU General Public License
dnl along with this program.  If not, see <http://www.gnu.org/licenses/>.
dnl
AT_BANNER([BEGIN DATA])

# BEGIN DATA can run as a command in itself, or it can appear as part
# of the first procedure.  First, test it after a procedure.
AT_SETUP([BEGIN DATA as part of a procedure])
AT_DATA([begin-data.sps], [dnl
TITLE 'Test BEGIN DATA ... END DATA'.

DATA LIST /a b 1-2.
LIST.
BEGIN DATA.
12
34
56
78
90
END DATA.
])
AT_CHECK([pspp -O format=csv begin-data.sps], [0], [dnl
Table: Reading 1 record from INLINE.
Variable,Record,Columns,Format
a,1,1-  1,F1.0
b,1,2-  2,F1.0

Table: Data List
a,b
1,2
3,4
5,6
7,8
9,0
])
AT_CLEANUP

# Also test BEGIN DATA as an independent command.
AT_SETUP([BEGIN DATA as an independent command])
AT_DATA([begin-data.sps], [dnl
data list /A B 1-2.
begin data.
09
87
65
43
21
end data.
list.
])
AT_CHECK([pspp -O format=csv begin-data.sps], [0], [dnl
Table: Reading 1 record from INLINE.
Variable,Record,Columns,Format
A,1,1-  1,F1.0
B,1,2-  2,F1.0

Table: Data List
A,B
0,9
8,7
6,5
4,3
2,1
])
AT_CLEANUP

m4_define([DATA_READER_BINARY],
  [AT_SETUP([read and write files with $1])
$3
   AT_DATA([input.txt], [dnl
07-22-2007
10-06-2007
321
07-14-1789
08-26-1789
4
01-01-1972
12-31-1999
682
])
   AT_DATA([make-binary.pl], [dnl
use strict;
use warnings;

# ASCII to EBCDIC translation table
our ($ascii2ebcdic) = ""
. "\x00\x01\x02\x03\x37\x2d\x2e\x2f"
. "\x16\x05\x25\x0b\x0c\x0d\x0e\x0f"
. "\x10\x11\x12\x13\x3c\x3d\x32\x26"
. "\x18\x19\x3f\x27\x1c\x1d\x1e\x1f"
. "\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d"
. "\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61"
. "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7"
. "\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f"
. "\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7"
. "\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6"
. "\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6"
. "\xe7\xe8\xe9\xad\xe0\xbd\x9a\x6d"
. "\x79\x81\x82\x83\x84\x85\x86\x87"
. "\x88\x89\x91\x92\x93\x94\x95\x96"
. "\x97\x98\x99\xa2\xa3\xa4\xa5\xa6"
. "\xa7\xa8\xa9\xc0\x4f\xd0\x5f\x07"
. "\x20\x21\x22\x23\x24\x15\x06\x17"
. "\x28\x29\x2a\x2b\x2c\x09\x0a\x1b"
. "\x30\x31\x1a\x33\x34\x35\x36\x08"
. "\x38\x39\x3a\x3b\x04\x14\x3e\xe1"
. "\x41\x42\x43\x44\x45\x46\x47\x48"
. "\x49\x51\x52\x53\x54\x55\x56\x57"
. "\x58\x59\x62\x63\x64\x65\x66\x67"
. "\x68\x69\x70\x71\x72\x73\x74\x75"
. "\x76\x77\x78\x80\x8a\x8b\x8c\x8d"
. "\x8e\x8f\x90\x6a\x9b\x9c\x9d\x9e"
. "\x9f\xa0\xaa\xab\xac\x4a\xae\xaf"
. "\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7"
. "\xb8\xb9\xba\xbb\xbc\xa1\xbe\xbf"
. "\xca\xcb\xcc\xcd\xce\xcf\xda\xdb"
. "\xdc\xdd\xde\xdf\xea\xeb\xec\xed"
. "\xee\xef\xfa\xfb\xfc\xfd\xfe\xff";
length ($ascii2ebcdic) == 256 || die;

open (INPUT, '<', 'input.txt') or die "input.txt: open: $!\n";
my (@data) = <INPUT> or die;
close (INPUT) or die;
chomp $_ foreach @data;

our @records;

$2

sub a2e {
    local ($_) = @_;
    my ($s) = "";
    foreach (split (//)) {
        $s .= substr ($ascii2ebcdic, ord, 1);
    }
    return $s;
}

sub min {
    my ($a, $b) = @_;
    return $a < $b ? $a : $b
}

sub dump_records {
    while (@records) {
	my ($n) = min (int (rand (5)) + 1, scalar (@records));
	my (@r) = splice (@records, 0, $n);
	my ($len) = 0;
	$len += length foreach @r;
	print pack ("n xx", $len + 4);
	print foreach @r;
    }
}
])
   AT_CHECK([$PERL make-binary.pl < input.txt > input.bin])
   AT_DATA([data-reader.sps], [dnl
FILE HANDLE input/NAME='input.bin'/$1.
DATA LIST FIXED FILE=input NOTABLE
	/1 start 1-10 (ADATE)
	/2 end 1-10 (ADATE)
	/3 count 1-3.
LIST.

* Output the data to a new file in the same format.
FILE HANDLE OUTPUT/NAME='output.bin'/$1.
COMPUTE count=count + 1.
PRINT OUTFILE=output/start end count.
EXECUTE.
])
   AT_CHECK([pspp -O format=csv data-reader.sps], [0], [dnl
Table: Data List
start,end,count
07/22/2007,10/06/2007,321
07/14/1789,08/26/1789,4
01/01/1972,12/31/1999,682
])
   AT_CHECK([test -s output.bin])
   AT_DATA([data-reader-2.sps], [dnl
* Re-read the new data and list it, to verify that it was written correctly.
FILE HANDLE OUTPUT/NAME='output.bin'/$1.
DATA LIST FIXED FILE=output NOTABLE/
	start 2-11 (ADATE)
	end 13-22 (ADATE)
	count 24-26.
LIST.
])
   AT_CHECK([pspp -O format=csv data-reader-2.sps], [0], [dnl
Table: Data List
start,end,count
07/22/2007,10/06/2007,322
07/14/1789,08/26/1789,5
01/01/1972,12/31/1999,683
])
   AT_CLEANUP])

DATA_READER_BINARY([MODE=BINARY],
  [for $_ (@data) {
       my ($reclen) = pack ("V", length);
       print $reclen, $_, $reclen;
   }])

DATA_READER_BINARY([MODE=360 /RECFORM=FIXED /LRECL=32],
  [my ($lrecl) = 32;
   for $_ (@data) {
       my ($out) = substr ($_, 0, $lrecl);
       $out .= ' ' x ($lrecl - length ($out));
       length ($out) == 32 or die;
       print +a2e ($out);
   }],
  [AT_CHECK([i18n-test supports_encodings EBCDIC-US])])

DATA_READER_BINARY([MODE=360 /RECFORM=VARIABLE],
  [for $_ (@data) {
       push (@records, pack ("n xx", length ($_) + 4) . a2e ($_));
   }
   dump_records ();],
  [AT_CHECK([i18n-test supports_encodings EBCDIC-US])])

DATA_READER_BINARY([MODE=360 /RECFORM=SPANNED],
  [[for my $line (@data) {
       local ($_) = $line;
       my (@r);
       while (length) {
	   my ($n) = min (int (rand (5)), length);
	   push (@r, substr ($_, 0, $n, ''));
       }
       foreach my $i (0...$#r) {
	   my $scc = ($#r == 0 ? 0
		      : $i == 0 ? 1
		      : $i == $#r ? 2
		      : 3);
	   push (@records,
		 pack ("nCx", length ($r[$i]) + 4, $scc) . a2e ($r[$i]));
       }
   }
   dump_records ();]],
  [AT_CHECK([i18n-test supports_encodings EBCDIC-US])])