- return 0;
- }
- v->print = v->write = output;
-
- spec = pool_alloc (dls->pool, sizeof *spec);
- spec->input = input;
- spec->fv = v->fv;
- strcpy (spec->name, v->name);
- ll_push_tail (&dls->specs, &spec->ll);
- }
- }
-
- return true;
-}
-
-/* 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;
- struct dls_var_spec *spec;
- size_t spec_cnt;
- int row;
-
- spec_cnt = ll_count (&dls->specs);
-
- t = tab_create (2, spec_cnt + 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, spec_cnt);
- tab_hline (t, TAL_2, 0, 1, 1);
- tab_dim (t, tab_natural_dimensions);
-
- row = 1;
- ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
- {
- tab_text (t, 0, row, TAB_LEFT, spec->name);
- tab_text (t, 1, row, TAB_LEFT | TAB_FIX, fmt_to_string (&spec->input));
- row++;
- }
-
- 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. The caller must not
- or destroy this constant string.
-
- After parsing the field, sets the current position in the
- record to just past the field and any trailing delimiter.
- Returns 0 on failure or a 1-based column number indicating the
- beginning of the field on success. */
-static bool
-cut_field (const struct data_list_pgm *dls, struct substring *field)
-{
- struct substring line, p;
-
- if (dfm_eof (dls->reader))
- return false;
- if (ds_is_empty (&dls->delims))
- dfm_expand_tabs (dls->reader);
- line = p = dfm_get_record (dls->reader);
-
- if (ds_is_empty (&dls->delims))
- {
- bool missing_quote = false;
-
- /* Skip leading whitespace. */
- ss_ltrim (&p, ss_cstr (CC_SPACES));
- if (ss_is_empty (p))
- return false;
-
- /* Handle actual data, whether quoted or unquoted. */
- if (ss_match_char (&p, '\''))
- missing_quote = !ss_get_until (&p, '\'', field);
- else if (ss_match_char (&p, '"'))
- missing_quote = !ss_get_until (&p, '"', field);
- else
- ss_get_chars (&p, ss_cspan (p, ss_cstr ("," CC_SPACES)), field);
- if (missing_quote)
- msg (SW, _("Quoted string extends beyond end of line."));
-
- /* Skip trailing whitespace and a single comma if present. */
- ss_ltrim (&p, ss_cstr (CC_SPACES));
- ss_match_char (&p, ',');
-
- dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p));
- }
- else
- {
- if (!ss_is_empty (p))
- ss_get_chars (&p, ss_cspan (p, ds_ss (&dls->delims)), field);
- else if (dfm_columns_past_end (dls->reader) == 0)
- {
- /* A blank line or a line that ends in a delimiter has a
- trailing blank field. */
- *field = p;
- }
- else
- return false;
-
- /* Advance past the field.
-
- Also advance past a trailing delimiter, regardless of
- whether one actually existed. If we "skip" a delimiter
- that was not actually there, then we will return
- end-of-line on our next call, which is what we want. */
- dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p) + 1);
- }
- return true;
-}
-
-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:
- NOT_REACHED ();
- }
- 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 *spec;
- int row;
-
- if (dfm_eof (dls->reader))
- return false;
-
- spec = ll_to_dls_var_spec (ll_head (&dls->specs));
- for (row = 1; row <= dls->record_cnt; row++)
- {
- struct substring line;
-
- if (dfm_eof (dls->reader))
- {
- msg (SW, _("Partial case of %d of %d records discarded."),
- row - 1, dls->record_cnt);
- return false;
- }
- dfm_expand_tabs (dls->reader);
- line = dfm_get_record (dls->reader);
-
- ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
- {
- struct data_in di;
-
- data_in_finite_line (&di, ss_data (line), ss_length (line),
- spec->first_column,
- spec->first_column + spec->input.w - 1);
- di.v = case_data_rw (c, spec->fv);
- di.flags = DI_IMPLIED_DECIMALS;
- di.f1 = spec->first_column;
- di.format = 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 *spec;
-
- ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
- {
- struct substring field;
- struct data_in di;
-
- /* Cut out a field and read in a new record if necessary. */
- while (!cut_field (dls, &field))
- {
- if (!dfm_eof (dls->reader))
- dfm_forward_record (dls->reader);
- if (dfm_eof (dls->reader))
- {
- if (&spec->ll != ll_head (&dls->specs))
- msg (SW, _("Partial case discarded. The first variable "
- "missing was %s."), spec->name);