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

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