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