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