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           output = fmt_for_output_from_input (&input);
 473         }
 474       else
 475         {
 476           lex_match (lexer, '*');
 477           input = fmt_for_input (FMT_F, 8, 0);
 478           output = *get_format ();
 479         }
 480
 481       for (i = 0; i < name_cnt; i++)
 482         {
 483           struct dls_var_spec *spec;
 484           struct variable *v;
 485
 486           v = dict_create_var (dict, name[i], fmt_var_width (&input));
 487           if (v == NULL)
 488             {
 489               msg (SE, _("%s is a duplicate variable name."), name[i]);
 490               return 0;
 491             }
 492           v->print = v->write = output;
 493
 494           spec = pool_alloc (dls->pool, sizeof *spec);
 495           spec->input = input;
 496           spec->fv = v->fv;
 497           strcpy (spec->name, v->name);
 498           ll_push_tail (&dls->specs, &spec->ll);
 499         }
 500     }
 501
 502   return true;
 503 }
 504
 505 /* Displays a table giving information on free-format variable parsing
 506    on DATA LIST. */
 507 static void
 508 dump_free_table (const struct data_list_pgm *dls,
 509                  const struct file_handle *fh)
 510 {
 511   struct tab_table *t;
 512   struct dls_var_spec *spec;
 513   size_t spec_cnt;
 514   int row;
 515
 516   spec_cnt = ll_count (&dls->specs);
 517
 518   t = tab_create (2, spec_cnt + 1, 0);
 519   tab_columns (t, TAB_COL_DOWN, 1);
 520   tab_headers (t, 0, 0, 1, 0);
 521   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 522   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 523   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, spec_cnt);
 524   tab_hline (t, TAL_2, 0, 1, 1);
 525   tab_dim (t, tab_natural_dimensions);
 526   row = 1;
 527   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 528     {
 529       char str[FMT_STRING_LEN_MAX + 1];
 530       tab_text (t, 0, row, TAB_LEFT, spec->name);
 531       tab_text (t, 1, row, TAB_LEFT | TAB_FIX,
 532                 fmt_to_string (&spec->input, str));
 533       row++;
 534     }
 535
 536   tab_title (t, _("Reading free-form data from %s."), fh_get_name (fh));
 537
 538   tab_submit (t);
 539 }
 540 \f
 541 /* Input procedure. */
 542
 543 /* Extracts a field from the current position in the current
 544    record.  Fields can be unquoted or quoted with single- or
 545    double-quote characters.
 546
 547    *FIELD is set to the field content.  The caller must not
 548    or destroy this constant string.
 549
 550    After parsing the field, sets the current position in the
 551    record to just past the field and any trailing delimiter.
 552    Returns 0 on failure or a 1-based column number indicating the
 553    beginning of the field on success. */
 554 static bool
 555 cut_field (const struct data_list_pgm *dls, struct substring *field)
 556 {
 557   struct substring line, p;
 558
 559   if (dfm_eof (dls->reader))
 560     return false;
 561   if (ds_is_empty (&dls->delims))
 562     dfm_expand_tabs (dls->reader);
 563   line = p = dfm_get_record (dls->reader);
 564
 565   if (ds_is_empty (&dls->delims))
 566     {
 567       bool missing_quote = false;
 568
 569       /* Skip leading whitespace. */
 570       ss_ltrim (&p, ss_cstr (CC_SPACES));
 571       if (ss_is_empty (p))
 572         return false;
 573
 574       /* Handle actual data, whether quoted or unquoted. */
 575       if (ss_match_char (&p, '\''))
 576         missing_quote = !ss_get_until (&p, '\'', field);
 577       else if (ss_match_char (&p, '"'))
 578         missing_quote = !ss_get_until (&p, '"', field);
 579       else
 580         ss_get_chars (&p, ss_cspan (p, ss_cstr ("," CC_SPACES)), field);
 581       if (missing_quote)
 582         msg (SW, _("Quoted string extends beyond end of line."));
 583
 584       /* Skip trailing whitespace and a single comma if present. */
 585       ss_ltrim (&p, ss_cstr (CC_SPACES));
 586       ss_match_char (&p, ',');
 587
 588       dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p));
 589     }
 590   else
 591     {
 592       if (!ss_is_empty (p))
 593         ss_get_chars (&p, ss_cspan (p, ds_ss (&dls->delims)), field);
 594       else if (dfm_columns_past_end (dls->reader) == 0)
 595         {
 596           /* A blank line or a line that ends in a delimiter has a
 597              trailing blank field. */
 598           *field = p;
 599         }
 600       else
 601         return false;
 602
 603       /* Advance past the field.
 604
 605          Also advance past a trailing delimiter, regardless of
 606          whether one actually existed.  If we "skip" a delimiter
 607          that was not actually there, then we will return
 608          end-of-line on our next call, which is what we want. */
 609       dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p) + 1);
 610     }
 611   return true;
 612 }
 613
 614 static bool read_from_data_list_fixed (const struct data_list_pgm *,
 615                                        struct ccase *);
 616 static bool read_from_data_list_free (const struct data_list_pgm *,
 617                                       struct ccase *);
 618 static bool read_from_data_list_list (const struct data_list_pgm *,
 619                                       struct ccase *);
 620
 621 /* Reads a case from DLS into C.
 622    Returns true if successful, false at end of file or on I/O error. */
 623 static bool
 624 read_from_data_list (const struct data_list_pgm *dls, struct ccase *c)
 625 {
 626   bool retval;
 627
 628   dfm_push (dls->reader);
 629   switch (dls->type)
 630     {
 631     case DLS_FIXED:
 632       retval = read_from_data_list_fixed (dls, c);
 633       break;
 634     case DLS_FREE:
 635       retval = read_from_data_list_free (dls, c);
 636       break;
 637     case DLS_LIST:
 638       retval = read_from_data_list_list (dls, c);
 639       break;
 640     default:
 641       NOT_REACHED ();
 642     }
 643   dfm_pop (dls->reader);
 644
 645   return retval;
 646 }
 647
 648 /* Reads a case from the data file into C, parsing it according
 649    to fixed-format syntax rules in DLS.
 650    Returns true if successful, false at end of file or on I/O error. */
 651 static bool
 652 read_from_data_list_fixed (const struct data_list_pgm *dls, struct ccase *c)
 653 {
 654   struct dls_var_spec *spec;
 655   int row;
 656
 657   if (dfm_eof (dls->reader))
 658     return false;
 659
 660   spec = ll_to_dls_var_spec (ll_head (&dls->specs));
 661   for (row = 1; row <= dls->record_cnt; row++)
 662     {
 663       struct substring line;
 664
 665       if (dfm_eof (dls->reader))
 666         {
 667           msg (SW, _("Partial case of %d of %d records discarded."),
 668                row - 1, dls->record_cnt);
 669           return false;
 670         }
 671       dfm_expand_tabs (dls->reader);
 672       line = dfm_get_record (dls->reader);
 673
 674       ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
 675         {
 676           struct data_in di;
 677
 678           data_in_finite_line (&di, ss_data (line), ss_length (line),
 679                                spec->first_column,
 680                                spec->first_column + spec->input.w - 1);
 681           di.v = case_data_rw (c, spec->fv);
 682           di.flags = DI_IMPLIED_DECIMALS;
 683           di.f1 = spec->first_column;
 684           di.format = spec->input;
 685
 686           data_in (&di);
 687         }
 688
 689       dfm_forward_record (dls->reader);
 690     }
 691
 692   return true;
 693 }
 694
 695 /* Reads a case from the data file into C, parsing it according
 696    to free-format syntax rules in DLS.
 697    Returns true if successful, false at end of file or on I/O error. */
 698 static bool
 699 read_from_data_list_free (const struct data_list_pgm *dls, struct ccase *c)
 700 {
 701   struct dls_var_spec *spec;
 702
 703   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 704     {
 705       struct substring field;
 706       struct data_in di;
 707
 708       /* Cut out a field and read in a new record if necessary. */
 709       while (!cut_field (dls, &field))
 710         {
 711           if (!dfm_eof (dls->reader))
 712             dfm_forward_record (dls->reader);
 713           if (dfm_eof (dls->reader))
 714             {
 715               if (&spec->ll != ll_head (&dls->specs))
 716                 msg (SW, _("Partial case discarded.  The first variable "
 717                            "missing was %s."), spec->name);
 718               return false;
 719             }
 720         }
 721
 722       di.s = ss_data (field);
 723       di.e = ss_end (field);
 724       di.v = case_data_rw (c, spec->fv);
 725       di.flags = 0;
 726       di.f1 = dfm_get_column (dls->reader, ss_data (field));
 727       di.format = spec->input;
 728       data_in (&di);
 729     }
 730   return true;
 731 }
 732
 733 /* Reads a case from the data file and parses it according to
 734    list-format syntax rules.
 735    Returns true if successful, false at end of file or on I/O error. */
 736 static bool
 737 read_from_data_list_list (const struct data_list_pgm *dls, struct ccase *c)
 738 {
 739   struct dls_var_spec *spec;
 740
 741   if (dfm_eof (dls->reader))
 742     return false;
 743
 744   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 745     {
 746       struct substring field;
 747       struct data_in di;
 748
 749       if (!cut_field (dls, &field))
 750         {
 751           if (get_undefined ())
 752             msg (SW, _("Missing value(s) for all variables from %s onward.  "
 753                        "These will be filled with the system-missing value "
 754                        "or blanks, as appropriate."),
 755                  spec->name);
 756           ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
 757             {
 758               int width = fmt_var_width (&spec->input);
 759               if (width == 0)
 760                 case_data_rw (c, spec->fv)->f = SYSMIS;
 761               else
 762                 memset (case_data_rw (c, spec->fv)->s, ' ', width);
 763             }
 764           break;
 765         }
 766
 767       di.s = ss_data (field);
 768       di.e = ss_end (field);
 769       di.v = case_data_rw (c, spec->fv);
 770       di.flags = 0;
 771       di.f1 = dfm_get_column (dls->reader, ss_data (field));
 772       di.format = spec->input;
 773       data_in (&di);
 774     }
 775
 776   dfm_forward_record (dls->reader);
 777   return true;
 778 }
 779
 780 /* Destroys DATA LIST transformation DLS.
 781    Returns true if successful, false if an I/O error occurred. */
 782 static bool
 783 data_list_trns_free (void *dls_)
 784 {
 785   struct data_list_pgm *dls = dls_;
 786   dfm_close_reader (dls->reader);
 787   pool_destroy (dls->pool);
 788   return true;
 789 }
 790
 791 /* Handle DATA LIST transformation DLS, parsing data into C. */
 792 static int
 793 data_list_trns_proc (void *dls_, struct ccase *c, casenumber case_num UNUSED)
 794 {
 795   struct data_list_pgm *dls = dls_;
 796   int retval;
 797
 798   if (read_from_data_list (dls, c))
 799     retval = TRNS_CONTINUE;
 800   else if (dfm_reader_error (dls->reader) || dfm_eof (dls->reader) > 1)
 801     {
 802       /* An I/O error, or encountering end of file for a second
 803          time, should be escalated into a more serious error. */
 804       retval = TRNS_ERROR;
 805     }
 806   else
 807     retval = TRNS_END_FILE;
 808
 809   /* If there was an END subcommand handle it. */
 810   if (dls->end != NULL)
 811     {
 812       double *end = &case_data_rw (c, dls->end->fv)->f;
 813       if (retval == TRNS_DROP_CASE)
 814         {
 815           *end = 1.0;
 816           retval = TRNS_END_FILE;
 817         }
 818       else
 819         *end = 0.0;
 820     }
 821
 822   return retval;
 823 }
 824 \f
 825 /* Reads all the records from the data file and passes them to
 826    write_case().
 827    Returns true if successful, false if an I/O error occurred. */
 828 static bool
 829 data_list_source_read (struct case_source *source,
 830                        struct ccase *c,
 831                        write_case_func *write_case, write_case_data wc_data)
 832 {
 833   struct data_list_pgm *dls = source->aux;
 834
 835   /* Skip the requested number of records before reading the
 836      first case. */
 837   while (dls->skip_records > 0)
 838     {
 839       if (dfm_eof (dls->reader))
 840         return false;
 841       dfm_forward_record (dls->reader);
 842       dls->skip_records--;
 843     }
 844
 845   for (;;)
 846     {
 847       bool ok;
 848
 849       if (!read_from_data_list (dls, c))
 850         return !dfm_reader_error (dls->reader);
 851
 852       dfm_push (dls->reader);
 853       ok = write_case (wc_data);
 854       dfm_pop (dls->reader);
 855       if (!ok)
 856         return false;
 857     }
 858 }
 859
 860 /* Destroys the source's internal data. */
 861 static void
 862 data_list_source_destroy (struct case_source *source)
 863 {
 864   data_list_trns_free (source->aux);
 865 }
 866
 867 static const struct case_source_class data_list_source_class =
 868   {
 869     "DATA LIST",
 870     NULL,
 871     data_list_source_read,
 872     data_list_source_destroy,
 873   };