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