src/get.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., 59 Temple Place - Suite 330, Boston, MA
  18    02111-1307, USA. */
  19
  20 #include <config.h>
  21 #include "error.h"
  22 #include <stdlib.h>
  23 #include "alloc.h"
  24 #include "command.h"
  25 #include "error.h"
  26 #include "file-handle.h"
  27 #include "hash.h"
  28 #include "lexer.h"
  29 #include "misc.h"
  30 #include "pfm.h"
  31 #include "settings.h"
  32 #include "sfm.h"
  33 #include "str.h"
  34 #include "value-labels.h"
  35 #include "var.h"
  36 #include "vfm.h"
  37 #include "vfmP.h"
  38
  39 #include "debug-print.h"
  40
  41 /* GET or IMPORT input program. */
  42 struct get_pgm
  43   {
  44     struct file_handle *handle; /* File to GET or IMPORT from. */
  45     size_t case_size;           /* Case size in bytes. */
  46   };
  47
  48 /* XSAVE transformation (and related SAVE, EXPORT procedures). */
  49 struct save_trns
  50   {
  51     struct trns_header h;
  52     struct file_handle *f;      /* Associated system file. */
  53     int nvar;                   /* Number of variables. */
  54     struct variable **var;      /* Variables. */
  55     flt64 *case_buf;            /* Case transfer buffer. */
  56   };
  57
  58 /* Options bits set by trim_dictionary(). */
  59 #define GTSV_OPT_COMPRESSED     001     /* Compression; (X)SAVE only. */
  60 #define GTSV_OPT_SAVE           002     /* The SAVE/XSAVE/EXPORT procedures. */
  61 #define GTSV_OPT_MATCH_FILES    004     /* The MATCH FILES procedure. */
  62 #define GTSV_OPT_NONE           0
  63
  64 static int trim_dictionary (struct dictionary * dict, int *options);
  65 static int save_write_case_func (struct ccase *, void *);
  66 static trns_proc_func save_trns_proc;
  67 static trns_free_func save_trns_free;
  68
  69 #if DEBUGGING
  70 void dump_dict_variables (struct dictionary *);
  71 #endif
  72
  73 /* Parses the GET command. */
  74 int
  75 cmd_get (void)
  76 {
  77   struct file_handle *handle;
  78   struct dictionary *dict;
  79   struct get_pgm *pgm;
  80   int options = GTSV_OPT_NONE;
  81
  82   discard_variables ();
  83
  84   lex_match ('/');
  85   if (lex_match_id ("FILE"))
  86     lex_match ('=');
  87
  88   handle = fh_parse_file_handle ();
  89   if (handle == NULL)
  90     return CMD_FAILURE;
  91
  92   dict = sfm_read_dictionary (handle, NULL);
  93   if (dict == NULL)
  94     return CMD_FAILURE;
  95
  96 #if DEBUGGING
  97   dump_dict_variables (dict);
  98 #endif
  99   if (0 == trim_dictionary (dict, &options))
 100     {
 101       fh_close_handle (handle);
 102       return CMD_FAILURE;
 103     }
 104 #if DEBUGGING
 105   dump_dict_variables (dict);
 106 #endif
 107
 108   dict_compact_values (dict);
 109
 110 #if DEBUGGING
 111   printf (_("GET translation table from file to memory:\n"));
 112   for (i = 0; i < dict->nvar; i++)
 113     {
 114       struct variable *v = dict->var[i];
 115
 116       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
 117               v->get.fv, v->get.nv, v->fv, v->nv);
 118     }
 119 #endif
 120
 121   dict_destroy (default_dict);
 122   default_dict = dict;
 123
 124   pgm = xmalloc (sizeof *pgm);
 125   pgm->handle = handle;
 126   pgm->case_size = dict_get_case_size (default_dict);
 127   vfm_source = create_case_source (&get_source_class, default_dict, pgm);
 128
 129   return CMD_SUCCESS;
 130 }
 131
 132 /* SAVE or XSAVE command? */
 133 enum save_cmd
 134   {
 135     CMD_SAVE,
 136     CMD_XSAVE
 137   };
 138
 139 /* Parses the SAVE and XSAVE commands.  */
 140 static int
 141 cmd_save_internal (enum save_cmd save_cmd)
 142 {
 143   struct file_handle *handle;
 144   struct dictionary *dict;
 145   int options = GTSV_OPT_SAVE;
 146
 147   struct save_trns *t;
 148   struct sfm_write_info inf;
 149
 150   int i;
 151
 152   lex_match ('/');
 153   if (lex_match_id ("OUTFILE"))
 154     lex_match ('=');
 155
 156   handle = fh_parse_file_handle ();
 157   if (handle == NULL)
 158     return CMD_FAILURE;
 159
 160   dict = dict_clone (default_dict);
 161 #if DEBUGGING
 162   dump_dict_variables (dict);
 163 #endif
 164   for (i = 0; i < dict_get_var_cnt (dict); i++)
 165     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
 166   if (0 == trim_dictionary (dict, &options))
 167     {
 168       fh_close_handle (handle);
 169       return CMD_FAILURE;
 170     }
 171
 172 #if DEBUGGING
 173   dump_dict_variables (dict);
 174 #endif
 175
 176   /* Write dictionary. */
 177   inf.h = handle;
 178   inf.dict = dict;
 179   inf.compress = !!(options & GTSV_OPT_COMPRESSED);
 180   if (!sfm_write_dictionary (&inf))
 181     {
 182       dict_destroy (dict);
 183       fh_close_handle (handle);
 184       return CMD_FAILURE;
 185     }
 186
 187   /* Fill in transformation structure. */
 188   t = xmalloc (sizeof *t);
 189   t->h.proc = save_trns_proc;
 190   t->h.free = save_trns_free;
 191   t->f = handle;
 192   t->nvar = dict_get_var_cnt (dict);
 193   t->var = xmalloc (sizeof *t->var * t->nvar);
 194   for (i = 0; i < t->nvar; i++)
 195     t->var[i] = dict_get_var (dict, i)->aux;
 196   t->case_buf = xmalloc (sizeof *t->case_buf * inf.case_size);
 197   dict_destroy (dict);
 198
 199   if (save_cmd == CMD_SAVE)
 200     {
 201       procedure (save_write_case_func, t);
 202       save_trns_free (&t->h);
 203     }
 204   else
 205     {
 206       assert (save_cmd == CMD_XSAVE);
 207       add_transformation (&t->h);
 208     }
 209
 210   return CMD_SUCCESS;
 211 }
 212
 213 /* Parses and performs the SAVE procedure. */
 214 int
 215 cmd_save (void)
 216 {
 217   return cmd_save_internal (CMD_SAVE);
 218 }
 219
 220 /* Parses the XSAVE transformation command. */
 221 int
 222 cmd_xsave (void)
 223 {
 224   return cmd_save_internal (CMD_XSAVE);
 225 }
 226
 227 /* Writes the given C to the file specified by T. */
 228 static void
 229 do_write_case (struct save_trns *t, struct ccase *c)
 230 {
 231   flt64 *p = t->case_buf;
 232   int i;
 233
 234   for (i = 0; i < t->nvar; i++)
 235     {
 236       struct variable *v = t->var[i];
 237       if (v->type == NUMERIC)
 238         {
 239           double src = c->data[v->fv].f;
 240           if (src == SYSMIS)
 241             *p++ = -FLT64_MAX;
 242           else
 243             *p++ = src;
 244         }
 245       else
 246         {
 247           memcpy (p, c->data[v->fv].s, v->width);
 248           memset (&((char *) p)[v->width], ' ',
 249                   REM_RND_UP (v->width, sizeof *p));
 250           p += DIV_RND_UP (v->width, sizeof *p);
 251         }
 252     }
 253
 254   sfm_write_case (t->f, t->case_buf, p - t->case_buf);
 255 }
 256
 257 /* Writes case C to the system file specified on SAVE. */
 258 static int
 259 save_write_case_func (struct ccase *c, void *aux UNUSED)
 260 {
 261   do_write_case (aux, c);
 262   return 1;
 263 }
 264
 265 /* Writes case C to the system file specified on XSAVE. */
 266 static int
 267 save_trns_proc (struct trns_header *h, struct ccase *c, int case_num UNUSED)
 268 {
 269   struct save_trns *t = (struct save_trns *) h;
 270   do_write_case (t, c);
 271   return -1;
 272 }
 273
 274 /* Frees a SAVE transformation. */
 275 static void
 276 save_trns_free (struct trns_header *pt)
 277 {
 278   struct save_trns *t = (struct save_trns *) pt;
 279
 280   fh_close_handle (t->f);
 281   free (t->var);
 282   free (t->case_buf);
 283   free (t);
 284 }
 285
 286 static int rename_variables (struct dictionary * dict);
 287
 288 /* The GET and SAVE commands have a common structure after the
 289    FILE/OUTFILE subcommand.  This function parses this structure and
 290    returns nonzero on success, zero on failure.  It both reads
 291    *OPTIONS, for the GTSV_OPT_SAVE bit, and writes it, for the
 292    GTSV_OPT_COMPRESSED bit. */
 293 /* FIXME: IN, FIRST, LAST, MAP. */
 294 /* FIXME?  Should we call dict_compact_values() on dict as a
 295    final step? */
 296 static int
 297 trim_dictionary (struct dictionary *dict, int *options)
 298 {
 299   if (get_scompression())
 300     *options |= GTSV_OPT_COMPRESSED;
 301
 302   if (*options & GTSV_OPT_SAVE)
 303     {
 304       /* Delete all the scratch variables. */
 305       struct variable **v;
 306       size_t nv;
 307       size_t i;
 308
 309       v = xmalloc (sizeof *v * dict_get_var_cnt (dict));
 310       nv = 0;
 311       for (i = 0; i < dict_get_var_cnt (dict); i++)
 312         if (dict_class_from_id (dict_get_var (dict, i)->name) == DC_SCRATCH)
 313           v[nv++] = dict_get_var (dict, i);
 314       dict_delete_vars (dict, v, nv);
 315       free (v);
 316     }
 317
 318   while ((*options & GTSV_OPT_MATCH_FILES) || lex_match ('/'))
 319     {
 320       if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("COMPRESSED"))
 321         *options |= GTSV_OPT_COMPRESSED;
 322       else if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("UNCOMPRESSED"))
 323         *options &= ~GTSV_OPT_COMPRESSED;
 324       else if (lex_match_id ("DROP"))
 325         {
 326           struct variable **v;
 327           int nv;
 328
 329           lex_match ('=');
 330           if (!parse_variables (dict, &v, &nv, PV_NONE))
 331             return 0;
 332           dict_delete_vars (dict, v, nv);
 333           free (v);
 334         }
 335       else if (lex_match_id ("KEEP"))
 336         {
 337           struct variable **v;
 338           int nv;
 339           int i;
 340
 341           lex_match ('=');
 342           if (!parse_variables (dict, &v, &nv, PV_NONE))
 343             return 0;
 344
 345           /* Move the specified variables to the beginning. */
 346           dict_reorder_vars (dict, v, nv);
 347
 348           /* Delete the remaining variables. */
 349           v = xrealloc (v, (dict_get_var_cnt (dict) - nv) * sizeof *v);
 350           for (i = nv; i < dict_get_var_cnt (dict); i++)
 351             v[i - nv] = dict_get_var (dict, i);
 352           dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
 353           free (v);
 354         }
 355       else if (lex_match_id ("RENAME"))
 356         {
 357           if (!rename_variables (dict))
 358             return 0;
 359         }
 360       else
 361         {
 362           lex_error (_("while expecting a valid subcommand"));
 363           return 0;
 364         }
 365
 366       if (dict_get_var_cnt (dict) == 0)
 367         {
 368           msg (SE, _("All variables deleted from system file dictionary."));
 369           return 0;
 370         }
 371
 372       if (*options & GTSV_OPT_MATCH_FILES)
 373         return 1;
 374     }
 375
 376   if (token != '.')
 377     {
 378       lex_error (_("expecting end of command"));
 379       return 0;
 380     }
 381
 382   return 1;
 383 }
 384
 385 /* Parses and performs the RENAME subcommand of GET and SAVE. */
 386 static int
 387 rename_variables (struct dictionary * dict)
 388 {
 389   int i;
 390
 391   int success = 0;
 392
 393   struct variable **v;
 394   char **new_names;
 395   int nv, nn;
 396   char *err_name;
 397
 398   int group;
 399
 400   lex_match ('=');
 401   if (token != '(')
 402     {
 403       struct variable *v;
 404
 405       v = parse_dict_variable (dict);
 406       if (v == NULL)
 407         return 0;
 408       if (!lex_force_match ('=')
 409           || !lex_force_id ())
 410         return 0;
 411       if (!strncmp (tokid, v->name, 8))
 412         return 1;
 413       if (dict_lookup_var (dict, tokid) != NULL)
 414         {
 415           msg (SE, _("Cannot rename %s as %s because there already exists "
 416                      "a variable named %s.  To rename variables with "
 417                      "overlapping names, use a single RENAME subcommand "
 418                      "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
 419                      "\"/RENAME (A B C=B C A)\"."), v->name, tokid, tokid);
 420           return 0;
 421         }
 422
 423       dict_rename_var (dict, v, tokid);
 424       lex_get ();
 425       return 1;
 426     }
 427
 428   nv = nn = 0;
 429   v = NULL;
 430   new_names = 0;
 431   group = 1;
 432   while (lex_match ('('))
 433     {
 434       int old_nv = nv;
 435
 436       if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
 437         goto done;
 438       if (!lex_match ('='))
 439         {
 440           msg (SE, _("`=' expected after variable list."));
 441           goto done;
 442         }
 443       if (!parse_DATA_LIST_vars (&new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
 444         goto done;
 445       if (nn != nv)
 446         {
 447           msg (SE, _("Number of variables on left side of `=' (%d) does not "
 448                "match number of variables on right side (%d), in "
 449                "parenthesized group %d of RENAME subcommand."),
 450                nv - old_nv, nn - old_nv, group);
 451           goto done;
 452         }
 453       if (!lex_force_match (')'))
 454         goto done;
 455       group++;
 456     }
 457
 458   if (!dict_rename_vars (dict, v, new_names, nv, &err_name))
 459     {
 460       msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
 461       goto done;
 462     }
 463   success = 1;
 464
 465 done:
 466   for (i = 0; i < nn; i++)
 467     free (new_names[i]);
 468   free (new_names);
 469   free (v);
 470
 471   return success;
 472 }
 473
 474 #if DEBUGGING
 475 void
 476 dump_dict_variables (struct dictionary * dict)
 477 {
 478   int i;
 479
 480   printf (_("\nVariables in dictionary:\n"));
 481   for (i = 0; i < dict->nvar; i++)
 482     printf ("%s, ", dict->var[i]->name);
 483   printf ("\n");
 484 }
 485 #endif
 486 \f
 487 /* Clears internal state related to GET input procedure. */
 488 static void
 489 get_source_destroy (struct case_source *source)
 490 {
 491   struct get_pgm *pgm = source->aux;
 492
 493   /* It is not necessary to destroy the dictionary because if we get
 494      to this point then the dictionary is default_dict. */
 495   fh_close_handle (pgm->handle);
 496   free (pgm);
 497 }
 498
 499 /* Reads all the cases from the data file into C and passes them
 500    to WRITE_CASE one by one, passing WC_DATA. */
 501 static void
 502 get_source_read (struct case_source *source,
 503                  struct ccase *c,
 504                  write_case_func *write_case, write_case_data wc_data)
 505 {
 506   struct get_pgm *pgm = source->aux;
 507
 508   while (sfm_read_case (pgm->handle, c->data, default_dict)
 509          && write_case (wc_data))
 510     ;
 511 }
 512
 513 const struct case_source_class get_source_class =
 514   {
 515     "GET",
 516     NULL,
 517     get_source_read,
 518     get_source_destroy,
 519   };
 520
 521 \f
 522 /* MATCH FILES. */
 523
 524 #include "debug-print.h"
 525
 526 /* File types. */
 527 enum
 528   {
 529     MTF_FILE,                   /* Specified on FILE= subcommand. */
 530     MTF_TABLE                   /* Specified on TABLE= subcommand. */
 531   };
 532
 533 /* One of the files on MATCH FILES. */
 534 struct mtf_file
 535   {
 536     struct mtf_file *next, *prev;
 537                                 /* Next, previous in the list of files. */
 538     struct mtf_file *next_min;  /* Next in the chain of minimums. */
 539
 540     int type;                   /* One of MTF_*. */
 541     struct variable **by;       /* List of BY variables for this file. */
 542     struct file_handle *handle; /* File handle for the file. */
 543     struct dictionary *dict;    /* Dictionary from system file. */
 544     char in[9];                 /* Name of the variable from IN=. */
 545     char first[9], last[9];     /* Name of the variables from FIRST=, LAST=. */
 546     union value *input;         /* Input record. */
 547   };
 548
 549 /* MATCH FILES procedure. */
 550 struct mtf_proc
 551   {
 552     struct mtf_file *head;      /* First file mentioned on FILE or TABLE. */
 553     struct mtf_file *tail;      /* Last file mentioned on FILE or TABLE. */
 554
 555     struct variable **by;       /* Variables on the BY subcommand. */
 556     size_t by_cnt;              /* Number of variables on BY subcommand. */
 557
 558     struct dictionary *dict;    /* Dictionary of output file. */
 559     struct case_sink *sink;     /* Sink to receive output. */
 560     struct ccase *mtf_case;     /* Case used for output. */
 561
 562     unsigned seq_num;           /* Have we initialized this variable? */
 563     unsigned *seq_nums;         /* Sequence numbers for each var in dict. */
 564   };
 565
 566 static void mtf_free (struct mtf_proc *);
 567 static void mtf_free_file (struct mtf_file *);
 568 static int mtf_merge_dictionary (struct dictionary *const, struct mtf_file *);
 569 static void mtf_delete_file_in_place (struct mtf_proc *, struct mtf_file **);
 570
 571 static void mtf_read_nonactive_records (void *);
 572 static void mtf_processing_finish (void *);
 573 static int mtf_processing (struct ccase *, void *);
 574
 575 static char *var_type_description (struct variable *);
 576
 577 /* Parse and execute the MATCH FILES command. */
 578 int
 579 cmd_match_files (void)
 580 {
 581   struct mtf_proc mtf;
 582   struct mtf_file *first_table = NULL;
 583
 584   int seen = 0;
 585
 586   mtf.head = mtf.tail = NULL;
 587   mtf.by = NULL;
 588   mtf.by_cnt = 0;
 589   mtf.dict = dict_create ();
 590   mtf.sink = NULL;
 591   mtf.mtf_case = NULL;
 592   mtf.seq_num = 0;
 593   mtf.seq_nums = NULL;
 594   dict_set_case_limit (mtf.dict, dict_get_case_limit (default_dict));
 595
 596   do
 597     {
 598       lex_match ('/');
 599
 600       if (lex_match (T_BY))
 601         {
 602           if (seen & 1)
 603             {
 604               msg (SE, _("The BY subcommand may be given once at most."));
 605               goto lossage;
 606             }
 607           seen |= 1;
 608
 609           lex_match ('=');
 610           if (!parse_variables (mtf.dict, &mtf.by, &mtf.by_cnt,
 611                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
 612             goto lossage;
 613         }
 614       else if (token != T_ID)
 615         {
 616           lex_error (NULL);
 617           goto lossage;
 618         }
 619       else if (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid))
 620         {
 621           struct mtf_file *file = xmalloc (sizeof *file);
 622
 623           file->in[0] = file->first[0] = file->last[0] = '\0';
 624           file->dict = NULL;
 625           file->by = NULL;
 626           file->input = NULL;
 627
 628           if (lex_match_id ("FILE"))
 629             file->type = MTF_FILE;
 630           else if (lex_match_id ("TABLE"))
 631             {
 632               file->type = MTF_TABLE;
 633               seen |= 4;
 634             }
 635           else
 636             assert (0);
 637
 638           /* FILEs go first, then TABLEs. */
 639           if (file->type == MTF_TABLE || first_table == NULL)
 640             {
 641               file->next = NULL;
 642               file->prev = mtf.tail;
 643               if (mtf.tail)
 644                 mtf.tail->next = file;
 645               mtf.tail = file;
 646               if (mtf.head == NULL)
 647                 mtf.head = file;
 648               if (file->type == MTF_TABLE && first_table == NULL)
 649                 first_table = file;
 650             }
 651           else
 652             {
 653               assert (file->type == MTF_FILE);
 654               file->next = first_table;
 655               file->prev = first_table->prev;
 656               if (first_table->prev)
 657                 first_table->prev->next = file;
 658               else
 659                 mtf.head = file;
 660               first_table->prev = file;
 661             }
 662
 663           lex_match ('=');
 664
 665           if (lex_match ('*'))
 666             {
 667               file->handle = NULL;
 668
 669               if (seen & 2)
 670                 {
 671                   msg (SE, _("The active file may not be specified more "
 672                              "than once."));
 673                   goto lossage;
 674                 }
 675               seen |= 2;
 676
 677               assert (pgm_state != STATE_INPUT);
 678               if (pgm_state == STATE_INIT)
 679                 {
 680                   msg (SE, _("Cannot specify the active file since no active "
 681                              "file has been defined."));
 682                   goto lossage;
 683                 }
 684
 685               if (temporary != 0)
 686                 {
 687                   msg (SE,
 688                        _("MATCH FILES may not be used after TEMPORARY when "
 689                          "the active file is an input source.  "
 690                          "Temporary transformations will be made permanent."));
 691                   cancel_temporary ();
 692                 }
 693             }
 694           else
 695             {
 696               file->handle = fh_parse_file_handle ();
 697               if (!file->handle)
 698                 goto lossage;
 699             }
 700
 701           if (file->handle)
 702             {
 703               file->dict = sfm_read_dictionary (file->handle, NULL);
 704               if (!file->dict)
 705                 goto lossage;
 706             }
 707           else
 708             file->dict = default_dict;
 709           if (!mtf_merge_dictionary (mtf.dict, file))
 710             goto lossage;
 711         }
 712       else if (lex_id_match ("IN", tokid)
 713                || lex_id_match ("FIRST", tokid)
 714                || lex_id_match ("LAST", tokid))
 715         {
 716           const char *sbc;
 717           char *name;
 718
 719           if (mtf.tail == NULL)
 720             {
 721               msg (SE, _("IN, FIRST, and LAST subcommands may not occur "
 722                          "before the first FILE or TABLE."));
 723               goto lossage;
 724             }
 725
 726           if (lex_match_id ("IN"))
 727             {
 728               name = mtf.tail->in;
 729               sbc = "IN";
 730             }
 731           else if (lex_match_id ("FIRST"))
 732             {
 733               name = mtf.tail->first;
 734               sbc = "FIRST";
 735             }
 736           else if (lex_match_id ("LAST"))
 737             {
 738               name = mtf.tail->last;
 739               sbc = "LAST";
 740             }
 741           else
 742             assert (0);
 743
 744           lex_match ('=');
 745           if (token != T_ID)
 746             {
 747               lex_error (NULL);
 748               goto lossage;
 749             }
 750
 751           if (*name)
 752             {
 753               msg (SE, _("Multiple %s subcommands for a single FILE or "
 754                          "TABLE."),
 755                    sbc);
 756               goto lossage;
 757             }
 758           strcpy (name, tokid);
 759           lex_get ();
 760
 761           if (!dict_create_var (mtf.dict, name, 0))
 762             {
 763               msg (SE, _("Duplicate variable name %s while creating %s "
 764                          "variable."),
 765                    name, sbc);
 766               goto lossage;
 767             }
 768         }
 769       else if (lex_id_match ("RENAME", tokid)
 770                || lex_id_match ("KEEP", tokid)
 771                || lex_id_match ("DROP", tokid))
 772         {
 773           int options = GTSV_OPT_MATCH_FILES;
 774
 775           if (mtf.tail == NULL)
 776             {
 777               msg (SE, _("RENAME, KEEP, and DROP subcommands may not occur "
 778                          "before the first FILE or TABLE."));
 779               goto lossage;
 780             }
 781
 782           if (!trim_dictionary (mtf.tail->dict, &options))
 783             goto lossage;
 784         }
 785       else if (lex_match_id ("MAP"))
 786         {
 787           /* FIXME. */
 788         }
 789       else
 790         {
 791           lex_error (NULL);
 792           goto lossage;
 793         }
 794     }
 795   while (token != '.');
 796
 797   if (seen & 4)
 798     {
 799       if (!(seen & 1))
 800         {
 801           msg (SE, _("The BY subcommand is required when a TABLE subcommand "
 802                      "is given."));
 803           goto lossage;
 804         }
 805     }
 806
 807   if (seen & 1)
 808     {
 809       struct mtf_file *iter;
 810
 811       for (iter = mtf.head; iter; iter = iter->next)
 812         {
 813           int i;
 814
 815           iter->by = xmalloc (sizeof *iter->by * mtf.by_cnt);
 816
 817           for (i = 0; i < mtf.by_cnt; i++)
 818             {
 819               iter->by[i] = dict_lookup_var (iter->dict, mtf.by[i]->name);
 820               if (iter->by[i] == NULL)
 821                 {
 822                   msg (SE, _("File %s lacks BY variable %s."),
 823                        iter->handle ? handle_get_name (iter->handle) : "*",
 824                        mtf.by[i]->name);
 825                   goto lossage;
 826                 }
 827             }
 828         }
 829     }
 830
 831 #if DEBUGGING
 832   {
 833     /* From sfm-read.c. */
 834     extern void dump_dictionary (struct dictionary *);
 835
 836     dump_dictionary (mtf.dict);
 837   }
 838 #endif
 839
 840   /* MATCH FILES performs an n-way merge on all its input files.
 841      Abstract algorithm:
 842
 843      1. Read one input record from every input FILE.
 844
 845      2. If no FILEs are left, stop.  Otherwise, proceed to step 3.
 846
 847      3. Find the FILE input record with minimum BY values.  Store all
 848      the values from this input record into the output record.
 849
 850      4. Find all the FILE input records with BY values identical to
 851      the minimums.  Store all the values from these input records into
 852      the output record.
 853
 854      5. For every TABLE, read another record as long as the BY values
 855      on the TABLE's input record are less than the FILEs' BY values.
 856      If an exact match is found, store all the values from the TABLE
 857      input record into the output record.
 858
 859      6. Write the output record.
 860
 861      7. Read another record from each input file FILE and TABLE that
 862      we stored values from above.  If we come to the end of one of the
 863      input files, remove it from the list of input files.
 864
 865      8. Repeat from step 2.
 866
 867      Unfortunately, this algorithm can't be directly implemented
 868      because there's no function to read a record from the active
 869      file; instead, it has to be done using callbacks.
 870
 871      FIXME: For merging large numbers of files (more than 10?) a
 872      better algorithm would use a heap for finding minimum
 873      values. */
 874
 875   if (!(seen & 2))
 876     discard_variables ();
 877
 878   mtf.sink = create_case_sink (&storage_sink_class, mtf.dict, NULL);
 879
 880   mtf.seq_nums = xmalloc (dict_get_var_cnt (mtf.dict)
 881                           * sizeof *mtf.seq_nums);
 882   memset (mtf.seq_nums, 0,
 883           dict_get_var_cnt (mtf.dict) * sizeof *mtf.seq_nums);
 884   mtf.mtf_case = xmalloc (dict_get_case_size (mtf.dict));
 885
 886   mtf_read_nonactive_records (NULL);
 887   if (seen & 2)
 888     procedure (mtf_processing, NULL);
 889   mtf_processing_finish (NULL);
 890
 891   dict_destroy (default_dict);
 892   default_dict = mtf.dict;
 893   mtf.dict = NULL;
 894   vfm_source = mtf.sink->class->make_source (mtf.sink);
 895   free_case_sink (mtf.sink);
 896
 897   mtf_free (&mtf);
 898   return CMD_SUCCESS;
 899
 900 lossage:
 901   mtf_free (&mtf);
 902   return CMD_FAILURE;
 903 }
 904
 905 /* Repeats 2...8 an arbitrary number of times. */
 906 static void
 907 mtf_processing_finish (void *mtf_)
 908 {
 909   struct mtf_proc *mtf = mtf_;
 910   struct mtf_file *iter;
 911
 912   /* Find the active file and delete it. */
 913   for (iter = mtf->head; iter; iter = iter->next)
 914     if (iter->handle == NULL)
 915       {
 916         mtf_delete_file_in_place (mtf, &iter);
 917         break;
 918       }
 919
 920   while (mtf->head && mtf->head->type == MTF_FILE)
 921     if (!mtf_processing (NULL, mtf))
 922       break;
 923 }
 924
 925 /* Return a string in a static buffer describing V's variable type and
 926    width. */
 927 static char *
 928 var_type_description (struct variable *v)
 929 {
 930   static char buf[2][32];
 931   static int x = 0;
 932   char *s;
 933
 934   x ^= 1;
 935   s = buf[x];
 936
 937   if (v->type == NUMERIC)
 938     strcpy (s, "numeric");
 939   else
 940     {
 941       assert (v->type == ALPHA);
 942       sprintf (s, "string with width %d", v->width);
 943     }
 944   return s;
 945 }
 946
 947 /* Free FILE and associated data. */
 948 static void
 949 mtf_free_file (struct mtf_file *file)
 950 {
 951   fh_close_handle (file->handle);
 952   if (file->dict != NULL && file->dict != default_dict)
 953     dict_destroy (file->dict);
 954   free (file->by);
 955   if (file->handle)
 956     free (file->input);
 957   free (file);
 958 }
 959
 960 /* Free all the data for the MATCH FILES procedure. */
 961 static void
 962 mtf_free (struct mtf_proc *mtf)
 963 {
 964   struct mtf_file *iter, *next;
 965
 966   for (iter = mtf->head; iter; iter = next)
 967     {
 968       next = iter->next;
 969
 970       mtf_free_file (iter);
 971     }
 972
 973   free (mtf->by);
 974   if (mtf->dict)
 975     dict_destroy (mtf->dict);
 976   free (mtf->seq_nums);
 977 }
 978
 979 /* Remove *FILE from the mtf_file chain.  Make *FILE point to the next
 980    file in the chain, or to NULL if was the last in the chain. */
 981 static void
 982 mtf_delete_file_in_place (struct mtf_proc *mtf, struct mtf_file **file)
 983 {
 984   struct mtf_file *f = *file;
 985
 986   if (f->prev)
 987     f->prev->next = f->next;
 988   if (f->next)
 989     f->next->prev = f->prev;
 990   if (f == mtf->head)
 991     mtf->head = f->next;
 992   if (f == mtf->tail)
 993     mtf->tail = f->prev;
 994   *file = f->next;
 995
 996   {
 997     int i;
 998
 999     for (i = 0; i < dict_get_var_cnt (f->dict); i++)
1000       {
1001         struct variable *v = dict_get_var (f->dict, i);
1002
1003         if (v->type == NUMERIC)
1004           mtf->mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1005         else
1006           memset (mtf->mtf_case->data[v->p.mtf.master->fv].s, ' ', v->width);
1007       }
1008   }
1009
1010   mtf_free_file (f);
1011 }
1012
1013 /* Read a record from every input file except the active file. */
1014 static void
1015 mtf_read_nonactive_records (void *mtf_ UNUSED)
1016 {
1017   struct mtf_proc *mtf = mtf_;
1018   struct mtf_file *iter;
1019
1020   for (iter = mtf->head; iter; )
1021     {
1022       if (iter->handle)
1023         {
1024           assert (iter->input == NULL);
1025           iter->input = xmalloc (dict_get_case_size (iter->dict));
1026
1027           if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1028             mtf_delete_file_in_place (mtf, &iter);
1029           else
1030             iter = iter->next;
1031         }
1032       else
1033         iter = iter->next;
1034     }
1035 }
1036
1037 /* Compare the BY variables for files A and B; return -1 if A < B, 0
1038    if A == B, 1 if A > B. */
1039 static inline int
1040 mtf_compare_BY_values (struct mtf_proc *mtf,
1041                        struct mtf_file *a, struct mtf_file *b,
1042                        struct ccase *c)
1043 {
1044   union value *a_input, *b_input;
1045   int i;
1046
1047   assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
1048   a_input = a->input != NULL ? a->input : c->data;
1049   b_input = b->input != NULL ? b->input : c->data;
1050   for (i = 0; i < mtf->by_cnt; i++)
1051     {
1052       assert (a->by[i]->type == b->by[i]->type);
1053       assert (a->by[i]->width == b->by[i]->width);
1054
1055       if (a->by[i]->type == NUMERIC)
1056         {
1057           double af = a_input[a->by[i]->fv].f;
1058           double bf = b_input[b->by[i]->fv].f;
1059
1060           if (af < bf)
1061             return -1;
1062           else if (af > bf)
1063             return 1;
1064         }
1065       else
1066         {
1067           int result;
1068
1069           assert (a->by[i]->type == ALPHA);
1070           result = memcmp (a_input[a->by[i]->fv].s,
1071                            b_input[b->by[i]->fv].s,
1072                            a->by[i]->width);
1073           if (result < 0)
1074             return -1;
1075           else if (result > 0)
1076             return 1;
1077         }
1078     }
1079   return 0;
1080 }
1081
1082 /* Perform one iteration of steps 3...7 above. */
1083 static int
1084 mtf_processing (struct ccase *c, void *mtf_ UNUSED)
1085 {
1086   struct mtf_proc *mtf = mtf_;
1087   struct mtf_file *min_head, *min_tail; /* Files with minimum BY values. */
1088   struct mtf_file *max_head, *max_tail; /* Files with non-minimum BY values. */
1089   struct mtf_file *iter;                /* Iterator. */
1090
1091   for (;;)
1092     {
1093       /* If the active file doesn't have the minimum BY values, don't
1094          return because that would cause a record to be skipped. */
1095       int advance = 1;
1096
1097       if (mtf->head->type == MTF_TABLE)
1098         return 0;
1099
1100       /* 3. Find the FILE input record with minimum BY values.  Store
1101          all the values from this input record into the output record.
1102
1103          4. Find all the FILE input records with BY values identical
1104          to the minimums.  Store all the values from these input
1105          records into the output record. */
1106       min_head = min_tail = mtf->head;
1107       max_head = max_tail = NULL;
1108       for (iter = mtf->head->next; iter && iter->type == MTF_FILE;
1109            iter = iter->next)
1110         switch (mtf_compare_BY_values (mtf, min_head, iter, c))
1111           {
1112           case -1:
1113             if (max_head)
1114               max_tail = max_tail->next_min = iter;
1115             else
1116               max_head = max_tail = iter;
1117             break;
1118
1119           case 0:
1120             min_tail = min_tail->next_min = iter;
1121             break;
1122
1123           case 1:
1124             if (max_head)
1125               {
1126                 max_tail->next_min = min_head;
1127                 max_tail = min_tail;
1128               }
1129             else
1130               {
1131                 max_head = min_head;
1132                 max_tail = min_tail;
1133               }
1134             min_head = min_tail = iter;
1135             break;
1136
1137           default:
1138             assert (0);
1139           }
1140
1141       /* 5. For every TABLE, read another record as long as the BY
1142          values on the TABLE's input record are less than the FILEs'
1143          BY values.  If an exact match is found, store all the values
1144          from the TABLE input record into the output record. */
1145       while (iter)
1146         {
1147           struct mtf_file *next = iter->next;
1148
1149           assert (iter->type == MTF_TABLE);
1150
1151           if (iter->handle == NULL)
1152             advance = 0;
1153
1154         again:
1155           switch (mtf_compare_BY_values (mtf, min_head, iter, c))
1156             {
1157             case -1:
1158               if (max_head)
1159                 max_tail = max_tail->next_min = iter;
1160               else
1161                 max_head = max_tail = iter;
1162               break;
1163
1164             case 0:
1165               min_tail = min_tail->next_min = iter;
1166               break;
1167
1168             case 1:
1169               if (iter->handle == NULL)
1170                 return 1;
1171               if (sfm_read_case (iter->handle, iter->input, iter->dict))
1172                 goto again;
1173               mtf_delete_file_in_place (mtf, &iter);
1174               break;
1175
1176             default:
1177               assert (0);
1178             }
1179
1180           iter = next;
1181         }
1182
1183       /* Next sequence number. */
1184       mtf->seq_num++;
1185
1186       /* Store data to all the records we are using. */
1187       if (min_tail)
1188         min_tail->next_min = NULL;
1189       for (iter = min_head; iter; iter = iter->next_min)
1190         {
1191           int i;
1192
1193           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1194             {
1195               struct variable *v = dict_get_var (iter->dict, i);
1196               union value *record;
1197
1198               if (mtf->seq_nums[v->p.mtf.master->index] == mtf->seq_num)
1199                 continue;
1200               mtf->seq_nums[v->p.mtf.master->index] = mtf->seq_num;
1201
1202               record = iter->input != NULL ? iter->input : c->data;
1203
1204               assert (v->type == NUMERIC || v->type == ALPHA);
1205               if (v->type == NUMERIC)
1206                 mtf->mtf_case->data[v->p.mtf.master->fv].f = record[v->fv].f;
1207               else
1208                 memcpy (mtf->mtf_case->data[v->p.mtf.master->fv].s,
1209                         record[v->fv].s, v->width);
1210             }
1211         }
1212
1213       /* Store missing values to all the records we're not using. */
1214       if (max_tail)
1215         max_tail->next_min = NULL;
1216       for (iter = max_head; iter; iter = iter->next_min)
1217         {
1218           int i;
1219
1220           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1221             {
1222               struct variable *v = dict_get_var (iter->dict, i);
1223
1224               if (mtf->seq_nums[v->p.mtf.master->index] == mtf->seq_num)
1225                 continue;
1226               mtf->seq_nums[v->p.mtf.master->index] = mtf->seq_num;
1227
1228 #if 0
1229               printf ("%s/%s: dest-fv=%d\n",
1230                       fh_handle_name (iter->handle),
1231                       v->name,
1232                       v->p.mtf.master->fv);
1233 #endif
1234               if (v->type == NUMERIC)
1235                 mtf->mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1236               else
1237                 memset (mtf->mtf_case->data[v->p.mtf.master->fv].s, ' ',
1238                         v->width);
1239             }
1240
1241           if (iter->handle == NULL)
1242             advance = 0;
1243         }
1244
1245       /* 6. Write the output record. */
1246       mtf->sink->class->write (mtf->sink, mtf->mtf_case);
1247
1248       /* 7. Read another record from each input file FILE and TABLE
1249          that we stored values from above.  If we come to the end of
1250          one of the input files, remove it from the list of input
1251          files. */
1252       for (iter = min_head; iter && iter->type == MTF_FILE; )
1253         {
1254           struct mtf_file *next = iter->next_min;
1255
1256           if (iter->handle)
1257             {
1258               assert (iter->input != NULL);
1259
1260               if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1261                 mtf_delete_file_in_place (mtf, &iter);
1262             }
1263
1264           iter = next;
1265         }
1266
1267       if (advance)
1268         break;
1269     }
1270
1271   return (mtf->head && mtf->head->type != MTF_TABLE);
1272 }
1273
1274 /* Merge the dictionary for file F into the master dictionary
1275    mtf_dict. */
1276 static int
1277 mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
1278 {
1279   struct dictionary *d = f->dict;
1280   const char *d_docs, *m_docs;
1281
1282   if (dict_get_label (m) == NULL)
1283     dict_set_label (m, dict_get_label (d));
1284
1285   d_docs = dict_get_documents (d);
1286   m_docs = dict_get_documents (m);
1287   if (d_docs != NULL)
1288     {
1289       if (m_docs == NULL)
1290         dict_set_documents (m, d_docs);
1291       else
1292         {
1293           char *new_docs;
1294           size_t new_len;
1295
1296           new_len = strlen (m_docs) + strlen (d_docs);
1297           new_docs = xmalloc (new_len + 1);
1298           strcpy (new_docs, m_docs);
1299           strcat (new_docs, d_docs);
1300           dict_set_documents (m, new_docs);
1301           free (new_docs);
1302         }
1303     }
1304
1305   dict_compact_values (d);
1306
1307   {
1308     int i;
1309
1310     for (i = 0; i < dict_get_var_cnt (d); i++)
1311       {
1312         struct variable *dv = dict_get_var (d, i);
1313         struct variable *mv = dict_lookup_var (m, dv->name);
1314
1315         assert (dv->type == ALPHA || dv->width == 0);
1316         assert (!mv || mv->type == ALPHA || mv->width == 0);
1317         if (mv && dv->width == mv->width)
1318           {
1319             if (val_labs_count (dv->val_labs)
1320                 && !val_labs_count (mv->val_labs))
1321               mv->val_labs = val_labs_copy (dv->val_labs);
1322             if (dv->miss_type != MISSING_NONE
1323                 && mv->miss_type == MISSING_NONE)
1324               copy_missing_values (mv, dv);
1325           }
1326         if (mv && dv->label && !mv->label)
1327           mv->label = xstrdup (dv->label);
1328         if (!mv)
1329           {
1330             mv = dict_clone_var (m, dv, dv->name);
1331             assert (mv != NULL);
1332           }
1333         else if (mv->width != dv->width)
1334           {
1335             msg (SE, _("Variable %s in file %s (%s) has different "
1336                        "type or width from the same variable in "
1337                        "earlier file (%s)."),
1338                  dv->name, handle_get_name (f->handle),
1339                  var_type_description (dv), var_type_description (mv));
1340             return 0;
1341           }
1342         dv->p.mtf.master = mv;
1343       }
1344   }
1345
1346   return 1;
1347 }
1348 \f
1349 /* IMPORT command. */
1350
1351 /* Parses the IMPORT command. */
1352 int
1353 cmd_import (void)
1354 {
1355   struct file_handle *handle = NULL;
1356   struct dictionary *dict;
1357   struct get_pgm *pgm;
1358   int options = GTSV_OPT_NONE;
1359   int type;
1360
1361   for (;;)
1362     {
1363       lex_match ('/');
1364
1365       if (lex_match_id ("FILE") || token == T_STRING)
1366         {
1367           lex_match ('=');
1368
1369           handle = fh_parse_file_handle ();
1370           if (handle == NULL)
1371             return CMD_FAILURE;
1372         }
1373       else if (lex_match_id ("TYPE"))
1374         {
1375           lex_match ('=');
1376
1377           if (lex_match_id ("COMM"))
1378             type = PFM_COMM;
1379           else if (lex_match_id ("TAPE"))
1380             type = PFM_TAPE;
1381           else
1382             {
1383               lex_error (_("expecting COMM or TAPE"));
1384               return CMD_FAILURE;
1385             }
1386         }
1387       else break;
1388     }
1389   if (!lex_match ('/') && token != '.')
1390     {
1391       lex_error (NULL);
1392       return CMD_FAILURE;
1393     }
1394
1395   discard_variables ();
1396
1397   dict = pfm_read_dictionary (handle, NULL);
1398   if (dict == NULL)
1399     return CMD_FAILURE;
1400
1401 #if DEBUGGING
1402   dump_dict_variables (dict);
1403 #endif
1404   if (0 == trim_dictionary (dict, &options))
1405     {
1406       fh_close_handle (handle);
1407       return CMD_FAILURE;
1408     }
1409 #if DEBUGGING
1410   dump_dict_variables (dict);
1411 #endif
1412
1413   dict_compact_values (dict);
1414
1415 #if DEBUGGING
1416   printf (_("IMPORT translation table from file to memory:\n"));
1417   for (i = 0; i < dict->nvar; i++)
1418     {
1419       struct variable *v = dict->var[i];
1420
1421       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
1422               v->get.fv, v->get.nv, v->fv, v->nv);
1423     }
1424 #endif
1425
1426   dict_destroy (default_dict);
1427   default_dict = dict;
1428
1429   pgm = xmalloc (sizeof *pgm);
1430   pgm->handle = handle;
1431   pgm->case_size = dict_get_case_size (default_dict);
1432   vfm_source = create_case_source (&import_source_class, default_dict, pgm);
1433
1434   return CMD_SUCCESS;
1435 }
1436
1437 /* Reads all the cases from the data file and passes them to
1438    write_case(). */
1439 static void
1440 import_source_read (struct case_source *source,
1441                     struct ccase *c,
1442                     write_case_func *write_case, write_case_data wc_data)
1443 {
1444   struct get_pgm *pgm = source->aux;
1445
1446   while (pfm_read_case (pgm->handle, c->data, default_dict))
1447     if (!write_case (wc_data))
1448       break;
1449 }
1450
1451 const struct case_source_class import_source_class =
1452   {
1453     "IMPORT",
1454     NULL,
1455     import_source_read,
1456     get_source_destroy,
1457   };
1458 \f
1459 static int export_write_case_func (struct ccase *c, void *);
1460
1461 /* Parses the EXPORT command.  */
1462 /* FIXME: same as cmd_save_internal(). */
1463 int
1464 cmd_export (void)
1465 {
1466   struct file_handle *handle;
1467   struct dictionary *dict;
1468   int options = GTSV_OPT_SAVE;
1469
1470   struct save_trns *t;
1471
1472   int i;
1473
1474   lex_match ('/');
1475   if (lex_match_id ("OUTFILE"))
1476     lex_match ('=');
1477
1478   handle = fh_parse_file_handle ();
1479   if (handle == NULL)
1480     return CMD_FAILURE;
1481
1482   dict = dict_clone (default_dict);
1483 #if DEBUGGING
1484   dump_dict_variables (dict);
1485 #endif
1486   for (i = 0; i < dict_get_var_cnt (dict); i++)
1487     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
1488   if (0 == trim_dictionary (dict, &options))
1489     {
1490       fh_close_handle (handle);
1491       return CMD_FAILURE;
1492     }
1493
1494 #if DEBUGGING
1495   dump_dict_variables (dict);
1496 #endif
1497
1498   /* Write dictionary. */
1499   if (!pfm_write_dictionary (handle, dict))
1500     {
1501       dict_destroy (dict);
1502       fh_close_handle (handle);
1503       return CMD_FAILURE;
1504     }
1505
1506   /* Fill in transformation structure. */
1507   t = xmalloc (sizeof *t);
1508   t->h.proc = save_trns_proc;
1509   t->h.free = save_trns_free;
1510   t->f = handle;
1511   t->nvar = dict_get_var_cnt (dict);
1512   t->var = xmalloc (sizeof *t->var * t->nvar);
1513   for (i = 0; i < t->nvar; i++)
1514     t->var[i] = dict_get_var (dict, i)->aux;
1515   t->case_buf = xmalloc (sizeof *t->case_buf * t->nvar);
1516   dict_destroy (dict);
1517
1518   procedure (export_write_case_func, t);
1519   save_trns_free (&t->h);
1520
1521   return CMD_SUCCESS;
1522 }
1523
1524 /* Writes case C to the EXPORT file. */
1525 static int
1526 export_write_case_func (struct ccase *c, void *aux)
1527 {
1528   struct save_trns *t = aux;
1529   union value *p = (union value *) t->case_buf;
1530   int i;
1531
1532   for (i = 0; i < t->nvar; i++)
1533     {
1534       struct variable *v = t->var[i];
1535
1536       if (v->type == NUMERIC)
1537         *p++ = c->data[v->fv];
1538       else
1539         (*p++).c = c->data[v->fv].s;
1540     }
1541
1542   pfm_write_case (t->f, (union value *) t->case_buf);
1543   return 1;
1544 }