src/language/data-io/data-list.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18    02110-1301, USA. */
  19
  20 #include <config.h>
  21
  22 #include <ctype.h>
  23 #include <float.h>
  24 #include <stdio.h>
  25 #include <stdlib.h>
  26
  27 #include <data/case-source.h>
  28 #include <data/case.h>
  29 #include <data/case-source.h>
  30 #include <data/data-in.h>
  31 #include <data/dictionary.h>
  32 #include <data/format.h>
  33 #include <data/procedure.h>
  34 #include <data/settings.h>
  35 #include <data/transformations.h>
  36 #include <data/variable.h>
  37 #include <language/command.h>
  38 #include <language/data-io/data-reader.h>
  39 #include <language/data-io/file-handle.h>
  40 #include <language/data-io/inpt-pgm.h>
  41 #include <language/data-io/placement-parser.h>
  42 #include <language/lexer/format-parser.h>
  43 #include <language/lexer/lexer.h>
  44 #include <language/lexer/variable-parser.h>
  45 #include <libpspp/alloc.h>
  46 #include <libpspp/assertion.h>
  47 #include <libpspp/compiler.h>
  48 #include <libpspp/ll.h>
  49 #include <libpspp/message.h>
  50 #include <libpspp/misc.h>
  51 #include <libpspp/pool.h>
  52 #include <libpspp/str.h>
  53 #include <output/table.h>
  54
  55 #include "size_max.h"
  56 #include "xsize.h"
  57
  58 #include "gettext.h"
  59 #define _(msgid) gettext (msgid)
  60 \f
  61 /* Utility function. */
  62
  63 /* Describes how to parse one variable. */
  64 struct dls_var_spec
  65   {
  66     struct ll ll;               /* List element. */
  67
  68     /* All parsers. */
  69     struct fmt_spec input;      /* Input format of this field. */
  70     int fv;                     /* First value in case. */
  71     char name[LONG_NAME_LEN + 1]; /* Var name for error messages and tables. */
  72
  73     /* Fixed format only. */
  74     int record;                 /* Record number (1-based). */
  75     int first_column;           /* Column numbers in record. */
  76   };
  77
  78 static struct dls_var_spec *
  79 ll_to_dls_var_spec (struct ll *ll)
  80 {
  81   return ll_data (ll, struct dls_var_spec, ll);
  82 }
  83
  84 /* Constants for DATA LIST type. */
  85 enum dls_type
  86   {
  87     DLS_FIXED,
  88     DLS_FREE,
  89     DLS_LIST
  90   };
  91
  92 /* DATA LIST private data structure. */
  93 struct data_list_pgm
  94   {
  95     struct pool *pool;          /* Used for all DATA LIST storage. */
  96     struct ll_list specs;       /* List of dls_var_specs. */
  97     struct dfm_reader *reader;  /* Data file reader. */
  98     enum dls_type type;         /* Type of DATA LIST construct. */
  99     struct variable *end;       /* Variable specified on END subcommand. */
 100     int record_cnt;             /* Number of records. */
 101     struct string delims;       /* Field delimiters. */
 102   };
 103
 104 static const struct case_source_class data_list_source_class;
 105
 106 static bool parse_fixed (struct dictionary *dict,
 107                          struct pool *tmp_pool, struct data_list_pgm *);
 108 static bool parse_free (struct dictionary *dict,
 109                         struct pool *tmp_pool, struct data_list_pgm *);
 110 static void dump_fixed_table (const struct ll_list *,
 111                               const struct file_handle *, int record_cnt);
 112 static void dump_free_table (const struct data_list_pgm *,
 113                              const struct file_handle *);
 114
 115 static trns_free_func data_list_trns_free;
 116 static trns_proc_func data_list_trns_proc;
 117
 118 int
 119 cmd_data_list (struct dataset *ds)
 120 {
 121   struct dictionary *dict = dataset_dict (ds);
 122   struct data_list_pgm *dls;
 123   int table = -1;                /* Print table if nonzero, -1=undecided. */
 124   struct file_handle *fh = fh_inline_file ();
 125   struct pool *tmp_pool;
 126   bool ok;
 127
 128   if (!in_input_program ())
 129     discard_variables (ds);
 130
 131   dls = pool_create_container (struct data_list_pgm, pool);
 132   ll_init (&dls->specs);
 133   dls->reader = NULL;
 134   dls->type = -1;
 135   dls->end = NULL;
 136   dls->record_cnt = 0;
 137   ds_init_empty (&dls->delims);
 138   ds_register_pool (&dls->delims, dls->pool);
 139
 140   tmp_pool = pool_create_subpool (dls->pool);
 141
 142   while (token != '/')
 143     {
 144       if (lex_match_id ("FILE"))
 145         {
 146           lex_match ('=');
 147           fh = fh_parse (FH_REF_FILE | FH_REF_INLINE);
 148           if (fh == NULL)
 149             goto error;
 150         }
 151       else if (lex_match_id ("RECORDS"))
 152         {
 153           lex_match ('=');
 154           lex_match ('(');
 155           if (!lex_force_int ())
 156             goto error;
 157           dls->record_cnt = lex_integer ();
 158           lex_get ();
 159           lex_match (')');
 160         }
 161       else if (lex_match_id ("END"))
 162         {
 163           if (dls->end)
 164             {
 165               msg (SE, _("The END subcommand may only be specified once."));
 166               goto error;
 167             }
 168
 169           lex_match ('=');
 170           if (!lex_force_id ())
 171             goto error;
 172           dls->end = dict_lookup_var (dataset_dict (ds), tokid);
 173           if (!dls->end)
 174             dls->end = dict_create_var_assert (dataset_dict (ds), tokid, 0);
 175           lex_get ();
 176         }
 177       else if (token == T_ID)
 178         {
 179           if (lex_match_id ("NOTABLE"))
 180             table = 0;
 181           else if (lex_match_id ("TABLE"))
 182             table = 1;
 183           else
 184             {
 185               int type;
 186               if (lex_match_id ("FIXED"))
 187                 type = DLS_FIXED;
 188               else if (lex_match_id ("FREE"))
 189                 type = DLS_FREE;
 190               else if (lex_match_id ("LIST"))
 191                 type = DLS_LIST;
 192               else
 193                 {
 194                   lex_error (NULL);
 195                   goto error;
 196                 }
 197
 198               if (dls->type != -1)
 199                 {
 200                   msg (SE, _("Only one of FIXED, FREE, or LIST may "
 201                              "be specified."));
 202                   goto error;
 203                 }
 204               dls->type = type;
 205
 206               if ((dls->type == DLS_FREE || dls->type == DLS_LIST)
 207                   && lex_match ('('))
 208                 {
 209                   while (!lex_match (')'))
 210                     {
 211                       int delim;
 212
 213                       if (lex_match_id ("TAB"))
 214                         delim = '\t';
 215                       else if (token == T_STRING && ds_length (&tokstr) == 1)
 216                         {
 217                           delim = ds_first (&tokstr);
 218                           lex_get ();
 219                         }
 220                       else
 221                         {
 222                           lex_error (NULL);
 223                           goto error;
 224                         }
 225
 226                       ds_put_char (&dls->delims, delim);
 227
 228                       lex_match (',');
 229                     }
 230                 }
 231             }
 232         }
 233       else
 234         {
 235           lex_error (NULL);
 236           goto error;
 237         }
 238     }
 239
 240   fh_set_default_handle (fh);
 241
 242   if (dls->type == -1)
 243     dls->type = DLS_FIXED;
 244
 245   if (table == -1)
 246     table = dls->type != DLS_FREE;
 247
 248   ok = (dls->type == DLS_FIXED ? parse_fixed : parse_free) (dict, tmp_pool, dls);
 249   if (!ok)
 250     goto error;
 251
 252   if (lex_end_of_command () != CMD_SUCCESS)
 253     goto error;
 254
 255   if (table)
 256     {
 257       if (dls->type == DLS_FIXED)
 258         dump_fixed_table (&dls->specs, fh, dls->record_cnt);
 259       else
 260         dump_free_table (dls, fh);
 261     }
 262
 263   dls->reader = dfm_open_reader (fh);
 264   if (dls->reader == NULL)
 265     goto error;
 266
 267   if (in_input_program ())
 268     add_transformation (ds, data_list_trns_proc, data_list_trns_free, dls);
 269   else
 270     proc_set_source (ds, create_case_source (&data_list_source_class, dls));
 271
 272   pool_destroy (tmp_pool);
 273
 274   return CMD_SUCCESS;
 275
 276  error:
 277   data_list_trns_free (dls);
 278   return CMD_CASCADING_FAILURE;
 279 }
 280 \f
 281 /* Fixed-format parsing. */
 282
 283 /* Parses all the variable specifications for DATA LIST FIXED,
 284    storing them into DLS.  Uses TMP_POOL for data that is not
 285    needed once parsing is complete.  Returns true only if
 286    successful. */
 287 static bool
 288 parse_fixed (struct dictionary *dict,
 289              struct pool *tmp_pool, struct data_list_pgm *dls)
 290 {
 291   int last_nonempty_record;
 292   int record = 0;
 293   int column = 1;
 294
 295   while (token != '.')
 296     {
 297       char **names;
 298       size_t name_cnt, name_idx;
 299       struct fmt_spec *formats, *f;
 300       size_t format_cnt;
 301
 302       /* Parse everything. */
 303       if (!parse_record_placement (&record, &column)
 304           || !parse_DATA_LIST_vars_pool (tmp_pool, &names, &name_cnt, PV_NONE)
 305           || !parse_var_placements (tmp_pool, name_cnt, true,
 306                                     &formats, &format_cnt))
 307         return false;
 308
 309       /* Create variables and var specs. */
 310       name_idx = 0;
 311       for (f = formats; f < &formats[format_cnt]; f++)
 312         if (!execute_placement_format (f, &record, &column))
 313           {
 314             char *name;
 315             int width;
 316             struct variable *v;
 317             struct dls_var_spec *spec;
 318
 319             name = names[name_idx++];
 320
 321             /* Create variable. */
 322             width = fmt_var_width (f);
 323             v = dict_create_var (dict, name, width);
 324             if (v != NULL)
 325               {
 326                 /* Success. */
 327                 struct fmt_spec output = fmt_for_output_from_input (f);
 328                 v->print = output;
 329                 v->write = output;
 330               }
 331             else
 332               {
 333                 /* Failure.
 334                    This can be acceptable if we're in INPUT
 335                    PROGRAM, but only if the existing variable has
 336                    the same width as the one we would have
 337                    created. */
 338                 if (!in_input_program ())
 339                   {
 340                     msg (SE, _("%s is a duplicate variable name."), name);
 341                     return false;
 342                   }
 343
 344                 v = dict_lookup_var_assert (dict, name);
 345                 if ((width != 0) != (v->width != 0))
 346                   {
 347                     msg (SE, _("There is already a variable %s of a "
 348                                "different type."),
 349                          name);
 350                     return false;
 351                   }
 352                 if (width != 0 && width != v->width)
 353                   {
 354                     msg (SE, _("There is already a string variable %s of a "
 355                                "different width."), name);
 356                     return false;
 357                   }
 358               }
 359
 360             /* Create specifier for parsing the variable. */
 361             spec = pool_alloc (dls->pool, sizeof *spec);
 362             spec->input = *f;
 363             spec->fv = v->fv;
 364             spec->record = record;
 365             spec->first_column = column;
 366             strcpy (spec->name, v->name);
 367             ll_push_tail (&dls->specs, &spec->ll);
 368
 369             column += f->w;
 370           }
 371       assert (name_idx == name_cnt);
 372     }
 373   if (ll_is_empty (&dls->specs))
 374     {
 375       msg (SE, _("At least one variable must be specified."));
 376       return false;
 377     }
 378
 379   last_nonempty_record = ll_to_dls_var_spec (ll_tail (&dls->specs))->record;
 380   if (dls->record_cnt && last_nonempty_record > dls->record_cnt)
 381     {
 382       msg (SE, _("Variables are specified on records that "
 383                  "should not exist according to RECORDS subcommand."));
 384       return false;
 385     }
 386   else if (!dls->record_cnt)
 387     dls->record_cnt = last_nonempty_record;
 388
 389   return true;
 390 }
 391
 392 /* Displays a table giving information on fixed-format variable
 393    parsing on DATA LIST. */
 394 static void
 395 dump_fixed_table (const struct ll_list *specs,
 396                   const struct file_handle *fh, int record_cnt)
 397 {
 398   size_t spec_cnt;
 399   struct tab_table *t;
 400   struct dls_var_spec *spec;
 401   int row;
 402
 403   spec_cnt = ll_count (specs);
 404   t = tab_create (4, spec_cnt + 1, 0);
 405   tab_columns (t, TAB_COL_DOWN, 1);
 406   tab_headers (t, 0, 0, 1, 0);
 407   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 408   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
 409   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
 410   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 411   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, spec_cnt);
 412   tab_hline (t, TAL_2, 0, 3, 1);
 413   tab_dim (t, tab_natural_dimensions);
 414
 415   row = 1;
 416   ll_for_each (spec, struct dls_var_spec, ll, specs)
 417     {
 418       char fmt_string[FMT_STRING_LEN_MAX + 1];
 419       tab_text (t, 0, row, TAB_LEFT, spec->name);
 420       tab_text (t, 1, row, TAT_PRINTF, "%d", spec->record);
 421       tab_text (t, 2, row, TAT_PRINTF, "%3d-%3d",
 422                 spec->first_column, spec->first_column + spec->input.w - 1);
 423       tab_text (t, 3, row, TAB_LEFT | TAB_FIX,
 424                 fmt_to_string (&spec->input, fmt_string));
 425       row++;
 426     }
 427
 428   tab_title (t, ngettext ("Reading %d record from %s.",
 429                           "Reading %d records from %s.", record_cnt),
 430              record_cnt, fh_get_name (fh));
 431   tab_submit (t);
 432 }
 433 \f
 434 /* Free-format parsing. */
 435
 436 /* Parses variable specifications for DATA LIST FREE and adds
 437    them to DLS.  Uses TMP_POOL for data that is not needed once
 438    parsing is complete.  Returns true only if successful. */
 439 static bool
 440 parse_free (struct dictionary *dict, struct pool *tmp_pool, struct data_list_pgm *dls)
 441 {
 442   lex_get ();
 443   while (token != '.')
 444     {
 445       struct fmt_spec input, output;
 446       char **name;
 447       size_t name_cnt;
 448       size_t i;
 449
 450       if (!parse_DATA_LIST_vars_pool (tmp_pool, &name, &name_cnt, PV_NONE))
 451         return 0;
 452
 453       if (lex_match ('('))
 454         {
 455           if (!parse_format_specifier (&input)
 456               || !fmt_check_input (&input)
 457               || !lex_force_match (')'))
 458             return NULL;
 459           output = fmt_for_output_from_input (&input);
 460         }
 461       else
 462         {
 463           lex_match ('*');
 464           input = fmt_for_input (FMT_F, 8, 0);
 465           output = *get_format ();
 466         }
 467
 468       for (i = 0; i < name_cnt; i++)
 469         {
 470           struct dls_var_spec *spec;
 471           struct variable *v;
 472
 473           v = dict_create_var (dict, name[i], fmt_var_width (&input));
 474           if (v == NULL)
 475             {
 476               msg (SE, _("%s is a duplicate variable name."), name[i]);
 477               return 0;
 478             }
 479           v->print = v->write = output;
 480
 481           spec = pool_alloc (dls->pool, sizeof *spec);
 482           spec->input = input;
 483           spec->fv = v->fv;
 484           strcpy (spec->name, v->name);
 485           ll_push_tail (&dls->specs, &spec->ll);
 486         }
 487     }
 488
 489   return true;
 490 }
 491
 492 /* Displays a table giving information on free-format variable parsing
 493    on DATA LIST. */
 494 static void
 495 dump_free_table (const struct data_list_pgm *dls,
 496                  const struct file_handle *fh)
 497 {
 498   struct tab_table *t;
 499   struct dls_var_spec *spec;
 500   size_t spec_cnt;
 501   int row;
 502
 503   spec_cnt = ll_count (&dls->specs);
 504
 505   t = tab_create (2, spec_cnt + 1, 0);
 506   tab_columns (t, TAB_COL_DOWN, 1);
 507   tab_headers (t, 0, 0, 1, 0);
 508   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 509   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 510   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, spec_cnt);
 511   tab_hline (t, TAL_2, 0, 1, 1);
 512   tab_dim (t, tab_natural_dimensions);
 513   row = 1;
 514   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 515     {
 516       char str[FMT_STRING_LEN_MAX + 1];
 517       tab_text (t, 0, row, TAB_LEFT, spec->name);
 518       tab_text (t, 1, row, TAB_LEFT | TAB_FIX,
 519                 fmt_to_string (&spec->input, str));
 520       row++;
 521     }
 522
 523   tab_title (t, _("Reading free-form data from %s."), fh_get_name (fh));
 524
 525   tab_submit (t);
 526 }
 527 \f
 528 /* Input procedure. */
 529
 530 /* Extracts a field from the current position in the current
 531    record.  Fields can be unquoted or quoted with single- or
 532    double-quote characters.
 533
 534    *FIELD is set to the field content.  The caller must not
 535    or destroy this constant string.
 536
 537    After parsing the field, sets the current position in the
 538    record to just past the field and any trailing delimiter.
 539    Returns 0 on failure or a 1-based column number indicating the
 540    beginning of the field on success. */
 541 static bool
 542 cut_field (const struct data_list_pgm *dls, struct substring *field)
 543 {
 544   struct substring line, p;
 545
 546   if (dfm_eof (dls->reader))
 547     return false;
 548   if (ds_is_empty (&dls->delims))
 549     dfm_expand_tabs (dls->reader);
 550   line = p = dfm_get_record (dls->reader);
 551
 552   if (ds_is_empty (&dls->delims))
 553     {
 554       bool missing_quote = false;
 555
 556       /* Skip leading whitespace. */
 557       ss_ltrim (&p, ss_cstr (CC_SPACES));
 558       if (ss_is_empty (p))
 559         return false;
 560
 561       /* Handle actual data, whether quoted or unquoted. */
 562       if (ss_match_char (&p, '\''))
 563         missing_quote = !ss_get_until (&p, '\'', field);
 564       else if (ss_match_char (&p, '"'))
 565         missing_quote = !ss_get_until (&p, '"', field);
 566       else
 567         ss_get_chars (&p, ss_cspan (p, ss_cstr ("," CC_SPACES)), field);
 568       if (missing_quote)
 569         msg (SW, _("Quoted string extends beyond end of line."));
 570
 571       /* Skip trailing whitespace and a single comma if present. */
 572       ss_ltrim (&p, ss_cstr (CC_SPACES));
 573       ss_match_char (&p, ',');
 574
 575       dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p));
 576     }
 577   else
 578     {
 579       if (!ss_is_empty (p))
 580         ss_get_chars (&p, ss_cspan (p, ds_ss (&dls->delims)), field);
 581       else if (dfm_columns_past_end (dls->reader) == 0)
 582         {
 583           /* A blank line or a line that ends in a delimiter has a
 584              trailing blank field. */
 585           *field = p;
 586         }
 587       else
 588         return false;
 589
 590       /* Advance past the field.
 591
 592          Also advance past a trailing delimiter, regardless of
 593          whether one actually existed.  If we "skip" a delimiter
 594          that was not actually there, then we will return
 595          end-of-line on our next call, which is what we want. */
 596       dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p) + 1);
 597     }
 598   return true;
 599 }
 600
 601 static bool read_from_data_list_fixed (const struct data_list_pgm *,
 602                                        struct ccase *);
 603 static bool read_from_data_list_free (const struct data_list_pgm *,
 604                                       struct ccase *);
 605 static bool read_from_data_list_list (const struct data_list_pgm *,
 606                                       struct ccase *);
 607
 608 /* Reads a case from DLS into C.
 609    Returns true if successful, false at end of file or on I/O error. */
 610 static bool
 611 read_from_data_list (const struct data_list_pgm *dls, struct ccase *c)
 612 {
 613   bool retval;
 614
 615   dfm_push (dls->reader);
 616   switch (dls->type)
 617     {
 618     case DLS_FIXED:
 619       retval = read_from_data_list_fixed (dls, c);
 620       break;
 621     case DLS_FREE:
 622       retval = read_from_data_list_free (dls, c);
 623       break;
 624     case DLS_LIST:
 625       retval = read_from_data_list_list (dls, c);
 626       break;
 627     default:
 628       NOT_REACHED ();
 629     }
 630   dfm_pop (dls->reader);
 631
 632   return retval;
 633 }
 634
 635 /* Reads a case from the data file into C, parsing it according
 636    to fixed-format syntax rules in DLS.
 637    Returns true if successful, false at end of file or on I/O error. */
 638 static bool
 639 read_from_data_list_fixed (const struct data_list_pgm *dls, struct ccase *c)
 640 {
 641   struct dls_var_spec *spec;
 642   int row;
 643
 644   if (dfm_eof (dls->reader))
 645     return false;
 646
 647   spec = ll_to_dls_var_spec (ll_head (&dls->specs));
 648   for (row = 1; row <= dls->record_cnt; row++)
 649     {
 650       struct substring line;
 651
 652       if (dfm_eof (dls->reader))
 653         {
 654           msg (SW, _("Partial case of %d of %d records discarded."),
 655                row - 1, dls->record_cnt);
 656           return false;
 657         }
 658       dfm_expand_tabs (dls->reader);
 659       line = dfm_get_record (dls->reader);
 660
 661       ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
 662         {
 663           struct data_in di;
 664
 665           data_in_finite_line (&di, ss_data (line), ss_length (line),
 666                                spec->first_column,
 667                                spec->first_column + spec->input.w - 1);
 668           di.v = case_data_rw (c, spec->fv);
 669           di.flags = DI_IMPLIED_DECIMALS;
 670           di.f1 = spec->first_column;
 671           di.format = spec->input;
 672
 673           data_in (&di);
 674         }
 675
 676       dfm_forward_record (dls->reader);
 677     }
 678
 679   return true;
 680 }
 681
 682 /* Reads a case from the data file into C, parsing it according
 683    to free-format syntax rules in DLS.
 684    Returns true if successful, false at end of file or on I/O error. */
 685 static bool
 686 read_from_data_list_free (const struct data_list_pgm *dls, struct ccase *c)
 687 {
 688   struct dls_var_spec *spec;
 689
 690   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 691     {
 692       struct substring field;
 693       struct data_in di;
 694
 695       /* Cut out a field and read in a new record if necessary. */
 696       while (!cut_field (dls, &field))
 697         {
 698           if (!dfm_eof (dls->reader))
 699             dfm_forward_record (dls->reader);
 700           if (dfm_eof (dls->reader))
 701             {
 702               if (&spec->ll != ll_head (&dls->specs))
 703                 msg (SW, _("Partial case discarded.  The first variable "
 704                            "missing was %s."), spec->name);
 705               return false;
 706             }
 707         }
 708
 709       di.s = ss_data (field);
 710       di.e = ss_end (field);
 711       di.v = case_data_rw (c, spec->fv);
 712       di.flags = 0;
 713       di.f1 = dfm_get_column (dls->reader, ss_data (field));
 714       di.format = spec->input;
 715       data_in (&di);
 716     }
 717   return true;
 718 }
 719
 720 /* Reads a case from the data file and parses it according to
 721    list-format syntax rules.
 722    Returns true if successful, false at end of file or on I/O error. */
 723 static bool
 724 read_from_data_list_list (const struct data_list_pgm *dls, struct ccase *c)
 725 {
 726   struct dls_var_spec *spec;
 727
 728   if (dfm_eof (dls->reader))
 729     return false;
 730
 731   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 732     {
 733       struct substring field;
 734       struct data_in di;
 735
 736       if (!cut_field (dls, &field))
 737         {
 738           if (get_undefined ())
 739             msg (SW, _("Missing value(s) for all variables from %s onward.  "
 740                        "These will be filled with the system-missing value "
 741                        "or blanks, as appropriate."),
 742                  spec->name);
 743           ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
 744             {
 745               int width = fmt_var_width (&spec->input);
 746               if (width == 0)
 747                 case_data_rw (c, spec->fv)->f = SYSMIS;
 748               else
 749                 memset (case_data_rw (c, spec->fv)->s, ' ', width);
 750             }
 751           break;
 752         }
 753
 754       di.s = ss_data (field);
 755       di.e = ss_end (field);
 756       di.v = case_data_rw (c, spec->fv);
 757       di.flags = 0;
 758       di.f1 = dfm_get_column (dls->reader, ss_data (field));
 759       di.format = spec->input;
 760       data_in (&di);
 761     }
 762
 763   dfm_forward_record (dls->reader);
 764   return true;
 765 }
 766
 767 /* Destroys DATA LIST transformation DLS.
 768    Returns true if successful, false if an I/O error occurred. */
 769 static bool
 770 data_list_trns_free (void *dls_)
 771 {
 772   struct data_list_pgm *dls = dls_;
 773   dfm_close_reader (dls->reader);
 774   pool_destroy (dls->pool);
 775   return true;
 776 }
 777
 778 /* Handle DATA LIST transformation DLS, parsing data into C. */
 779 static int
 780 data_list_trns_proc (void *dls_, struct ccase *c, casenumber case_num UNUSED)
 781 {
 782   struct data_list_pgm *dls = dls_;
 783   int retval;
 784
 785   if (read_from_data_list (dls, c))
 786     retval = TRNS_CONTINUE;
 787   else if (dfm_reader_error (dls->reader) || dfm_eof (dls->reader) > 1)
 788     {
 789       /* An I/O error, or encountering end of file for a second
 790          time, should be escalated into a more serious error. */
 791       retval = TRNS_ERROR;
 792     }
 793   else
 794     retval = TRNS_END_FILE;
 795
 796   /* If there was an END subcommand handle it. */
 797   if (dls->end != NULL)
 798     {
 799       double *end = &case_data_rw (c, dls->end->fv)->f;
 800       if (retval == TRNS_DROP_CASE)
 801         {
 802           *end = 1.0;
 803           retval = TRNS_END_FILE;
 804         }
 805       else
 806         *end = 0.0;
 807     }
 808
 809   return retval;
 810 }
 811 \f
 812 /* Reads all the records from the data file and passes them to
 813    write_case().
 814    Returns true if successful, false if an I/O error occurred. */
 815 static bool
 816 data_list_source_read (struct case_source *source,
 817                        struct ccase *c,
 818                        write_case_func *write_case, write_case_data wc_data)
 819 {
 820   struct data_list_pgm *dls = source->aux;
 821
 822   for (;;)
 823     {
 824       bool ok;
 825
 826       if (!read_from_data_list (dls, c))
 827         return !dfm_reader_error (dls->reader);
 828
 829       dfm_push (dls->reader);
 830       ok = write_case (wc_data);
 831       dfm_pop (dls->reader);
 832       if (!ok)
 833         return false;
 834     }
 835 }
 836
 837 /* Destroys the source's internal data. */
 838 static void
 839 data_list_source_destroy (struct case_source *source)
 840 {
 841   data_list_trns_free (source->aux);
 842 }
 843
 844 static const struct case_source_class data_list_source_class =
 845   {
 846     "DATA LIST",
 847     NULL,
 848     data_list_source_read,
 849     data_list_source_destroy,
 850   };