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                 var_set_both_formats (v, &output);
 340               }
 341             else
 342               {
 343                 /* Failure.
 344                    This can be acceptable if we're in INPUT
 345                    PROGRAM, but only if the existing variable has
 346                    the same width as the one we would have
 347                    created. */
 348                 if (!in_input_program ())
 349                   {
 350                     msg (SE, _("%s is a duplicate variable name."), name);
 351                     return false;
 352                   }
 353
 354                 v = dict_lookup_var_assert (dict, name);
 355                 if ((width != 0) != (var_get_width (v) != 0))
 356                   {
 357                     msg (SE, _("There is already a variable %s of a "
 358                                "different type."),
 359                          name);
 360                     return false;
 361                   }
 362                 if (width != 0 && width != var_get_width (v))
 363                   {
 364                     msg (SE, _("There is already a string variable %s of a "
 365                                "different width."), name);
 366                     return false;
 367                   }
 368               }
 369
 370             /* Create specifier for parsing the variable. */
 371             spec = pool_alloc (dls->pool, sizeof *spec);
 372             spec->input = *f;
 373             spec->fv = var_get_case_index (v);
 374             spec->record = record;
 375             spec->first_column = column;
 376             strcpy (spec->name, var_get_name (v));
 377             ll_push_tail (&dls->specs, &spec->ll);
 378
 379             column += f->w;
 380           }
 381       assert (name_idx == name_cnt);
 382     }
 383   if (ll_is_empty (&dls->specs))
 384     {
 385       msg (SE, _("At least one variable must be specified."));
 386       return false;
 387     }
 388
 389   last_nonempty_record = ll_to_dls_var_spec (ll_tail (&dls->specs))->record;
 390   if (dls->record_cnt && last_nonempty_record > dls->record_cnt)
 391     {
 392       msg (SE, _("Variables are specified on records that "
 393                  "should not exist according to RECORDS subcommand."));
 394       return false;
 395     }
 396   else if (!dls->record_cnt)
 397     dls->record_cnt = last_nonempty_record;
 398
 399   return true;
 400 }
 401
 402 /* Displays a table giving information on fixed-format variable
 403    parsing on DATA LIST. */
 404 static void
 405 dump_fixed_table (const struct ll_list *specs,
 406                   const struct file_handle *fh, int record_cnt)
 407 {
 408   size_t spec_cnt;
 409   struct tab_table *t;
 410   struct dls_var_spec *spec;
 411   int row;
 412
 413   spec_cnt = ll_count (specs);
 414   t = tab_create (4, spec_cnt + 1, 0);
 415   tab_columns (t, TAB_COL_DOWN, 1);
 416   tab_headers (t, 0, 0, 1, 0);
 417   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 418   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
 419   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
 420   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 421   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, spec_cnt);
 422   tab_hline (t, TAL_2, 0, 3, 1);
 423   tab_dim (t, tab_natural_dimensions);
 424
 425   row = 1;
 426   ll_for_each (spec, struct dls_var_spec, ll, specs)
 427     {
 428       char fmt_string[FMT_STRING_LEN_MAX + 1];
 429       tab_text (t, 0, row, TAB_LEFT, spec->name);
 430       tab_text (t, 1, row, TAT_PRINTF, "%d", spec->record);
 431       tab_text (t, 2, row, TAT_PRINTF, "%3d-%3d",
 432                 spec->first_column, spec->first_column + spec->input.w - 1);
 433       tab_text (t, 3, row, TAB_LEFT | TAB_FIX,
 434                 fmt_to_string (&spec->input, fmt_string));
 435       row++;
 436     }
 437
 438   tab_title (t, ngettext ("Reading %d record from %s.",
 439                           "Reading %d records from %s.", record_cnt),
 440              record_cnt, fh_get_name (fh));
 441   tab_submit (t);
 442 }
 443 \f
 444 /* Free-format parsing. */
 445
 446 /* Parses variable specifications for DATA LIST FREE and adds
 447    them to DLS.  Uses TMP_POOL for data that is not needed once
 448    parsing is complete.  Returns true only if successful. */
 449 static bool
 450 parse_free (struct lexer *lexer, struct dictionary *dict, struct pool *tmp_pool,
 451                 struct data_list_pgm *dls)
 452 {
 453   lex_get (lexer);
 454   while (lex_token (lexer) != '.')
 455     {
 456       struct fmt_spec input, output;
 457       char **name;
 458       size_t name_cnt;
 459       size_t i;
 460
 461       if (!parse_DATA_LIST_vars_pool (lexer, tmp_pool,
 462                                       &name, &name_cnt, PV_NONE))
 463         return 0;
 464
 465       if (lex_match (lexer, '('))
 466         {
 467           if (!parse_format_specifier (lexer, &input)
 468               || !fmt_check_input (&input)
 469               || !lex_force_match (lexer, ')'))
 470             return NULL;
 471
 472           /* As a special case, N format is treated as F format
 473              for free-field input. */
 474           if (input.type == FMT_N)
 475             input.type = FMT_F;
 476
 477           output = fmt_for_output_from_input (&input);
 478         }
 479       else
 480         {
 481           lex_match (lexer, '*');
 482           input = fmt_for_input (FMT_F, 8, 0);
 483           output = *get_format ();
 484         }
 485
 486       for (i = 0; i < name_cnt; i++)
 487         {
 488           struct dls_var_spec *spec;
 489           struct variable *v;
 490
 491           v = dict_create_var (dict, name[i], fmt_var_width (&input));
 492           if (v == NULL)
 493             {
 494               msg (SE, _("%s is a duplicate variable name."), name[i]);
 495               return 0;
 496             }
 497           var_set_both_formats (v, &output);
 498
 499           spec = pool_alloc (dls->pool, sizeof *spec);
 500           spec->input = input;
 501           spec->fv = var_get_case_index (v);
 502           strcpy (spec->name, var_get_name (v));
 503           ll_push_tail (&dls->specs, &spec->ll);
 504         }
 505     }
 506
 507   return true;
 508 }
 509
 510 /* Displays a table giving information on free-format variable parsing
 511    on DATA LIST. */
 512 static void
 513 dump_free_table (const struct data_list_pgm *dls,
 514                  const struct file_handle *fh)
 515 {
 516   struct tab_table *t;
 517   struct dls_var_spec *spec;
 518   size_t spec_cnt;
 519   int row;
 520
 521   spec_cnt = ll_count (&dls->specs);
 522
 523   t = tab_create (2, spec_cnt + 1, 0);
 524   tab_columns (t, TAB_COL_DOWN, 1);
 525   tab_headers (t, 0, 0, 1, 0);
 526   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 527   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 528   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, spec_cnt);
 529   tab_hline (t, TAL_2, 0, 1, 1);
 530   tab_dim (t, tab_natural_dimensions);
 531   row = 1;
 532   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 533     {
 534       char str[FMT_STRING_LEN_MAX + 1];
 535       tab_text (t, 0, row, TAB_LEFT, spec->name);
 536       tab_text (t, 1, row, TAB_LEFT | TAB_FIX,
 537                 fmt_to_string (&spec->input, str));
 538       row++;
 539     }
 540
 541   tab_title (t, _("Reading free-form data from %s."), fh_get_name (fh));
 542
 543   tab_submit (t);
 544 }
 545 \f
 546 /* Input procedure. */
 547
 548 /* Extracts a field from the current position in the current
 549    record.  Fields can be unquoted or quoted with single- or
 550    double-quote characters.
 551
 552    *FIELD is set to the field content.  The caller must not
 553    or destroy this constant string.
 554
 555    After parsing the field, sets the current position in the
 556    record to just past the field and any trailing delimiter.
 557    Returns 0 on failure or a 1-based column number indicating the
 558    beginning of the field on success. */
 559 static bool
 560 cut_field (const struct data_list_pgm *dls, struct substring *field)
 561 {
 562   struct substring line, p;
 563
 564   if (dfm_eof (dls->reader))
 565     return false;
 566   if (ds_is_empty (&dls->delims))
 567     dfm_expand_tabs (dls->reader);
 568   line = p = dfm_get_record (dls->reader);
 569
 570   if (ds_is_empty (&dls->delims))
 571     {
 572       bool missing_quote = false;
 573
 574       /* Skip leading whitespace. */
 575       ss_ltrim (&p, ss_cstr (CC_SPACES));
 576       if (ss_is_empty (p))
 577         return false;
 578
 579       /* Handle actual data, whether quoted or unquoted. */
 580       if (ss_match_char (&p, '\''))
 581         missing_quote = !ss_get_until (&p, '\'', field);
 582       else if (ss_match_char (&p, '"'))
 583         missing_quote = !ss_get_until (&p, '"', field);
 584       else
 585         ss_get_chars (&p, ss_cspan (p, ss_cstr ("," CC_SPACES)), field);
 586       if (missing_quote)
 587         msg (SW, _("Quoted string extends beyond end of line."));
 588
 589       /* Skip trailing whitespace and a single comma if present. */
 590       ss_ltrim (&p, ss_cstr (CC_SPACES));
 591       ss_match_char (&p, ',');
 592
 593       dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p));
 594     }
 595   else
 596     {
 597       if (!ss_is_empty (p))
 598         ss_get_chars (&p, ss_cspan (p, ds_ss (&dls->delims)), field);
 599       else if (dfm_columns_past_end (dls->reader) == 0)
 600         {
 601           /* A blank line or a line that ends in a delimiter has a
 602              trailing blank field. */
 603           *field = p;
 604         }
 605       else
 606         return false;
 607
 608       /* Advance past the field.
 609
 610          Also advance past a trailing delimiter, regardless of
 611          whether one actually existed.  If we "skip" a delimiter
 612          that was not actually there, then we will return
 613          end-of-line on our next call, which is what we want. */
 614       dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p) + 1);
 615     }
 616   return true;
 617 }
 618
 619 static bool read_from_data_list_fixed (const struct data_list_pgm *,
 620                                        struct ccase *);
 621 static bool read_from_data_list_free (const struct data_list_pgm *,
 622                                       struct ccase *);
 623 static bool read_from_data_list_list (const struct data_list_pgm *,
 624                                       struct ccase *);
 625
 626 /* Reads a case from DLS into C.
 627    Returns true if successful, false at end of file or on I/O error. */
 628 static bool
 629 read_from_data_list (const struct data_list_pgm *dls, struct ccase *c)
 630 {
 631   bool retval;
 632
 633   dfm_push (dls->reader);
 634   switch (dls->type)
 635     {
 636     case DLS_FIXED:
 637       retval = read_from_data_list_fixed (dls, c);
 638       break;
 639     case DLS_FREE:
 640       retval = read_from_data_list_free (dls, c);
 641       break;
 642     case DLS_LIST:
 643       retval = read_from_data_list_list (dls, c);
 644       break;
 645     default:
 646       NOT_REACHED ();
 647     }
 648   dfm_pop (dls->reader);
 649
 650   return retval;
 651 }
 652
 653 /* Reads a case from the data file into C, parsing it according
 654    to fixed-format syntax rules in DLS.
 655    Returns true if successful, false at end of file or on I/O error. */
 656 static bool
 657 read_from_data_list_fixed (const struct data_list_pgm *dls, struct ccase *c)
 658 {
 659   struct dls_var_spec *spec;
 660   int row;
 661
 662   if (dfm_eof (dls->reader))
 663     return false;
 664
 665   spec = ll_to_dls_var_spec (ll_head (&dls->specs));
 666   for (row = 1; row <= dls->record_cnt; row++)
 667     {
 668       struct substring line;
 669
 670       if (dfm_eof (dls->reader))
 671         {
 672           msg (SW, _("Partial case of %d of %d records discarded."),
 673                row - 1, dls->record_cnt);
 674           return false;
 675         }
 676       dfm_expand_tabs (dls->reader);
 677       line = dfm_get_record (dls->reader);
 678
 679       ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
 680         data_in (ss_substr (line, spec->first_column - 1, spec->input.w),
 681                  spec->input.type, spec->input.d, spec->first_column,
 682                  case_data_rw_idx (c, spec->fv), fmt_var_width (&spec->input));
 683
 684       dfm_forward_record (dls->reader);
 685     }
 686
 687   return true;
 688 }
 689
 690 /* Reads a case from the data file into C, parsing it according
 691    to free-format syntax rules in DLS.
 692    Returns true if successful, false at end of file or on I/O error. */
 693 static bool
 694 read_from_data_list_free (const struct data_list_pgm *dls, struct ccase *c)
 695 {
 696   struct dls_var_spec *spec;
 697
 698   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 699     {
 700       struct substring field;
 701
 702       /* Cut out a field and read in a new record if necessary. */
 703       while (!cut_field (dls, &field))
 704         {
 705           if (!dfm_eof (dls->reader))
 706             dfm_forward_record (dls->reader);
 707           if (dfm_eof (dls->reader))
 708             {
 709               if (&spec->ll != ll_head (&dls->specs))
 710                 msg (SW, _("Partial case discarded.  The first variable "
 711                            "missing was %s."), spec->name);
 712               return false;
 713             }
 714         }
 715
 716       data_in (field, spec->input.type, 0,
 717                dfm_get_column (dls->reader, ss_data (field)),
 718                case_data_rw_idx (c, spec->fv), fmt_var_width (&spec->input));
 719     }
 720   return true;
 721 }
 722
 723 /* Reads a case from the data file and parses it according to
 724    list-format syntax rules.
 725    Returns true if successful, false at end of file or on I/O error. */
 726 static bool
 727 read_from_data_list_list (const struct data_list_pgm *dls, struct ccase *c)
 728 {
 729   struct dls_var_spec *spec;
 730
 731   if (dfm_eof (dls->reader))
 732     return false;
 733
 734   ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
 735     {
 736       struct substring field;
 737
 738       if (!cut_field (dls, &field))
 739         {
 740           if (get_undefined ())
 741             msg (SW, _("Missing value(s) for all variables from %s onward.  "
 742                        "These will be filled with the system-missing value "
 743                        "or blanks, as appropriate."),
 744                  spec->name);
 745           ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
 746             {
 747               int width = fmt_var_width (&spec->input);
 748               if (width == 0)
 749                 case_data_rw_idx (c, spec->fv)->f = SYSMIS;
 750               else
 751                 memset (case_data_rw_idx (c, spec->fv)->s, ' ', width);
 752             }
 753           break;
 754         }
 755
 756       data_in (field, spec->input.type, 0,
 757                dfm_get_column (dls->reader, ss_data (field)),
 758                case_data_rw_idx (c, spec->fv), fmt_var_width (&spec->input));
 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)->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   /* Skip the requested number of records before reading the
 821      first case. */
 822   while (dls->skip_records > 0)
 823     {
 824       if (dfm_eof (dls->reader))
 825         return false;
 826       dfm_forward_record (dls->reader);
 827       dls->skip_records--;
 828     }
 829
 830   for (;;)
 831     {
 832       bool ok;
 833
 834       if (!read_from_data_list (dls, c))
 835         return !dfm_reader_error (dls->reader);
 836
 837       dfm_push (dls->reader);
 838       ok = write_case (wc_data);
 839       dfm_pop (dls->reader);
 840       if (!ok)
 841         return false;
 842     }
 843 }
 844
 845 /* Destroys the source's internal data. */
 846 static void
 847 data_list_source_destroy (struct case_source *source)
 848 {
 849   data_list_trns_free (source->aux);
 850 }
 851
 852 static const struct case_source_class data_list_source_class =
 853   {
 854     "DATA LIST",
 855     NULL,
 856     data_list_source_read,
 857     data_list_source_destroy,
 858   };