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

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