src/data-list.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 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 #include "data-list.h"
  22 #include "error.h"
  23 #include <ctype.h>
  24 #include <float.h>
  25 #include <stdio.h>
  26 #include <stdlib.h>
  27 #include "alloc.h"
  28 #include "case.h"
  29 #include "command.h"
  30 #include "data-in.h"
  31 #include "debug-print.h"
  32 #include "dfm-read.h"
  33 #include "dictionary.h"
  34 #include "error.h"
  35 #include "file-handle.h"
  36 #include "format.h"
  37 #include "lexer.h"
  38 #include "misc.h"
  39 #include "settings.h"
  40 #include "str.h"
  41 #include "tab.h"
  42 #include "var.h"
  43 #include "vfm.h"
  44
  45 #include "gettext.h"
  46 #define _(msgid) gettext (msgid)
  47 \f
  48 /* Utility function. */
  49
  50 /* FIXME: Either REPEATING DATA must be the last transformation, or we
  51    must multiplex the transformations that follow (i.e., perform them
  52    for every case that we produce from a repetition instance).
  53    Currently we do neither.  We should do one or the other. */
  54
  55 /* Describes how to parse one variable. */
  56 struct dls_var_spec
  57   {
  58     struct dls_var_spec *next;  /* Next specification in list. */
  59
  60     /* Both free and fixed formats. */
  61     struct fmt_spec input;      /* Input format of this field. */
  62     struct variable *v;         /* Associated variable.  Used only in
  63                                    parsing.  Not safe later. */
  64     int fv;                     /* First value in case. */
  65
  66     /* Fixed format only. */
  67     int rec;                    /* Record number (1-based). */
  68     int fc, lc;                 /* Column numbers in record. */
  69
  70     /* Free format only. */
  71     char name[LONG_NAME_LEN + 1]; /* Name of variable. */
  72   };
  73
  74 /* Constants for DATA LIST type. */
  75 /* Must match table in cmd_data_list(). */
  76 enum
  77   {
  78     DLS_FIXED,
  79     DLS_FREE,
  80     DLS_LIST
  81   };
  82
  83 /* DATA LIST private data structure. */
  84 struct data_list_pgm
  85   {
  86     struct trns_header h;
  87
  88     struct dls_var_spec *first, *last;  /* Variable parsing specifications. */
  89     struct dfm_reader *reader;  /* Data file reader. */
  90
  91     int type;                   /* A DLS_* constant. */
  92     struct variable *end;       /* Variable specified on END subcommand. */
  93     int eof;                    /* End of file encountered. */
  94     int rec_cnt;                /* Number of records. */
  95     size_t case_size;           /* Case size in bytes. */
  96     char *delims;               /* Delimiters if any; not null-terminated. */
  97     size_t delim_cnt;           /* Number of delimiter, or 0 for spaces. */
  98   };
  99
 100 static int parse_fixed (struct data_list_pgm *);
 101 static int parse_free (struct dls_var_spec **, struct dls_var_spec **);
 102 static void dump_fixed_table (const struct dls_var_spec *,
 103                               const struct file_handle *, int rec_cnt);
 104 static void dump_free_table (const struct data_list_pgm *,
 105                              const struct file_handle *);
 106 static void destroy_dls_var_spec (struct dls_var_spec *);
 107 static trns_free_func data_list_trns_free;
 108 static trns_proc_func data_list_trns_proc;
 109
 110 /* Message title for REPEATING DATA. */
 111 #define RPD_ERR "REPEATING DATA: "
 112
 113 int
 114 cmd_data_list (void)
 115 {
 116   struct data_list_pgm *dls;     /* DATA LIST program under construction. */
 117   int table = -1;                /* Print table if nonzero, -1=undecided. */
 118   struct file_handle *fh = NULL; /* File handle of source, NULL=inline file. */
 119
 120   if (!case_source_is_complex (vfm_source))
 121     discard_variables ();
 122
 123   dls = xmalloc (sizeof *dls);
 124   dls->reader = NULL;
 125   dls->type = -1;
 126   dls->end = NULL;
 127   dls->eof = 0;
 128   dls->rec_cnt = 0;
 129   dls->delims = NULL;
 130   dls->delim_cnt = 0;
 131   dls->first = dls->last = NULL;
 132
 133   while (token != '/')
 134     {
 135       if (lex_match_id ("FILE"))
 136         {
 137           lex_match ('=');
 138           fh = fh_parse ();
 139           if (fh == NULL)
 140             goto error;
 141           if (case_source_is_class (vfm_source, &file_type_source_class)
 142               && fh != default_handle)
 143             {
 144               msg (SE, _("DATA LIST may not use a different file from "
 145                          "that specified on its surrounding FILE TYPE."));
 146               goto error;
 147             }
 148         }
 149       else if (lex_match_id ("RECORDS"))
 150         {
 151           lex_match ('=');
 152           lex_match ('(');
 153           if (!lex_force_int ())
 154             goto error;
 155           dls->rec_cnt = lex_integer ();
 156           lex_get ();
 157           lex_match (')');
 158         }
 159       else if (lex_match_id ("END"))
 160         {
 161           if (dls->end)
 162             {
 163               msg (SE, _("The END subcommand may only be specified once."));
 164               goto error;
 165             }
 166
 167           lex_match ('=');
 168           if (!lex_force_id ())
 169             goto error;
 170           dls->end = dict_lookup_var (default_dict, tokid);
 171           if (!dls->end)
 172             dls->end = dict_create_var_assert (default_dict, tokid, 0);
 173           lex_get ();
 174         }
 175       else if (token == T_ID)
 176         {
 177           if (lex_match_id ("NOTABLE"))
 178             table = 0;
 179           else if (lex_match_id ("TABLE"))
 180             table = 1;
 181           else
 182             {
 183               int type;
 184               if (lex_match_id ("FIXED"))
 185                 type = DLS_FIXED;
 186               else if (lex_match_id ("FREE"))
 187                 type = DLS_FREE;
 188               else if (lex_match_id ("LIST"))
 189                 type = DLS_LIST;
 190               else
 191                 {
 192                   lex_error (NULL);
 193                   goto error;
 194                 }
 195
 196               if (dls->type != -1)
 197                 {
 198                   msg (SE, _("Only one of FIXED, FREE, or LIST may "
 199                              "be specified."));
 200                   goto error;
 201                 }
 202               dls->type = type;
 203
 204               if ((dls->type == DLS_FREE || dls->type == DLS_LIST)
 205                   && lex_match ('('))
 206                 {
 207                   while (!lex_match (')'))
 208                     {
 209                       int delim;
 210
 211                       if (lex_match_id ("TAB"))
 212                         delim = '\t';
 213                       else if (token == T_STRING && tokstr.length == 1)
 214                         {
 215                           delim = tokstr.string[0];
 216                           lex_get();
 217                         }
 218                       else
 219                         {
 220                           lex_error (NULL);
 221                           goto error;
 222                         }
 223
 224                       dls->delims = xrealloc (dls->delims, dls->delim_cnt + 1);
 225                       dls->delims[dls->delim_cnt++] = delim;
 226
 227                       lex_match (',');
 228                     }
 229                 }
 230             }
 231         }
 232       else
 233         {
 234           lex_error (NULL);
 235           goto error;
 236         }
 237     }
 238
 239   dls->case_size = dict_get_case_size (default_dict);
 240   default_handle = fh;
 241
 242   if (dls->type == -1)
 243     dls->type = DLS_FIXED;
 244
 245   if (table == -1)
 246     {
 247       if (dls->type == DLS_FREE)
 248         table = 0;
 249       else
 250         table = 1;
 251     }
 252
 253   if (dls->type == DLS_FIXED)
 254     {
 255       if (!parse_fixed (dls))
 256         goto error;
 257       if (table)
 258         dump_fixed_table (dls->first, fh, dls->rec_cnt);
 259     }
 260   else
 261     {
 262       if (!parse_free (&dls->first, &dls->last))
 263         goto error;
 264       if (table)
 265         dump_free_table (dls, fh);
 266     }
 267
 268   dls->reader = dfm_open_reader (fh);
 269   if (dls->reader == NULL)
 270     goto error;
 271
 272   if (vfm_source != NULL)
 273     {
 274       dls->h.proc = data_list_trns_proc;
 275       dls->h.free = data_list_trns_free;
 276       add_transformation (&dls->h);
 277     }
 278   else
 279     vfm_source = create_case_source (&data_list_source_class, dls);
 280
 281   return CMD_SUCCESS;
 282
 283  error:
 284   destroy_dls_var_spec (dls->first);
 285   free (dls->delims);
 286   free (dls);
 287   return CMD_FAILURE;
 288 }
 289
 290 /* Adds SPEC to the linked list with head at FIRST and tail at
 291    LAST. */
 292 static void
 293 append_var_spec (struct dls_var_spec **first, struct dls_var_spec **last,
 294                  struct dls_var_spec *spec)
 295 {
 296   spec->next = NULL;
 297
 298   if (*first == NULL)
 299     *first = spec;
 300   else
 301     (*last)->next = spec;
 302   *last = spec;
 303 }
 304 \f
 305 /* Fixed-format parsing. */
 306
 307 /* Used for chaining together fortran-like format specifiers. */
 308 struct fmt_list
 309   {
 310     struct fmt_list *next;
 311     int count;
 312     struct fmt_spec f;
 313     struct fmt_list *down;
 314   };
 315
 316 /* State of parsing DATA LIST. */
 317 struct fixed_parsing_state
 318   {
 319     char **name;                /* Variable names. */
 320     int name_cnt;               /* Number of names. */
 321
 322     int recno;                  /* Index of current record. */
 323     int sc;                     /* 1-based column number of starting column for
 324                                    next field to output. */
 325   };
 326
 327 static int fixed_parse_compatible (struct fixed_parsing_state *,
 328                                    struct dls_var_spec **,
 329                                    struct dls_var_spec **);
 330 static int fixed_parse_fortran (struct fixed_parsing_state *,
 331                                 struct dls_var_spec **,
 332                                 struct dls_var_spec **);
 333
 334 /* Parses all the variable specifications for DATA LIST FIXED,
 335    storing them into DLS.  Returns nonzero if successful. */
 336 static int
 337 parse_fixed (struct data_list_pgm *dls)
 338 {
 339   struct fixed_parsing_state fx;
 340   int i;
 341
 342   fx.recno = 0;
 343   fx.sc = 1;
 344
 345   while (token != '.')
 346     {
 347       while (lex_match ('/'))
 348         {
 349           fx.recno++;
 350           if (lex_is_integer ())
 351             {
 352               if (lex_integer () < fx.recno)
 353                 {
 354                   msg (SE, _("The record number specified, %ld, is "
 355                              "before the previous record, %d.  Data "
 356                              "fields must be listed in order of "
 357                              "increasing record number."),
 358                        lex_integer (), fx.recno - 1);
 359                   return 0;
 360                 }
 361
 362               fx.recno = lex_integer ();
 363               lex_get ();
 364             }
 365           fx.sc = 1;
 366         }
 367
 368       if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
 369         return 0;
 370
 371       if (lex_is_number ())
 372         {
 373           if (!fixed_parse_compatible (&fx, &dls->first, &dls->last))
 374             goto fail;
 375         }
 376       else if (token == '(')
 377         {
 378           if (!fixed_parse_fortran (&fx, &dls->first, &dls->last))
 379             goto fail;
 380         }
 381       else
 382         {
 383           msg (SE, _("SPSS-like or FORTRAN-like format "
 384                      "specification expected after variable names."));
 385           goto fail;
 386         }
 387
 388       for (i = 0; i < fx.name_cnt; i++)
 389         free (fx.name[i]);
 390       free (fx.name);
 391     }
 392   if (dls->first == NULL)
 393     {
 394       msg (SE, _("At least one variable must be specified."));
 395       return 0;
 396     }
 397   if (dls->rec_cnt && dls->last->rec > dls->rec_cnt)
 398     {
 399       msg (SE, _("Variables are specified on records that "
 400                  "should not exist according to RECORDS subcommand."));
 401       return 0;
 402     }
 403   else if (!dls->rec_cnt)
 404     dls->rec_cnt = dls->last->rec;
 405   return lex_end_of_command () == CMD_SUCCESS;
 406
 407 fail:
 408   for (i = 0; i < fx.name_cnt; i++)
 409     free (fx.name[i]);
 410   free (fx.name);
 411   return 0;
 412 }
 413
 414 /* Parses a variable specification in the form 1-10 (A) based on
 415    FX and adds specifications to the linked list with head at
 416    FIRST and tail at LAST. */
 417 static int
 418 fixed_parse_compatible (struct fixed_parsing_state *fx,
 419                         struct dls_var_spec **first, struct dls_var_spec **last)
 420 {
 421   struct fmt_spec input;
 422   int fc, lc;
 423   int width;
 424   int i;
 425
 426   /* First column. */
 427   if (!lex_force_int ())
 428     return 0;
 429   fc = lex_integer ();
 430   if (fc < 1)
 431     {
 432       msg (SE, _("Column positions for fields must be positive."));
 433       return 0;
 434     }
 435   lex_get ();
 436
 437   /* Last column. */
 438   lex_negative_to_dash ();
 439   if (lex_match ('-'))
 440     {
 441       if (!lex_force_int ())
 442         return 0;
 443       lc = lex_integer ();
 444       if (lc < 1)
 445         {
 446           msg (SE, _("Column positions for fields must be positive."));
 447           return 0;
 448         }
 449       else if (lc < fc)
 450         {
 451           msg (SE, _("The ending column for a field must be "
 452                      "greater than the starting column."));
 453           return 0;
 454         }
 455
 456       lex_get ();
 457     }
 458   else
 459     lc = fc;
 460
 461   /* Divide columns evenly. */
 462   input.w = (lc - fc + 1) / fx->name_cnt;
 463   if ((lc - fc + 1) % fx->name_cnt)
 464     {
 465       msg (SE, _("The %d columns %d-%d "
 466                  "can't be evenly divided into %d fields."),
 467            lc - fc + 1, fc, lc, fx->name_cnt);
 468       return 0;
 469     }
 470
 471   /* Format specifier. */
 472   if (lex_match ('('))
 473     {
 474       struct fmt_desc *fdp;
 475
 476       if (token == T_ID)
 477         {
 478           const char *cp;
 479
 480           input.type = parse_format_specifier_name (&cp, 0);
 481           if (input.type == -1)
 482             return 0;
 483           if (*cp)
 484             {
 485               msg (SE, _("A format specifier on this line "
 486                          "has extra characters on the end."));
 487               return 0;
 488             }
 489
 490           lex_get ();
 491           lex_match (',');
 492         }
 493       else
 494         input.type = FMT_F;
 495
 496       if (lex_is_integer ())
 497         {
 498           if (lex_integer () < 1)
 499             {
 500               msg (SE, _("The value for number of decimal places "
 501                          "must be at least 1."));
 502               return 0;
 503             }
 504
 505           input.d = lex_integer ();
 506           lex_get ();
 507         }
 508       else
 509         input.d = 0;
 510
 511       fdp = &formats[input.type];
 512       if (fdp->n_args < 2 && input.d)
 513         {
 514           msg (SE, _("Input format %s doesn't accept decimal places."),
 515                fdp->name);
 516           return 0;
 517         }
 518
 519       if (input.d > 16)
 520         input.d = 16;
 521
 522       if (!lex_force_match (')'))
 523         return 0;
 524     }
 525   else
 526     {
 527       input.type = FMT_F;
 528       input.d = 0;
 529     }
 530   if (!check_input_specifier (&input, 1))
 531     return 0;
 532
 533   /* Start column for next specification. */
 534   fx->sc = lc + 1;
 535
 536   /* Width of variables to create. */
 537   if (input.type == FMT_A || input.type == FMT_AHEX)
 538     width = input.w;
 539   else
 540     width = 0;
 541
 542   /* Create variables and var specs. */
 543   for (i = 0; i < fx->name_cnt; i++)
 544     {
 545       struct dls_var_spec *spec;
 546       struct variable *v;
 547
 548       v = dict_create_var (default_dict, fx->name[i], width);
 549       if (v != NULL)
 550         {
 551           convert_fmt_ItoO (&input, &v->print);
 552           v->write = v->print;
 553           if (!case_source_is_complex (vfm_source))
 554             v->init = 0;
 555         }
 556       else
 557         {
 558           v = dict_lookup_var_assert (default_dict, fx->name[i]);
 559           if (vfm_source == NULL)
 560             {
 561               msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
 562               return 0;
 563             }
 564           if ((width != 0) != (v->width != 0))
 565             {
 566               msg (SE, _("There is already a variable %s of a "
 567                          "different type."),
 568                    fx->name[i]);
 569               return 0;
 570             }
 571           if (width != 0 && width != v->width)
 572             {
 573               msg (SE, _("There is already a string variable %s of a "
 574                          "different width."), fx->name[i]);
 575               return 0;
 576             }
 577         }
 578
 579       spec = xmalloc (sizeof *spec);
 580       spec->input = input;
 581       spec->v = v;
 582       spec->fv = v->fv;
 583       spec->rec = fx->recno;
 584       spec->fc = fc + input.w * i;
 585       spec->lc = spec->fc + input.w - 1;
 586       append_var_spec (first, last, spec);
 587     }
 588   return 1;
 589 }
 590
 591 /* Destroy format list F and, if RECURSE is nonzero, all its
 592    sublists. */
 593 static void
 594 destroy_fmt_list (struct fmt_list *f, int recurse)
 595 {
 596   struct fmt_list *next;
 597
 598   for (; f; f = next)
 599     {
 600       next = f->next;
 601       if (recurse && f->f.type == FMT_DESCEND)
 602         destroy_fmt_list (f->down, 1);
 603       free (f);
 604     }
 605 }
 606
 607 /* Takes a hierarchically structured fmt_list F as constructed by
 608    fixed_parse_fortran(), and flattens it, adding the variable
 609    specifications to the linked list with head FIRST and tail
 610    LAST.  NAME_IDX is used to take values from the list of names
 611    in FX; it should initially point to a value of 0. */
 612 static int
 613 dump_fmt_list (struct fixed_parsing_state *fx, struct fmt_list *f,
 614                struct dls_var_spec **first, struct dls_var_spec **last,
 615                int *name_idx)
 616 {
 617   int i;
 618
 619   for (; f; f = f->next)
 620     if (f->f.type == FMT_X)
 621       fx->sc += f->count;
 622     else if (f->f.type == FMT_T)
 623       fx->sc = f->f.w;
 624     else if (f->f.type == FMT_NEWREC)
 625       {
 626         fx->recno += f->count;
 627         fx->sc = 1;
 628       }
 629     else
 630       for (i = 0; i < f->count; i++)
 631         if (f->f.type == FMT_DESCEND)
 632           {
 633             if (!dump_fmt_list (fx, f->down, first, last, name_idx))
 634               return 0;
 635           }
 636         else
 637           {
 638             struct dls_var_spec *spec;
 639             int width;
 640             struct variable *v;
 641
 642             if (formats[f->f.type].cat & FCAT_STRING)
 643               width = f->f.w;
 644             else
 645               width = 0;
 646             if (*name_idx >= fx->name_cnt)
 647               {
 648                 msg (SE, _("The number of format "
 649                            "specifications exceeds the given number of "
 650                            "variable names."));
 651                 return 0;
 652               }
 653
 654             v = dict_create_var (default_dict, fx->name[(*name_idx)++], width);
 655             if (!v)
 656               {
 657                 msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
 658                 return 0;
 659               }
 660
 661             if (!case_source_is_complex (vfm_source))
 662               v->init = 0;
 663
 664             spec = xmalloc (sizeof *spec);
 665             spec->v = v;
 666             spec->input = f->f;
 667             spec->fv = v->fv;
 668             spec->rec = fx->recno;
 669             spec->fc = fx->sc;
 670             spec->lc = fx->sc + f->f.w - 1;
 671             append_var_spec (first, last, spec);
 672
 673             convert_fmt_ItoO (&spec->input, &v->print);
 674             v->write = v->print;
 675
 676             fx->sc += f->f.w;
 677           }
 678   return 1;
 679 }
 680
 681 /* Recursively parses a FORTRAN-like format specification into
 682    the linked list with head FIRST and tail TAIL.  LEVEL is the
 683    level of recursion, starting from 0.  Returns the parsed
 684    specification if successful, or a null pointer on failure.  */
 685 static struct fmt_list *
 686 fixed_parse_fortran_internal (struct fixed_parsing_state *fx,
 687                               struct dls_var_spec **first,
 688                               struct dls_var_spec **last)
 689 {
 690   struct fmt_list *head = NULL;
 691   struct fmt_list *tail = NULL;
 692
 693   lex_force_match ('(');
 694   while (token != ')')
 695     {
 696       /* New fmt_list. */
 697       struct fmt_list *new = xmalloc (sizeof *new);
 698       new->next = NULL;
 699
 700       /* Append new to list. */
 701       if (head != NULL)
 702         tail->next = new;
 703       else
 704         head = new;
 705       tail = new;
 706
 707       /* Parse count. */
 708       if (lex_is_integer ())
 709         {
 710           new->count = lex_integer ();
 711           lex_get ();
 712         }
 713       else
 714         new->count = 1;
 715
 716       /* Parse format specifier. */
 717       if (token == '(')
 718         {
 719           new->f.type = FMT_DESCEND;
 720           new->down = fixed_parse_fortran_internal (fx, first, last);
 721           if (new->down == NULL)
 722             goto fail;
 723         }
 724       else if (lex_match ('/'))
 725         new->f.type = FMT_NEWREC;
 726       else if (!parse_format_specifier (&new->f, FMTP_ALLOW_XT)
 727                || !check_input_specifier (&new->f, 1))
 728         goto fail;
 729
 730       lex_match (',');
 731     }
 732   lex_force_match (')');
 733
 734   return head;
 735
 736 fail:
 737   destroy_fmt_list (head, 0);
 738
 739   return NULL;
 740 }
 741
 742 /* Parses a FORTRAN-like format specification into the linked
 743    list with head FIRST and tail LAST.  Returns nonzero if
 744    successful. */
 745 static int
 746 fixed_parse_fortran (struct fixed_parsing_state *fx,
 747                      struct dls_var_spec **first, struct dls_var_spec **last)
 748 {
 749   struct fmt_list *list;
 750   int name_idx;
 751
 752   list = fixed_parse_fortran_internal (fx, first, last);
 753   if (list == NULL)
 754     return 0;
 755
 756   name_idx = 0;
 757   dump_fmt_list (fx, list, first, last, &name_idx);
 758   destroy_fmt_list (list, 1);
 759   if (name_idx < fx->name_cnt)
 760     {
 761       msg (SE, _("There aren't enough format specifications "
 762                  "to match the number of variable names given."));
 763       return 0;
 764     }
 765
 766   return 1;
 767 }
 768
 769 /* Displays a table giving information on fixed-format variable
 770    parsing on DATA LIST. */
 771 /* FIXME: The `Columns' column should be divided into three columns,
 772    one for the starting column, one for the dash, one for the ending
 773    column; then right-justify the starting column and left-justify the
 774    ending column. */
 775 static void
 776 dump_fixed_table (const struct dls_var_spec *specs,
 777                   const struct file_handle *fh, int rec_cnt)
 778 {
 779   const struct dls_var_spec *spec;
 780   struct tab_table *t;
 781   int i;
 782
 783   for (i = 0, spec = specs; spec; spec = spec->next)
 784     i++;
 785   t = tab_create (4, i + 1, 0);
 786   tab_columns (t, TAB_COL_DOWN, 1);
 787   tab_headers (t, 0, 0, 1, 0);
 788   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 789   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
 790   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
 791   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 792   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, i);
 793   tab_hline (t, TAL_2, 0, 3, 1);
 794   tab_dim (t, tab_natural_dimensions);
 795
 796   for (i = 1, spec = specs; spec; spec = spec->next, i++)
 797     {
 798       tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 799       tab_text (t, 1, i, TAT_PRINTF, "%d", spec->rec);
 800       tab_text (t, 2, i, TAT_PRINTF, "%3d-%3d",
 801                     spec->fc, spec->lc);
 802       tab_text (t, 3, i, TAB_LEFT | TAT_FIX,
 803                     fmt_to_string (&spec->input));
 804     }
 805
 806   if (fh != NULL)
 807     tab_title (t, 1, ngettext ("Reading %d record from file %s.",
 808                                "Reading %d records from file %s.", rec_cnt),
 809                rec_cnt, handle_get_filename (fh));
 810   else
 811     tab_title (t, 1, ngettext ("Reading %d record from the command file.",
 812                                "Reading %d records from the command file.",
 813                                rec_cnt),
 814                rec_cnt);
 815   tab_submit (t);
 816 }
 817 \f
 818 /* Free-format parsing. */
 819
 820 /* Parses variable specifications for DATA LIST FREE and adds
 821    them to the linked list with head FIRST and tail LAST.
 822    Returns nonzero only if successful. */
 823 static int
 824 parse_free (struct dls_var_spec **first, struct dls_var_spec **last)
 825 {
 826   lex_get ();
 827   while (token != '.')
 828     {
 829       struct fmt_spec input, output;
 830       char **name;
 831       int name_cnt;
 832       int width;
 833       int i;
 834
 835       if (!parse_DATA_LIST_vars (&name, &name_cnt, PV_NONE))
 836         return 0;
 837
 838       if (lex_match ('('))
 839         {
 840           if (!parse_format_specifier (&input, 0)
 841               || !check_input_specifier (&input, 1)
 842               || !lex_force_match (')'))
 843             {
 844               for (i = 0; i < name_cnt; i++)
 845                 free (name[i]);
 846               free (name);
 847               return 0;
 848             }
 849           convert_fmt_ItoO (&input, &output);
 850         }
 851       else
 852         {
 853           lex_match ('*');
 854           input = make_input_format (FMT_F, 8, 0);
 855           output = get_format ();
 856         }
 857
 858       if (input.type == FMT_A || input.type == FMT_AHEX)
 859         width = input.w;
 860       else
 861         width = 0;
 862       for (i = 0; i < name_cnt; i++)
 863         {
 864           struct dls_var_spec *spec;
 865           struct variable *v;
 866
 867           v = dict_create_var (default_dict, name[i], width);
 868
 869           if (!v)
 870             {
 871               msg (SE, _("%s is a duplicate variable name."), name[i]);
 872               return 0;
 873             }
 874           v->print = v->write = output;
 875
 876           if (!case_source_is_complex (vfm_source))
 877             v->init = 0;
 878
 879           spec = xmalloc (sizeof *spec);
 880           spec->input = input;
 881           spec->v = v;
 882           spec->fv = v->fv;
 883           str_copy_trunc (spec->name, sizeof spec->name, v->name);
 884           append_var_spec (first, last, spec);
 885         }
 886       for (i = 0; i < name_cnt; i++)
 887         free (name[i]);
 888       free (name);
 889     }
 890
 891   return lex_end_of_command () == CMD_SUCCESS;
 892 }
 893
 894 /* Displays a table giving information on free-format variable parsing
 895    on DATA LIST. */
 896 static void
 897 dump_free_table (const struct data_list_pgm *dls,
 898                  const struct file_handle *fh)
 899 {
 900   struct tab_table *t;
 901   int i;
 902
 903   {
 904     struct dls_var_spec *spec;
 905     for (i = 0, spec = dls->first; spec; spec = spec->next)
 906       i++;
 907   }
 908
 909   t = tab_create (2, i + 1, 0);
 910   tab_columns (t, TAB_COL_DOWN, 1);
 911   tab_headers (t, 0, 0, 1, 0);
 912   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 913   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 914   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
 915   tab_hline (t, TAL_2, 0, 1, 1);
 916   tab_dim (t, tab_natural_dimensions);
 917
 918   {
 919     struct dls_var_spec *spec;
 920
 921     for (i = 1, spec = dls->first; spec; spec = spec->next, i++)
 922       {
 923         tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 924         tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
 925       }
 926   }
 927
 928   if (fh != NULL)
 929     tab_title (t, 1, _("Reading free-form data from file %s."),
 930                handle_get_filename (fh));
 931   else
 932     tab_title (t, 1, _("Reading free-form data from the command file."));
 933
 934   tab_submit (t);
 935 }
 936 \f
 937 /* Input procedure. */
 938
 939 /* Extracts a field from the current position in the current
 940    record.  Fields can be unquoted or quoted with single- or
 941    double-quote characters.  *FIELD is set to the field content.
 942    After parsing the field, sets the current position in the
 943    record to just past the field and any trailing delimiter.
 944    END_BLANK is used internally; it should be initialized by the
 945    caller to 0 and left alone afterward.  Returns 0 on failure or
 946    a 1-based column number indicating the beginning of the field
 947    on success. */
 948 static int
 949 cut_field (const struct data_list_pgm *dls, struct fixed_string *field,
 950            int *end_blank)
 951 {
 952   struct fixed_string line;
 953   char *cp;
 954   size_t column_start;
 955
 956   if (dfm_eof (dls->reader))
 957     return 0;
 958   if (dls->delim_cnt == 0)
 959     dfm_expand_tabs (dls->reader);
 960   dfm_get_record (dls->reader, &line);
 961
 962   cp = ls_c_str (&line);
 963   if (dls->delim_cnt == 0)
 964     {
 965       /* Skip leading whitespace. */
 966       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
 967         cp++;
 968       if (cp >= ls_end (&line))
 969         return 0;
 970
 971       /* Handle actual data, whether quoted or unquoted. */
 972       if (*cp == '\'' || *cp == '"')
 973         {
 974           int quote = *cp;
 975
 976           field->string = ++cp;
 977           while (cp < ls_end (&line) && *cp != quote)
 978             cp++;
 979           field->length = cp - field->string;
 980           if (cp < ls_end (&line))
 981             cp++;
 982           else
 983             msg (SW, _("Quoted string missing terminating `%c'."), quote);
 984         }
 985       else
 986         {
 987           field->string = cp;
 988           while (cp < ls_end (&line)
 989                  && !isspace ((unsigned char) *cp) && *cp != ',')
 990             cp++;
 991           field->length = cp - field->string;
 992         }
 993
 994       /* Skip trailing whitespace and a single comma if present. */
 995       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
 996         cp++;
 997       if (cp < ls_end (&line) && *cp == ',')
 998         cp++;
 999     }
1000   else
1001     {
1002       if (cp >= ls_end (&line))
1003         {
1004           int column = dfm_column_start (dls->reader);
1005                /* A blank line or a line that ends in \t has a
1006              trailing blank field. */
1007           if (column == 1 || (column > 1 && cp[-1] == '\t'))
1008             {
1009               if (*end_blank == 0)
1010                 {
1011                   *end_blank = 1;
1012                   field->string = ls_end (&line);
1013                   field->length = 0;
1014                   dfm_forward_record (dls->reader);
1015                   return column;
1016                 }
1017               else
1018                 {
1019                   *end_blank = 0;
1020                   return 0;
1021                 }
1022             }
1023           else
1024             return 0;
1025         }
1026       else
1027         {
1028           field->string = cp;
1029           while (cp < ls_end (&line)
1030                  && memchr (dls->delims, *cp, dls->delim_cnt) == NULL)
1031             cp++;
1032           field->length = cp - field->string;
1033           if (cp < ls_end (&line))
1034             cp++;
1035         }
1036     }
1037
1038   dfm_forward_columns (dls->reader, field->string - line.string);
1039   column_start = dfm_column_start (dls->reader);
1040
1041   dfm_forward_columns (dls->reader, cp - field->string);
1042
1043   return column_start;
1044 }
1045
1046 typedef int data_list_read_func (const struct data_list_pgm *, struct ccase *);
1047 static data_list_read_func read_from_data_list_fixed;
1048 static data_list_read_func read_from_data_list_free;
1049 static data_list_read_func read_from_data_list_list;
1050
1051 /* Returns the proper function to read the kind of DATA LIST
1052    data specified by DLS. */
1053 static data_list_read_func *
1054 get_data_list_read_func (const struct data_list_pgm *dls)
1055 {
1056   switch (dls->type)
1057     {
1058     case DLS_FIXED:
1059       return read_from_data_list_fixed;
1060
1061     case DLS_FREE:
1062       return read_from_data_list_free;
1063
1064     case DLS_LIST:
1065       return read_from_data_list_list;
1066
1067     default:
1068       assert (0);
1069       abort ();
1070     }
1071 }
1072
1073 /* Reads a case from the data file into C, parsing it according
1074    to fixed-format syntax rules in DLS.  Returns -1 on success,
1075    -2 at end of file. */
1076 static int
1077 read_from_data_list_fixed (const struct data_list_pgm *dls,
1078                            struct ccase *c)
1079 {
1080   struct dls_var_spec *var_spec = dls->first;
1081   int i;
1082
1083   if (dfm_eof (dls->reader))
1084     return -2;
1085   for (i = 1; i <= dls->rec_cnt; i++)
1086     {
1087       struct fixed_string line;
1088
1089       if (dfm_eof (dls->reader))
1090         {
1091           /* Note that this can't occur on the first record. */
1092           msg (SW, _("Partial case of %d of %d records discarded."),
1093                i - 1, dls->rec_cnt);
1094           return -2;
1095         }
1096       dfm_expand_tabs (dls->reader);
1097       dfm_get_record (dls->reader, &line);
1098
1099       for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
1100         {
1101           struct data_in di;
1102
1103           data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
1104                                var_spec->fc, var_spec->lc);
1105           di.v = case_data_rw (c, var_spec->fv);
1106           di.flags = DI_IMPLIED_DECIMALS;
1107           di.f1 = var_spec->fc;
1108           di.format = var_spec->input;
1109
1110           data_in (&di);
1111         }
1112
1113       dfm_forward_record (dls->reader);
1114     }
1115
1116   return -1;
1117 }
1118
1119 /* Reads a case from the data file into C, parsing it according
1120    to free-format syntax rules in DLS.  Returns -1 on success,
1121    -2 at end of file. */
1122 static int
1123 read_from_data_list_free (const struct data_list_pgm *dls,
1124                           struct ccase *c)
1125 {
1126   struct dls_var_spec *var_spec;
1127   int end_blank = 0;
1128
1129   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1130     {
1131       struct fixed_string field;
1132       int column;
1133
1134       /* Cut out a field and read in a new record if necessary. */
1135       for (;;)
1136         {
1137           column = cut_field (dls, &field, &end_blank);
1138           if (column != 0)
1139             break;
1140
1141           if (!dfm_eof (dls->reader))
1142             dfm_forward_record (dls->reader);
1143           if (dfm_eof (dls->reader))
1144             {
1145               if (var_spec != dls->first)
1146                 msg (SW, _("Partial case discarded.  The first variable "
1147                            "missing was %s."), var_spec->name);
1148               return -2;
1149             }
1150         }
1151
1152       {
1153         struct data_in di;
1154
1155         di.s = ls_c_str (&field);
1156         di.e = ls_end (&field);
1157         di.v = case_data_rw (c, var_spec->fv);
1158         di.flags = 0;
1159         di.f1 = column;
1160         di.format = var_spec->input;
1161         data_in (&di);
1162       }
1163     }
1164   return -1;
1165 }
1166
1167 /* Reads a case from the data file and parses it according to
1168    list-format syntax rules.  Returns -1 on success, -2 at end of
1169    file. */
1170 static int
1171 read_from_data_list_list (const struct data_list_pgm *dls,
1172                           struct ccase *c)
1173 {
1174   struct dls_var_spec *var_spec;
1175   int end_blank = 0;
1176
1177   if (dfm_eof (dls->reader))
1178     return -2;
1179
1180   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1181     {
1182       struct fixed_string field;
1183       int column;
1184
1185       /* Cut out a field and check for end-of-line. */
1186       column = cut_field (dls, &field, &end_blank);
1187       if (column == 0)
1188         {
1189           if (get_undefined ())
1190             msg (SW, _("Missing value(s) for all variables from %s onward.  "
1191                        "These will be filled with the system-missing value "
1192                        "or blanks, as appropriate."),
1193                  var_spec->name);
1194           for (; var_spec; var_spec = var_spec->next)
1195             {
1196               int width = get_format_var_width (&var_spec->input);
1197               if (width == 0)
1198                 case_data_rw (c, var_spec->fv)->f = SYSMIS;
1199               else
1200                 memset (case_data_rw (c, var_spec->fv)->s, ' ', width);
1201             }
1202           break;
1203         }
1204
1205       {
1206         struct data_in di;
1207
1208         di.s = ls_c_str (&field);
1209         di.e = ls_end (&field);
1210         di.v = case_data_rw (c, var_spec->fv);
1211         di.flags = 0;
1212         di.f1 = column;
1213         di.format = var_spec->input;
1214         data_in (&di);
1215       }
1216     }
1217
1218   dfm_forward_record (dls->reader);
1219   return -1;
1220 }
1221
1222 /* Destroys SPEC. */
1223 static void
1224 destroy_dls_var_spec (struct dls_var_spec *spec)
1225 {
1226   struct dls_var_spec *next;
1227
1228   while (spec != NULL)
1229     {
1230       next = spec->next;
1231       free (spec);
1232       spec = next;
1233     }
1234 }
1235
1236 /* Destroys DATA LIST transformation PGM. */
1237 static void
1238 data_list_trns_free (struct trns_header *pgm)
1239 {
1240   struct data_list_pgm *dls = (struct data_list_pgm *) pgm;
1241   free (dls->delims);
1242   destroy_dls_var_spec (dls->first);
1243   dfm_close_reader (dls->reader);
1244 }
1245
1246 /* Handle DATA LIST transformation T, parsing data into C. */
1247 static int
1248 data_list_trns_proc (struct trns_header *t, struct ccase *c,
1249                      int case_num UNUSED)
1250 {
1251   struct data_list_pgm *dls = (struct data_list_pgm *) t;
1252   data_list_read_func *read_func;
1253   int retval;
1254
1255   dfm_push (dls->reader);
1256
1257   read_func = get_data_list_read_func (dls);
1258   retval = read_func (dls, c);
1259
1260   /* Handle end of file. */
1261   if (retval == -2)
1262     {
1263       /* If we already encountered end of file then this is an
1264          error. */
1265       if (dls->eof == 1)
1266         {
1267           msg (SE, _("Attempt to read past end of file."));
1268           err_failure ();
1269           dfm_pop (dls->reader);
1270           return -2;
1271         }
1272
1273       /* Otherwise simply note it. */
1274       dls->eof = 1;
1275     }
1276   else
1277     dls->eof = 0;
1278
1279   /* If there was an END subcommand handle it. */
1280   if (dls->end != NULL)
1281     {
1282       if (retval == -2)
1283         {
1284           case_data_rw (c, dls->end->fv)->f = 1.0;
1285           retval = -1;
1286         }
1287       else
1288         case_data_rw (c, dls->end->fv)->f = 0.0;
1289     }
1290
1291   dfm_pop (dls->reader);
1292
1293   return retval;
1294 }
1295 \f
1296 /* Reads all the records from the data file and passes them to
1297    write_case(). */
1298 static void
1299 data_list_source_read (struct case_source *source,
1300                        struct ccase *c,
1301                        write_case_func *write_case, write_case_data wc_data)
1302 {
1303   struct data_list_pgm *dls = source->aux;
1304   data_list_read_func *read_func = get_data_list_read_func (dls);
1305
1306   dfm_push (dls->reader);
1307   while (read_func (dls, c) != -2)
1308     if (!write_case (wc_data))
1309       break;
1310   dfm_pop (dls->reader);
1311 }
1312
1313 /* Destroys the source's internal data. */
1314 static void
1315 data_list_source_destroy (struct case_source *source)
1316 {
1317   data_list_trns_free (source->aux);
1318   free (source->aux);
1319 }
1320
1321 const struct case_source_class data_list_source_class =
1322   {
1323     "DATA LIST",
1324     NULL,
1325     data_list_source_read,
1326     data_list_source_destroy,
1327   };
1328 \f
1329 /* REPEATING DATA. */
1330
1331 /* Represents a number or a variable. */
1332 struct rpd_num_or_var
1333   {
1334     int num;                    /* Value, or 0. */
1335     struct variable *var;       /* Variable, if number==0. */
1336   };
1337
1338 /* REPEATING DATA private data structure. */
1339 struct repeating_data_trns
1340   {
1341     struct trns_header h;
1342     struct dls_var_spec *first, *last;  /* Variable parsing specifications. */
1343     struct dfm_reader *reader;          /* Input file, never NULL. */
1344
1345     struct rpd_num_or_var starts_beg;   /* STARTS=, before the dash. */
1346     struct rpd_num_or_var starts_end;   /* STARTS=, after the dash. */
1347     struct rpd_num_or_var occurs;       /* OCCURS= subcommand. */
1348     struct rpd_num_or_var length;       /* LENGTH= subcommand. */
1349     struct rpd_num_or_var cont_beg;     /* CONTINUED=, before the dash. */
1350     struct rpd_num_or_var cont_end;     /* CONTINUED=, after the dash. */
1351
1352     /* ID subcommand. */
1353     int id_beg, id_end;                 /* Beginning & end columns. */
1354     struct variable *id_var;            /* DATA LIST variable. */
1355     struct fmt_spec id_spec;            /* Input format spec. */
1356     union value *id_value;              /* ID value. */
1357
1358     write_case_func *write_case;
1359     write_case_data wc_data;
1360   };
1361
1362 static trns_free_func repeating_data_trns_free;
1363 static int parse_num_or_var (struct rpd_num_or_var *, const char *);
1364 static int parse_repeating_data (struct dls_var_spec **,
1365                                  struct dls_var_spec **);
1366 static void find_variable_input_spec (struct variable *v,
1367                                       struct fmt_spec *spec);
1368
1369 /* Parses the REPEATING DATA command. */
1370 int
1371 cmd_repeating_data (void)
1372 {
1373   struct repeating_data_trns *rpd;
1374   int table = 1;                /* Print table? */
1375   bool saw_starts = false;      /* Saw STARTS subcommand? */
1376   bool saw_occurs = false;      /* Saw OCCURS subcommand? */
1377   bool saw_length = false;      /* Saw LENGTH subcommand? */
1378   bool saw_continued = false;   /* Saw CONTINUED subcommand? */
1379   bool saw_id = false;          /* Saw ID subcommand? */
1380   struct file_handle *const fh = default_handle;
1381
1382   assert (case_source_is_complex (vfm_source));
1383
1384   rpd = xmalloc (sizeof *rpd);
1385   rpd->reader = dfm_open_reader (default_handle);
1386   rpd->first = rpd->last = NULL;
1387   rpd->starts_beg.num = 0;
1388   rpd->starts_beg.var = NULL;
1389   rpd->starts_end = rpd->occurs = rpd->length = rpd->cont_beg
1390     = rpd->cont_end = rpd->starts_beg;
1391   rpd->id_beg = rpd->id_end = 0;
1392   rpd->id_var = NULL;
1393   rpd->id_value = NULL;
1394
1395   lex_match ('/');
1396
1397   for (;;)
1398     {
1399       if (lex_match_id ("FILE"))
1400         {
1401           struct file_handle *file;
1402           lex_match ('=');
1403           file = fh_parse ();
1404           if (file == NULL)
1405             goto error;
1406           if (file != fh)
1407             {
1408               msg (SE, _("REPEATING DATA must use the same file as its "
1409                          "corresponding DATA LIST or FILE TYPE."));
1410               goto error;
1411             }
1412         }
1413       else if (lex_match_id ("STARTS"))
1414         {
1415           lex_match ('=');
1416           if (saw_starts)
1417             {
1418               msg (SE, _("%s subcommand given multiple times."),"STARTS");
1419               goto error;
1420             }
1421           saw_starts = true;
1422
1423           if (!parse_num_or_var (&rpd->starts_beg, "STARTS beginning column"))
1424             goto error;
1425
1426           lex_negative_to_dash ();
1427           if (lex_match ('-'))
1428             {
1429               if (!parse_num_or_var (&rpd->starts_end, "STARTS ending column"))
1430                 goto error;
1431             } else {
1432               /* Otherwise, rpd->starts_end is uninitialized.  We
1433                  will initialize it later from the record length
1434                  of the file.  We can't do so now because the
1435                  file handle may not be specified yet. */
1436             }
1437
1438           if (rpd->starts_beg.num != 0 && rpd->starts_end.num != 0
1439               && rpd->starts_beg.num > rpd->starts_end.num)
1440             {
1441               msg (SE, _("STARTS beginning column (%d) exceeds "
1442                          "STARTS ending column (%d)."),
1443                    rpd->starts_beg.num, rpd->starts_end.num);
1444               goto error;
1445             }
1446         }
1447       else if (lex_match_id ("OCCURS"))
1448         {
1449           lex_match ('=');
1450           if (saw_occurs)
1451             {
1452               msg (SE, _("%s subcommand given multiple times."),"OCCURS");
1453               goto error;
1454             }
1455           saw_occurs |= 2;
1456
1457           if (!parse_num_or_var (&rpd->occurs, "OCCURS"))
1458             goto error;
1459         }
1460       else if (lex_match_id ("LENGTH"))
1461         {
1462           lex_match ('=');
1463           if (saw_length & 4)
1464             {
1465               msg (SE, _("%s subcommand given multiple times."),"LENGTH");
1466               goto error;
1467             }
1468           saw_length |= 4;
1469
1470           if (!parse_num_or_var (&rpd->length, "LENGTH"))
1471             goto error;
1472         }
1473       else if (lex_match_id ("CONTINUED"))
1474         {
1475           lex_match ('=');
1476           if (saw_continued & 8)
1477             {
1478               msg (SE, _("%s subcommand given multiple times."),"CONTINUED");
1479               goto error;
1480             }
1481           saw_continued |= 8;
1482
1483           if (!lex_match ('/'))
1484             {
1485               if (!parse_num_or_var (&rpd->cont_beg,
1486                                      "CONTINUED beginning column"))
1487                 goto error;
1488
1489               lex_negative_to_dash ();
1490               if (lex_match ('-')
1491                   && !parse_num_or_var (&rpd->cont_end,
1492                                         "CONTINUED ending column"))
1493                 goto error;
1494
1495               if (rpd->cont_beg.num != 0 && rpd->cont_end.num != 0
1496                   && rpd->cont_beg.num > rpd->cont_end.num)
1497                 {
1498                   msg (SE, _("CONTINUED beginning column (%d) exceeds "
1499                              "CONTINUED ending column (%d)."),
1500                        rpd->cont_beg.num, rpd->cont_end.num);
1501                   goto error;
1502                 }
1503             }
1504           else
1505             rpd->cont_beg.num = 1;
1506         }
1507       else if (lex_match_id ("ID"))
1508         {
1509           lex_match ('=');
1510           if (saw_id & 16)
1511             {
1512               msg (SE, _("%s subcommand given multiple times."),"ID");
1513               goto error;
1514             }
1515           saw_id |= 16;
1516
1517           if (!lex_force_int ())
1518             goto error;
1519           if (lex_integer () < 1)
1520             {
1521               msg (SE, _("ID beginning column (%ld) must be positive."),
1522                    lex_integer ());
1523               goto error;
1524             }
1525           rpd->id_beg = lex_integer ();
1526
1527           lex_get ();
1528           lex_negative_to_dash ();
1529
1530           if (lex_match ('-'))
1531             {
1532               if (!lex_force_int ())
1533                 goto error;
1534               if (lex_integer () < 1)
1535                 {
1536                   msg (SE, _("ID ending column (%ld) must be positive."),
1537                        lex_integer ());
1538                   goto error;
1539                 }
1540               if (lex_integer () < rpd->id_end)
1541                 {
1542                   msg (SE, _("ID ending column (%ld) cannot be less than "
1543                              "ID beginning column (%d)."),
1544                        lex_integer (), rpd->id_beg);
1545                   goto error;
1546                 }
1547
1548               rpd->id_end = lex_integer ();
1549               lex_get ();
1550             }
1551           else rpd->id_end = rpd->id_beg;
1552
1553           if (!lex_force_match ('='))
1554             goto error;
1555           rpd->id_var = parse_variable ();
1556           if (rpd->id_var == NULL)
1557             goto error;
1558
1559           find_variable_input_spec (rpd->id_var, &rpd->id_spec);
1560           rpd->id_value = xmalloc (sizeof *rpd->id_value * rpd->id_var->nv);
1561         }
1562       else if (lex_match_id ("TABLE"))
1563         table = 1;
1564       else if (lex_match_id ("NOTABLE"))
1565         table = 0;
1566       else if (lex_match_id ("DATA"))
1567         break;
1568       else
1569         {
1570           lex_error (NULL);
1571           goto error;
1572         }
1573
1574       if (!lex_force_match ('/'))
1575         goto error;
1576     }
1577
1578   /* Comes here when DATA specification encountered. */
1579   if (!saw_starts || !saw_occurs)
1580     {
1581       if (!saw_starts)
1582         msg (SE, _("Missing required specification STARTS."));
1583       if (!saw_occurs)
1584         msg (SE, _("Missing required specification OCCURS."));
1585       goto error;
1586     }
1587
1588   /* Enforce ID restriction. */
1589   if (saw_id && !saw_continued)
1590     {
1591       msg (SE, _("ID specified without CONTINUED."));
1592       goto error;
1593     }
1594
1595   /* Calculate and check starts_end, cont_end if necessary. */
1596   if (rpd->starts_end.num == 0 && rpd->starts_end.var == NULL)
1597     {
1598       rpd->starts_end.num = fh != NULL ? handle_get_record_width (fh) : 80;
1599       if (rpd->starts_beg.num != 0
1600           && rpd->starts_beg.num > rpd->starts_end.num)
1601         {
1602           msg (SE, _("STARTS beginning column (%d) exceeds "
1603                      "default STARTS ending column taken from file's "
1604                      "record width (%d)."),
1605                rpd->starts_beg.num, rpd->starts_end.num);
1606           goto error;
1607         }
1608     }
1609   if (rpd->cont_end.num == 0 && rpd->cont_end.var == NULL)
1610     {
1611       rpd->cont_end.num = fh != NULL ? handle_get_record_width (fh) : 80;
1612       if (rpd->cont_beg.num != 0
1613           && rpd->cont_beg.num > rpd->cont_end.num)
1614         {
1615           msg (SE, _("CONTINUED beginning column (%d) exceeds "
1616                      "default CONTINUED ending column taken from file's "
1617                      "record width (%d)."),
1618                rpd->cont_beg.num, rpd->cont_end.num);
1619           goto error;
1620         }
1621     }
1622
1623   lex_match ('=');
1624   if (!parse_repeating_data (&rpd->first, &rpd->last))
1625     goto error;
1626
1627   /* Calculate length if necessary. */
1628   if (!saw_length)
1629     {
1630       struct dls_var_spec *iter;
1631
1632       for (iter = rpd->first; iter; iter = iter->next)
1633         if (iter->lc > rpd->length.num)
1634           rpd->length.num = iter->lc;
1635       assert (rpd->length.num != 0);
1636     }
1637
1638   if (table)
1639     dump_fixed_table (rpd->first, fh, rpd->last->rec);
1640
1641   rpd->h.proc = repeating_data_trns_proc;
1642   rpd->h.free = repeating_data_trns_free;
1643   add_transformation (&rpd->h);
1644
1645   return lex_end_of_command ();
1646
1647  error:
1648   destroy_dls_var_spec (rpd->first);
1649   free (rpd->id_value);
1650   return CMD_FAILURE;
1651 }
1652
1653 /* Finds the input format specification for variable V and puts
1654    it in SPEC.  Because of the way that DATA LIST is structured,
1655    this is nontrivial. */
1656 static void
1657 find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
1658 {
1659   int i;
1660
1661   for (i = 0; i < n_trns; i++)
1662     {
1663       struct data_list_pgm *pgm = (struct data_list_pgm *) t_trns[i];
1664
1665       if (pgm->h.proc == data_list_trns_proc)
1666         {
1667           struct dls_var_spec *iter;
1668
1669           for (iter = pgm->first; iter; iter = iter->next)
1670             if (iter->v == v)
1671               {
1672                 *spec = iter->input;
1673                 return;
1674               }
1675         }
1676     }
1677
1678   assert (0);
1679 }
1680
1681 /* Parses a number or a variable name from the syntax file and puts
1682    the results in VALUE.  Ensures that the number is at least 1; else
1683    emits an error based on MESSAGE.  Returns nonzero only if
1684    successful. */
1685 static int
1686 parse_num_or_var (struct rpd_num_or_var *value, const char *message)
1687 {
1688   if (token == T_ID)
1689     {
1690       value->num = 0;
1691       value->var = parse_variable ();
1692       if (value->var == NULL)
1693         return 0;
1694       if (value->var->type == ALPHA)
1695         {
1696           msg (SE, _("String variable not allowed here."));
1697           return 0;
1698         }
1699     }
1700   else if (lex_is_integer ())
1701     {
1702       value->num = lex_integer ();
1703
1704       if (value->num < 1)
1705         {
1706           msg (SE, _("%s (%d) must be at least 1."), message, value->num);
1707           return 0;
1708         }
1709
1710       lex_get ();
1711     } else {
1712       msg (SE, _("Variable or integer expected for %s."), message);
1713       return 0;
1714     }
1715   return 1;
1716 }
1717
1718 /* Parses data specifications for repeating data groups, adding
1719    them to the linked list with head FIRST and tail LAST.
1720    Returns nonzero only if successful.  */
1721 static int
1722 parse_repeating_data (struct dls_var_spec **first, struct dls_var_spec **last)
1723 {
1724   struct fixed_parsing_state fx;
1725   int i;
1726
1727   fx.recno = 0;
1728   fx.sc = 1;
1729
1730   while (token != '.')
1731     {
1732       if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
1733         return 0;
1734
1735       if (lex_is_number ())
1736         {
1737           if (!fixed_parse_compatible (&fx, first, last))
1738             goto fail;
1739         }
1740       else if (token == '(')
1741         {
1742           if (!fixed_parse_fortran (&fx, first, last))
1743             goto fail;
1744         }
1745       else
1746         {
1747           msg (SE, _("SPSS-like or FORTRAN-like format "
1748                      "specification expected after variable names."));
1749           goto fail;
1750         }
1751
1752       for (i = 0; i < fx.name_cnt; i++)
1753         free (fx.name[i]);
1754       free (fx.name);
1755     }
1756
1757   return 1;
1758
1759  fail:
1760   for (i = 0; i < fx.name_cnt; i++)
1761     free (fx.name[i]);
1762   free (fx.name);
1763   return 0;
1764 }
1765
1766 /* Obtains the real value for rpd_num_or_var N in case C and returns
1767    it.  The valid range is nonnegative numbers, but numbers outside
1768    this range can be returned and should be handled by the caller as
1769    invalid. */
1770 static int
1771 realize_value (struct rpd_num_or_var *n, struct ccase *c)
1772 {
1773   if (n->var != NULL)
1774     {
1775       double v = case_num (c, n->var->fv);
1776       return v != SYSMIS && v >= INT_MIN && v <= INT_MAX ? v : -1;
1777     }
1778   else
1779     return n->num;
1780 }
1781
1782 /* Parameter record passed to rpd_parse_record(). */
1783 struct rpd_parse_info
1784   {
1785     struct repeating_data_trns *trns;  /* REPEATING DATA transformation. */
1786     const char *line;   /* Line being parsed. */
1787     size_t len;         /* Line length. */
1788     int beg, end;       /* First and last column of first occurrence. */
1789     int ofs;            /* Column offset between repeated occurrences. */
1790     struct ccase *c;    /* Case to fill in. */
1791     int verify_id;      /* Zero to initialize ID, nonzero to verify it. */
1792     int max_occurs;     /* Max number of occurrences to parse. */
1793   };
1794
1795 /* Parses one record of repeated data and outputs corresponding
1796    cases.  Returns number of occurrences parsed up to the
1797    maximum specified in INFO. */
1798 static int
1799 rpd_parse_record (const struct rpd_parse_info *info)
1800 {
1801   struct repeating_data_trns *t = info->trns;
1802   int cur = info->beg;
1803   int occurrences;
1804
1805   /* Handle record ID values. */
1806   if (t->id_beg != 0)
1807     {
1808       union value id_temp[MAX_ELEMS_PER_VALUE];
1809
1810       /* Parse record ID into V. */
1811       {
1812         struct data_in di;
1813
1814         data_in_finite_line (&di, info->line, info->len, t->id_beg, t->id_end);
1815         di.v = info->verify_id ? id_temp : t->id_value;
1816         di.flags = 0;
1817         di.f1 = t->id_beg;
1818         di.format = t->id_spec;
1819
1820         if (!data_in (&di))
1821           return 0;
1822       }
1823
1824       if (info->verify_id
1825           && compare_values (id_temp, t->id_value, t->id_var->width) != 0)
1826         {
1827           char expected_str [MAX_FORMATTED_LEN + 1];
1828           char actual_str [MAX_FORMATTED_LEN + 1];
1829
1830           data_out (expected_str, &t->id_var->print, t->id_value);
1831           expected_str[t->id_var->print.w] = '\0';
1832
1833           data_out (actual_str, &t->id_var->print, id_temp);
1834           actual_str[t->id_var->print.w] = '\0';
1835
1836           tmsg (SE, RPD_ERR,
1837                 _("Encountered mismatched record ID \"%s\" expecting \"%s\"."),
1838                 actual_str, expected_str);
1839
1840           return 0;
1841         }
1842     }
1843
1844   /* Iterate over the set of expected occurrences and record each of
1845      them as a separate case.  FIXME: We need to execute any
1846      transformations that follow the current one. */
1847   {
1848     int warned = 0;
1849
1850     for (occurrences = 0; occurrences < info->max_occurs; )
1851       {
1852         if (cur + info->ofs > info->end + 1)
1853           break;
1854         occurrences++;
1855
1856         {
1857           struct dls_var_spec *var_spec = t->first;
1858
1859           for (; var_spec; var_spec = var_spec->next)
1860             {
1861               int fc = var_spec->fc - 1 + cur;
1862               int lc = var_spec->lc - 1 + cur;
1863
1864               if (fc > info->len && !warned && var_spec->input.type != FMT_A)
1865                 {
1866                   warned = 1;
1867
1868                   tmsg (SW, RPD_ERR,
1869                         _("Variable %s starting in column %d extends "
1870                           "beyond physical record length of %d."),
1871                         var_spec->v->name, fc, info->len);
1872                 }
1873
1874               {
1875                 struct data_in di;
1876
1877                 data_in_finite_line (&di, info->line, info->len, fc, lc);
1878                 di.v = case_data_rw (info->c, var_spec->fv);
1879                 di.flags = 0;
1880                 di.f1 = fc + 1;
1881                 di.format = var_spec->input;
1882
1883                 if (!data_in (&di))
1884                   return 0;
1885               }
1886             }
1887         }
1888
1889         cur += info->ofs;
1890
1891         if (!t->write_case (t->wc_data))
1892           return 0;
1893       }
1894   }
1895
1896   return occurrences;
1897 }
1898
1899 /* Reads one set of repetitions of the elements in the REPEATING
1900    DATA structure.  Returns -1 on success, -2 on end of file or
1901    on failure. */
1902 int
1903 repeating_data_trns_proc (struct trns_header *trns, struct ccase *c,
1904                           int case_num UNUSED)
1905 {
1906   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
1907
1908   struct fixed_string line;       /* Current record. */
1909
1910   int starts_beg;       /* Starting column. */
1911   int starts_end;       /* Ending column. */
1912   int occurs;           /* Number of repetitions. */
1913   int length;           /* Length of each occurrence. */
1914   int cont_beg;         /* Starting column for continuation lines. */
1915   int cont_end;         /* Ending column for continuation lines. */
1916
1917   int occurs_left;      /* Number of occurrences remaining. */
1918
1919   int code;             /* Return value from rpd_parse_record(). */
1920
1921   int skip_first_record = 0;
1922
1923   dfm_push (t->reader);
1924
1925   /* Read the current record. */
1926   dfm_reread_record (t->reader, 1);
1927   dfm_expand_tabs (t->reader);
1928   if (dfm_eof (t->reader))
1929     return -2;
1930   dfm_get_record (t->reader, &line);
1931   dfm_forward_record (t->reader);
1932
1933   /* Calculate occurs, length. */
1934   occurs_left = occurs = realize_value (&t->occurs, c);
1935   if (occurs <= 0)
1936     {
1937       tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
1938       return -3;
1939     }
1940   starts_beg = realize_value (&t->starts_beg, c);
1941   if (starts_beg <= 0)
1942     {
1943       tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
1944                            "at least 1."),
1945             starts_beg);
1946       return -3;
1947     }
1948   starts_end = realize_value (&t->starts_end, c);
1949   if (starts_end < starts_beg)
1950     {
1951       tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
1952                            "beginning column (%d)."),
1953             starts_end, starts_beg);
1954       skip_first_record = 1;
1955     }
1956   length = realize_value (&t->length, c);
1957   if (length < 0)
1958     {
1959       tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
1960       length = 1;
1961       occurs = occurs_left = 1;
1962     }
1963   cont_beg = realize_value (&t->cont_beg, c);
1964   if (cont_beg < 0)
1965     {
1966       tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
1967                            "at least 1."),
1968             cont_beg);
1969       return -2;
1970     }
1971   cont_end = realize_value (&t->cont_end, c);
1972   if (cont_end < cont_beg)
1973     {
1974       tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
1975                            "beginning column (%d)."),
1976             cont_end, cont_beg);
1977       return -2;
1978     }
1979
1980   /* Parse the first record. */
1981   if (!skip_first_record)
1982     {
1983       struct rpd_parse_info info;
1984       info.trns = t;
1985       info.line = ls_c_str (&line);
1986       info.len = ls_length (&line);
1987       info.beg = starts_beg;
1988       info.end = starts_end;
1989       info.ofs = length;
1990       info.c = c;
1991       info.verify_id = 0;
1992       info.max_occurs = occurs_left;
1993       code = rpd_parse_record (&info);
1994       if (!code)
1995         return -2;
1996       occurs_left -= code;
1997     }
1998   else if (cont_beg == 0)
1999     return -3;
2000
2001   /* Make sure, if some occurrences are left, that we have
2002      continuation records. */
2003   if (occurs_left > 0 && cont_beg == 0)
2004     {
2005       tmsg (SE, RPD_ERR,
2006             _("Number of repetitions specified on OCCURS (%d) "
2007               "exceed number of repetitions available in "
2008               "space on STARTS (%d), and CONTINUED not specified."),
2009             occurs, (starts_end - starts_beg + 1) / length);
2010       return -2;
2011     }
2012
2013   /* Go on to additional records. */
2014   while (occurs_left != 0)
2015     {
2016       struct rpd_parse_info info;
2017
2018       assert (occurs_left >= 0);
2019
2020       /* Read in another record. */
2021       if (dfm_eof (t->reader))
2022         {
2023           tmsg (SE, RPD_ERR,
2024                 _("Unexpected end of file with %d repetitions "
2025                   "remaining out of %d."),
2026                 occurs_left, occurs);
2027           return -2;
2028         }
2029       dfm_expand_tabs (t->reader);
2030       dfm_get_record (t->reader, &line);
2031       dfm_forward_record (t->reader);
2032
2033       /* Parse this record. */
2034       info.trns = t;
2035       info.line = ls_c_str (&line);
2036       info.len = ls_length (&line);
2037       info.beg = cont_beg;
2038       info.end = cont_end;
2039       info.ofs = length;
2040       info.c = c;
2041       info.verify_id = 1;
2042       info.max_occurs = occurs_left;
2043       code = rpd_parse_record (&info);;
2044       if (!code)
2045         return -2;
2046       occurs_left -= code;
2047     }
2048
2049   dfm_pop (t->reader);
2050
2051   /* FIXME: This is a kluge until we've implemented multiplexing of
2052      transformations. */
2053   return -3;
2054 }
2055
2056 /* Frees a REPEATING DATA transformation. */
2057 void
2058 repeating_data_trns_free (struct trns_header *rpd_)
2059 {
2060   struct repeating_data_trns *rpd = (struct repeating_data_trns *) rpd_;
2061
2062   destroy_dls_var_spec (rpd->first);
2063   dfm_close_reader (rpd->reader);
2064   free (rpd->id_value);
2065 }
2066
2067 /* Lets repeating_data_trns_proc() know how to write the cases
2068    that it composes.  Not elegant. */
2069 void
2070 repeating_data_set_write_case (struct trns_header *trns,
2071                                write_case_func *write_case,
2072                                write_case_data wc_data)
2073 {
2074   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
2075
2076   assert (trns->proc == repeating_data_trns_proc);
2077   t->write_case = write_case;
2078   t->wc_data = wc_data;
2079 }