- return 0;
- }
- v->print = v->write = output;
-
- spec = xmalloc (sizeof *spec);
- spec->input = input;
- spec->v = v;
- spec->fv = v->fv;
- str_copy_trunc (spec->name, sizeof spec->name, v->name);
- append_var_spec (first, last, spec);
- }
- for (i = 0; i < name_cnt; i++)
- free (name[i]);
- free (name);
- }
-
- return lex_end_of_command () == CMD_SUCCESS;
-}
-
-/* Displays a table giving information on free-format variable parsing
- on DATA LIST. */
-static void
-dump_free_table (const struct data_list_pgm *dls,
- const struct file_handle *fh)
-{
- struct tab_table *t;
- int i;
-
- {
- struct dls_var_spec *spec;
- for (i = 0, spec = dls->first; spec; spec = spec->next)
- i++;
- }
-
- t = tab_create (2, i + 1, 0);
- tab_columns (t, TAB_COL_DOWN, 1);
- tab_headers (t, 0, 0, 1, 0);
- tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
- tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
- tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
- tab_hline (t, TAL_2, 0, 1, 1);
- tab_dim (t, tab_natural_dimensions);
-
- {
- struct dls_var_spec *spec;
-
- for (i = 1, spec = dls->first; spec; spec = spec->next, i++)
- {
- tab_text (t, 0, i, TAB_LEFT, spec->v->name);
- tab_text (t, 1, i, TAB_LEFT | TAB_FIX, fmt_to_string (&spec->input));
- }
- }
-
- tab_title (t, _("Reading free-form data from %s."), fh_get_name (fh));
-
- tab_submit (t);
-}
-\f
-/* Input procedure. */
-
-/* Extracts a field from the current position in the current
- record. Fields can be unquoted or quoted with single- or
- double-quote characters. *FIELD is set to the field content.
- After parsing the field, sets the current position in the
- record to just past the field and any trailing delimiter.
- END_BLANK is used internally; it should be initialized by the
- caller to 0 and left alone afterward. Returns 0 on failure or
- a 1-based column number indicating the beginning of the field
- on success. */
-static int
-cut_field (const struct data_list_pgm *dls, struct fixed_string *field,
- int *end_blank)
-{
- struct fixed_string line;
- char *cp;
- size_t column_start;
-
- if (dfm_eof (dls->reader))
- return 0;
- if (dls->delim_cnt == 0)
- dfm_expand_tabs (dls->reader);
- dfm_get_record (dls->reader, &line);
-
- cp = ls_c_str (&line);
- if (dls->delim_cnt == 0)
- {
- /* Skip leading whitespace. */
- while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
- cp++;
- if (cp >= ls_end (&line))
- return 0;
-
- /* Handle actual data, whether quoted or unquoted. */
- if (*cp == '\'' || *cp == '"')
- {
- int quote = *cp;
-
- field->string = ++cp;
- while (cp < ls_end (&line) && *cp != quote)
- cp++;
- field->length = cp - field->string;
- if (cp < ls_end (&line))
- cp++;
- else
- msg (SW, _("Quoted string missing terminating `%c'."), quote);
- }
- else
- {
- field->string = cp;
- while (cp < ls_end (&line)
- && !isspace ((unsigned char) *cp) && *cp != ',')
- cp++;
- field->length = cp - field->string;
- }
-
- /* Skip trailing whitespace and a single comma if present. */
- while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
- cp++;
- if (cp < ls_end (&line) && *cp == ',')
- cp++;
- }
- else
- {
- if (cp >= ls_end (&line))
- {
- int column = dfm_column_start (dls->reader);
- /* A blank line or a line that ends in \t has a
- trailing blank field. */
- if (column == 1 || (column > 1 && cp[-1] == '\t'))
- {
- if (*end_blank == 0)
- {
- *end_blank = 1;
- field->string = ls_end (&line);
- field->length = 0;
- dfm_forward_record (dls->reader);
- return column;
- }
- else
- {
- *end_blank = 0;
- return 0;
- }
- }
- else
- return 0;
- }
- else
- {
- field->string = cp;
- while (cp < ls_end (&line)
- && memchr (dls->delims, *cp, dls->delim_cnt) == NULL)
- cp++;
- field->length = cp - field->string;
- if (cp < ls_end (&line))
- cp++;
- }
- }
-
- dfm_forward_columns (dls->reader, field->string - line.string);
- column_start = dfm_column_start (dls->reader);
-
- dfm_forward_columns (dls->reader, cp - field->string);
-
- return column_start;
-}
-
-static bool read_from_data_list_fixed (const struct data_list_pgm *,
- struct ccase *);
-static bool read_from_data_list_free (const struct data_list_pgm *,
- struct ccase *);
-static bool read_from_data_list_list (const struct data_list_pgm *,
- struct ccase *);
-
-/* Reads a case from DLS into C.
- Returns true if successful, false at end of file or on I/O error. */
-static bool
-read_from_data_list (const struct data_list_pgm *dls, struct ccase *c)
-{
- bool retval;
-
- dfm_push (dls->reader);
- switch (dls->type)
- {
- case DLS_FIXED:
- retval = read_from_data_list_fixed (dls, c);
- break;
- case DLS_FREE:
- retval = read_from_data_list_free (dls, c);
- break;
- case DLS_LIST:
- retval = read_from_data_list_list (dls, c);
- break;
- default:
- abort ();
- }
- dfm_pop (dls->reader);
-
- return retval;
-}
-
-/* Reads a case from the data file into C, parsing it according
- to fixed-format syntax rules in DLS.
- Returns true if successful, false at end of file or on I/O error. */
-static bool
-read_from_data_list_fixed (const struct data_list_pgm *dls, struct ccase *c)
-{
- struct dls_var_spec *var_spec = dls->first;
- int i;
-
- if (dfm_eof (dls->reader))
- return false;
- for (i = 1; i <= dls->rec_cnt; i++)
- {
- struct fixed_string line;
-
- if (dfm_eof (dls->reader))
- {
- /* Note that this can't occur on the first record. */
- msg (SW, _("Partial case of %d of %d records discarded."),
- i - 1, dls->rec_cnt);
- return false;
- }
- dfm_expand_tabs (dls->reader);
- dfm_get_record (dls->reader, &line);
-
- for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
- {
- struct data_in di;
-
- data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
- var_spec->fc, var_spec->lc);
- di.v = case_data_rw (c, var_spec->fv);
- di.flags = DI_IMPLIED_DECIMALS;
- di.f1 = var_spec->fc;
- di.format = var_spec->input;
-
- data_in (&di);
- }
-
- dfm_forward_record (dls->reader);
- }
-
- return true;
-}
-
-/* Reads a case from the data file into C, parsing it according
- to free-format syntax rules in DLS.
- Returns true if successful, false at end of file or on I/O error. */
-static bool
-read_from_data_list_free (const struct data_list_pgm *dls, struct ccase *c)
-{
- struct dls_var_spec *var_spec;
- int end_blank = 0;
-
- for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
- {
- struct fixed_string field;
- int column;
-
- /* Cut out a field and read in a new record if necessary. */
- for (;;)
- {
- column = cut_field (dls, &field, &end_blank);
- if (column != 0)
- break;
-
- if (!dfm_eof (dls->reader))
- dfm_forward_record (dls->reader);
- if (dfm_eof (dls->reader))
- {
- if (var_spec != dls->first)
- msg (SW, _("Partial case discarded. The first variable "
- "missing was %s."), var_spec->name);