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