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