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

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