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