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

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