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 (NULL, save_write_case_func, NULL, 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_get_var (dict, i)->name[0] == '#')
 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 static void mtf_free (void);
 570 static void mtf_free_file (struct mtf_file *file);
 571 static int mtf_merge_dictionary (struct mtf_file *f);
 572 static void mtf_delete_file_in_place (struct mtf_file **file);
 573
 574 static void mtf_read_nonactive_records (void *);
 575 static void mtf_processing_finish (void *);
 576 static int mtf_processing (struct ccase *, void *);
 577
 578 static char *var_type_description (struct variable *);
 579
 580 /* Parse and execute the MATCH FILES command. */
 581 int
 582 cmd_match_files (void)
 583 {
 584   struct mtf_file *first_table = NULL;
 585
 586   int seen = 0;
 587
 588   lex_match_id ("MATCH");
 589   lex_match_id ("FILES");
 590
 591   mtf_head = mtf_tail = NULL;
 592   mtf_by = NULL;
 593   mtf_n_by = 0;
 594   mtf_master = dict_create ();
 595   mtf_seq_num = 0;
 596   mtf_seq_nums = NULL;
 597   dict_set_case_limit (mtf_master, dict_get_case_limit (default_dict));
 598
 599   do
 600     {
 601       lex_match ('/');
 602
 603       if (lex_match (T_BY))
 604         {
 605           if (seen & 1)
 606             {
 607               msg (SE, _("The BY subcommand may be given once at most."));
 608               goto lossage;
 609             }
 610           seen |= 1;
 611
 612           lex_match ('=');
 613           if (!parse_variables (mtf_master, &mtf_by, &mtf_n_by,
 614                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
 615             goto lossage;
 616         }
 617       else if (token != T_ID)
 618         {
 619           lex_error (NULL);
 620           goto lossage;
 621         }
 622       else if (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid))
 623         {
 624           struct mtf_file *file = xmalloc (sizeof *file);
 625
 626           file->in[0] = file->first[0] = file->last[0] = '\0';
 627           file->dict = NULL;
 628           file->by = NULL;
 629           file->input = NULL;
 630
 631           if (lex_match_id ("FILE"))
 632             file->type = MTF_FILE;
 633           else if (lex_match_id ("TABLE"))
 634             {
 635               file->type = MTF_TABLE;
 636               seen |= 4;
 637             }
 638           else
 639             assert (0);
 640
 641           /* FILEs go first, then TABLEs. */
 642           if (file->type == MTF_TABLE || first_table == NULL)
 643             {
 644               file->next = NULL;
 645               file->prev = mtf_tail;
 646               if (mtf_tail)
 647                 mtf_tail->next = file;
 648               mtf_tail = file;
 649               if (mtf_head == NULL)
 650                 mtf_head = file;
 651               if (file->type == MTF_TABLE && first_table == NULL)
 652                 first_table = file;
 653             }
 654           else
 655             {
 656               assert (file->type == MTF_FILE);
 657               file->next = first_table;
 658               file->prev = first_table->prev;
 659               if (first_table->prev)
 660                 first_table->prev->next = file;
 661               else
 662                 mtf_head = file;
 663               first_table->prev = file;
 664             }
 665
 666           lex_match ('=');
 667
 668           if (lex_match ('*'))
 669             {
 670               file->handle = NULL;
 671
 672               if (seen & 2)
 673                 {
 674                   msg (SE, _("The active file may not be specified more "
 675                              "than once."));
 676                   goto lossage;
 677                 }
 678               seen |= 2;
 679
 680               assert (pgm_state != STATE_INPUT);
 681               if (pgm_state == STATE_INIT)
 682                 {
 683                   msg (SE, _("Cannot specify the active file since no active "
 684                              "file has been defined."));
 685                   goto lossage;
 686                 }
 687             }
 688           else
 689             {
 690               file->handle = fh_parse_file_handle ();
 691               if (!file->handle)
 692                 goto lossage;
 693             }
 694
 695           if (file->handle)
 696             {
 697               file->dict = sfm_read_dictionary (file->handle, NULL);
 698               if (!file->dict)
 699                 goto lossage;
 700             }
 701           else
 702             file->dict = default_dict;
 703           if (!mtf_merge_dictionary (file))
 704             goto lossage;
 705         }
 706       else if (lex_id_match ("IN", tokid)
 707                || lex_id_match ("FIRST", tokid)
 708                || lex_id_match ("LAST", tokid))
 709         {
 710           const char *sbc;
 711           char *name;
 712
 713           if (mtf_tail == NULL)
 714             {
 715               msg (SE, _("IN, FIRST, and LAST subcommands may not occur "
 716                          "before the first FILE or TABLE."));
 717               goto lossage;
 718             }
 719
 720           if (lex_match_id ("IN"))
 721             {
 722               name = mtf_tail->in;
 723               sbc = "IN";
 724             }
 725           else if (lex_match_id ("FIRST"))
 726             {
 727               name = mtf_tail->first;
 728               sbc = "FIRST";
 729             }
 730           else if (lex_match_id ("LAST"))
 731             {
 732               name = mtf_tail->last;
 733               sbc = "LAST";
 734             }
 735           else
 736             assert (0);
 737
 738           lex_match ('=');
 739           if (token != T_ID)
 740             {
 741               lex_error (NULL);
 742               goto lossage;
 743             }
 744
 745           if (*name)
 746             {
 747               msg (SE, _("Multiple %s subcommands for a single FILE or "
 748                          "TABLE."),
 749                    sbc);
 750               goto lossage;
 751             }
 752           strcpy (name, tokid);
 753           lex_get ();
 754
 755           if (!dict_create_var (mtf_master, name, 0))
 756             {
 757               msg (SE, _("Duplicate variable name %s while creating %s "
 758                          "variable."),
 759                    name, sbc);
 760               goto lossage;
 761             }
 762         }
 763       else if (lex_id_match ("RENAME", tokid)
 764                || lex_id_match ("KEEP", tokid)
 765                || lex_id_match ("DROP", tokid))
 766         {
 767           int options = GTSV_OPT_MATCH_FILES;
 768
 769           if (mtf_tail == NULL)
 770             {
 771               msg (SE, _("RENAME, KEEP, and DROP subcommands may not occur "
 772                          "before the first FILE or TABLE."));
 773               goto lossage;
 774             }
 775
 776           if (!trim_dictionary (mtf_tail->dict, &options))
 777             goto lossage;
 778         }
 779       else if (lex_match_id ("MAP"))
 780         {
 781           /* FIXME. */
 782         }
 783       else
 784         {
 785           lex_error (NULL);
 786           goto lossage;
 787         }
 788     }
 789   while (token != '.');
 790
 791   if (seen & 4)
 792     {
 793       if (!(seen & 1))
 794         {
 795           msg (SE, _("The BY subcommand is required when a TABLE subcommand "
 796                      "is given."));
 797           goto lossage;
 798         }
 799     }
 800
 801   if (seen & 1)
 802     {
 803       struct mtf_file *iter;
 804
 805       for (iter = mtf_head; iter; iter = iter->next)
 806         {
 807           int i;
 808
 809           iter->by = xmalloc (sizeof *iter->by * mtf_n_by);
 810
 811           for (i = 0; i < mtf_n_by; i++)
 812             {
 813               iter->by[i] = dict_lookup_var (iter->dict, mtf_by[i]->name);
 814               if (iter->by[i] == NULL)
 815                 {
 816                   msg (SE, _("File %s lacks BY variable %s."),
 817                        iter->handle ? fh_handle_name (iter->handle) : "*",
 818                        mtf_by[i]->name);
 819                   goto lossage;
 820                 }
 821             }
 822         }
 823     }
 824
 825 #if DEBUGGING
 826   {
 827     /* From sfm-read.c. */
 828     extern void dump_dictionary (struct dictionary *);
 829
 830     dump_dictionary (mtf_master);
 831   }
 832 #endif
 833
 834   /* MATCH FILES performs an n-way merge on all its input files.
 835      Abstract algorithm:
 836
 837      1. Read one input record from every input FILE.
 838
 839      2. If no FILEs are left, stop.  Otherwise, proceed to step 3.
 840
 841      3. Find the FILE input record with minimum BY values.  Store all
 842      the values from this input record into the output record.
 843
 844      4. Find all the FILE input records with BY values identical to
 845      the minimums.  Store all the values from these input records into
 846      the output record.
 847
 848      5. For every TABLE, read another record as long as the BY values
 849      on the TABLE's input record are less than the FILEs' BY values.
 850      If an exact match is found, store all the values from the TABLE
 851      input record into the output record.
 852
 853      6. Write the output record.
 854
 855      7. Read another record from each input file FILE and TABLE that
 856      we stored values from above.  If we come to the end of one of the
 857      input files, remove it from the list of input files.
 858
 859      8. Repeat from step 2.
 860
 861      Unfortunately, this algorithm can't be directly implemented
 862      because there's no function to read a record from the active
 863      file; instead, it has to be done using callbacks.
 864
 865      FIXME: For merging large numbers of files (more than 10?) a
 866      better algorithm would use a heap for finding minimum
 867      values. */
 868
 869   if (!(seen & 2))
 870     discard_variables ();
 871
 872   temporary = 2;
 873   temp_dict = mtf_master;
 874   temp_trns = n_trns;
 875
 876   mtf_seq_nums = xmalloc (dict_get_var_cnt (mtf_master)
 877                           * sizeof *mtf_seq_nums);
 878   memset (mtf_seq_nums, 0,
 879           dict_get_var_cnt (mtf_master) * sizeof *mtf_seq_nums);
 880
 881   process_active_file (mtf_read_nonactive_records, mtf_processing,
 882                        mtf_processing_finish, NULL);
 883   mtf_master = NULL;
 884
 885   mtf_free ();
 886   return CMD_SUCCESS;
 887
 888 lossage:
 889   mtf_free ();
 890   return CMD_FAILURE;
 891 }
 892
 893 /* Repeats 2...8 an arbitrary number of times. */
 894 static void
 895 mtf_processing_finish (void *aux UNUSED)
 896 {
 897   /* Find the active file and delete it. */
 898   {
 899     struct mtf_file *iter;
 900
 901     for (iter = mtf_head; iter; iter = iter->next)
 902       if (iter->handle == NULL)
 903         {
 904           mtf_delete_file_in_place (&iter);
 905           break;
 906         }
 907   }
 908
 909   while (mtf_head && mtf_head->type == MTF_FILE)
 910     if (!mtf_processing (NULL, NULL))
 911       break;
 912 }
 913
 914 /* Return a string in a static buffer describing V's variable type and
 915    width. */
 916 static char *
 917 var_type_description (struct variable *v)
 918 {
 919   static char buf[2][32];
 920   static int x = 0;
 921   char *s;
 922
 923   x ^= 1;
 924   s = buf[x];
 925
 926   if (v->type == NUMERIC)
 927     strcpy (s, "numeric");
 928   else
 929     {
 930       assert (v->type == ALPHA);
 931       sprintf (s, "string with width %d", v->width);
 932     }
 933   return s;
 934 }
 935
 936 /* Free FILE and associated data. */
 937 static void
 938 mtf_free_file (struct mtf_file *file)
 939 {
 940   fh_close_handle (file->handle);
 941   if (file->dict != NULL && file->dict != default_dict)
 942     dict_destroy (file->dict);
 943   free (file->by);
 944   if (file->handle)
 945     free (file->input);
 946   free (file);
 947 }
 948
 949 /* Free all the data for the MATCH FILES procedure. */
 950 static void
 951 mtf_free (void)
 952 {
 953   struct mtf_file *iter, *next;
 954
 955   for (iter = mtf_head; iter; iter = next)
 956     {
 957       next = iter->next;
 958
 959       mtf_free_file (iter);
 960     }
 961
 962   free (mtf_by);
 963   if (mtf_master)
 964     dict_destroy (mtf_master);
 965   free (mtf_seq_nums);
 966 }
 967
 968 /* Remove *FILE from the mtf_file chain.  Make *FILE point to the next
 969    file in the chain, or to NULL if was the last in the chain. */
 970 static void
 971 mtf_delete_file_in_place (struct mtf_file **file)
 972 {
 973   struct mtf_file *f = *file;
 974
 975   if (f->prev)
 976     f->prev->next = f->next;
 977   if (f->next)
 978     f->next->prev = f->prev;
 979   if (f == mtf_head)
 980     mtf_head = f->next;
 981   if (f == mtf_tail)
 982     mtf_tail = f->prev;
 983   *file = f->next;
 984
 985   {
 986     int i;
 987
 988     for (i = 0; i < dict_get_var_cnt (f->dict); i++)
 989       {
 990         struct variable *v = dict_get_var (f->dict, i);
 991
 992         if (v->type == NUMERIC)
 993           compaction_case->data[v->p.mtf.master->fv].f = SYSMIS;
 994         else
 995           memset (compaction_case->data[v->p.mtf.master->fv].s, ' ',
 996                   v->width);
 997       }
 998   }
 999
1000   mtf_free_file (f);
1001 }
1002
1003 /* Read a record from every input file except the active file. */
1004 static void
1005 mtf_read_nonactive_records (void *aux UNUSED)
1006 {
1007   struct mtf_file *iter;
1008
1009   for (iter = mtf_head; iter; )
1010     {
1011       if (iter->handle)
1012         {
1013           assert (iter->input == NULL);
1014           iter->input = xmalloc (dict_get_case_size (iter->dict));
1015
1016           if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1017             mtf_delete_file_in_place (&iter);
1018           else
1019             iter = iter->next;
1020         }
1021       else
1022         iter = iter->next;
1023     }
1024 }
1025
1026 /* Compare the BY variables for files A and B; return -1 if A < B, 0
1027    if A == B, 1 if A > B. */
1028 static inline int
1029 mtf_compare_BY_values (struct mtf_file *a, struct mtf_file *b,
1030                        struct ccase *c)
1031 {
1032   union value *a_input, *b_input;
1033   int i;
1034
1035   assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
1036   a_input = a->input != NULL ? a->input : c->data;
1037   b_input = b->input != NULL ? b->input : c->data;
1038   for (i = 0; i < mtf_n_by; i++)
1039     {
1040       assert (a->by[i]->type == b->by[i]->type);
1041       assert (a->by[i]->width == b->by[i]->width);
1042
1043       if (a->by[i]->type == NUMERIC)
1044         {
1045           double af = a_input[a->by[i]->fv].f;
1046           double bf = b_input[b->by[i]->fv].f;
1047
1048           if (af < bf)
1049             return -1;
1050           else if (af > bf)
1051             return 1;
1052         }
1053       else
1054         {
1055           int result;
1056
1057           assert (a->by[i]->type == ALPHA);
1058           result = memcmp (a_input[a->by[i]->fv].s,
1059                            b_input[b->by[i]->fv].s,
1060                            a->by[i]->width);
1061           if (result < 0)
1062             return -1;
1063           else if (result > 0)
1064             return 1;
1065         }
1066     }
1067   return 0;
1068 }
1069
1070 /* Perform one iteration of steps 3...7 above. */
1071 static int
1072 mtf_processing (struct ccase *c, void *aux UNUSED)
1073 {
1074   /* List of files with minimum BY values. */
1075   struct mtf_file *min_head, *min_tail;
1076
1077   /* List of files with non-minimum BY values. */
1078   struct mtf_file *max_head, *max_tail;
1079
1080   /* Iterator. */
1081   struct mtf_file *iter;
1082
1083   for (;;)
1084     {
1085       /* If the active file doesn't have the minimum BY values, don't
1086          return because that would cause a record to be skipped. */
1087       int advance = 1;
1088
1089       if (mtf_head->type == MTF_TABLE)
1090         return 0;
1091
1092       /* 3. Find the FILE input record with minimum BY values.  Store
1093          all the values from this input record into the output record.
1094
1095          4. Find all the FILE input records with BY values identical
1096          to the minimums.  Store all the values from these input
1097          records into the output record. */
1098       min_head = min_tail = mtf_head;
1099       max_head = max_tail = NULL;
1100       for (iter = mtf_head->next; iter && iter->type == MTF_FILE;
1101            iter = iter->next)
1102         switch (mtf_compare_BY_values (min_head, iter, c))
1103           {
1104           case -1:
1105             if (max_head)
1106               max_tail = max_tail->next_min = iter;
1107             else
1108               max_head = max_tail = iter;
1109             break;
1110
1111           case 0:
1112             min_tail = min_tail->next_min = iter;
1113             break;
1114
1115           case 1:
1116             if (max_head)
1117               {
1118                 max_tail->next_min = min_head;
1119                 max_tail = min_tail;
1120               }
1121             else
1122               {
1123                 max_head = min_head;
1124                 max_tail = min_tail;
1125               }
1126             min_head = min_tail = iter;
1127             break;
1128
1129           default:
1130             assert (0);
1131           }
1132
1133       /* 5. For every TABLE, read another record as long as the BY
1134          values on the TABLE's input record are less than the FILEs'
1135          BY values.  If an exact match is found, store all the values
1136          from the TABLE input record into the output record. */
1137       while (iter)
1138         {
1139           struct mtf_file *next = iter->next;
1140
1141           assert (iter->type == MTF_TABLE);
1142
1143           if (iter->handle == NULL)
1144             advance = 0;
1145
1146         again:
1147           switch (mtf_compare_BY_values (min_head, iter, c))
1148             {
1149             case -1:
1150               if (max_head)
1151                 max_tail = max_tail->next_min = iter;
1152               else
1153                 max_head = max_tail = iter;
1154               break;
1155
1156             case 0:
1157               min_tail = min_tail->next_min = iter;
1158               break;
1159
1160             case 1:
1161               if (iter->handle == NULL)
1162                 return 1;
1163               if (sfm_read_case (iter->handle, iter->input, iter->dict))
1164                 goto again;
1165               mtf_delete_file_in_place (&iter);
1166               break;
1167
1168             default:
1169               assert (0);
1170             }
1171
1172           iter = next;
1173         }
1174
1175       /* Next sequence number. */
1176       mtf_seq_num++;
1177
1178       /* Store data to all the records we are using. */
1179       if (min_tail)
1180         min_tail->next_min = NULL;
1181       for (iter = min_head; iter; iter = iter->next_min)
1182         {
1183           int i;
1184
1185           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1186             {
1187               struct variable *v = dict_get_var (iter->dict, i);
1188               union value *record;
1189
1190               if (mtf_seq_nums[v->p.mtf.master->index] == mtf_seq_num)
1191                 continue;
1192               mtf_seq_nums[v->p.mtf.master->index] = mtf_seq_num;
1193
1194               record = iter->input != NULL ? iter->input : c->data;
1195
1196               assert (v->type == NUMERIC || v->type == ALPHA);
1197               if (v->type == NUMERIC)
1198                 compaction_case->data[v->p.mtf.master->fv].f = record[v->fv].f;
1199               else
1200                 memcpy (compaction_case->data[v->p.mtf.master->fv].s,
1201                         record[v->fv].s, v->width);
1202             }
1203         }
1204
1205       /* Store missing values to all the records we're not using. */
1206       if (max_tail)
1207         max_tail->next_min = NULL;
1208       for (iter = max_head; iter; iter = iter->next_min)
1209         {
1210           int i;
1211
1212           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1213             {
1214               struct variable *v = dict_get_var (iter->dict, i);
1215
1216               if (mtf_seq_nums[v->p.mtf.master->index] == mtf_seq_num)
1217                 continue;
1218               mtf_seq_nums[v->p.mtf.master->index] = mtf_seq_num;
1219
1220 #if 0
1221               printf ("%s/%s: dest-fv=%d\n",
1222                       fh_handle_name (iter->handle),
1223                       v->name,
1224                       v->p.mtf.master->fv);
1225 #endif
1226               if (v->type == NUMERIC)
1227                 compaction_case->data[v->p.mtf.master->fv].f = SYSMIS;
1228               else
1229                 memset (compaction_case->data[v->p.mtf.master->fv].s, ' ',
1230                         v->width);
1231             }
1232
1233           if (iter->handle == NULL)
1234             advance = 0;
1235         }
1236
1237       /* 6. Write the output record. */
1238       process_active_file_output_case (compaction_case);
1239
1240       /* 7. Read another record from each input file FILE and TABLE
1241          that we stored values from above.  If we come to the end of
1242          one of the input files, remove it from the list of input
1243          files. */
1244       for (iter = min_head; iter && iter->type == MTF_FILE; )
1245         {
1246           struct mtf_file *next = iter->next_min;
1247
1248           if (iter->handle)
1249             {
1250               assert (iter->input != NULL);
1251
1252               if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1253                 mtf_delete_file_in_place (&iter);
1254             }
1255
1256           iter = next;
1257         }
1258
1259       if (advance)
1260         break;
1261     }
1262
1263   return (mtf_head && mtf_head->type != MTF_TABLE);
1264 }
1265
1266 /* Merge the dictionary for file F into the master dictionary
1267    mtf_master. */
1268 static int
1269 mtf_merge_dictionary (struct mtf_file *f)
1270 {
1271   struct dictionary *const m = mtf_master;
1272   struct dictionary *d = f->dict;
1273   const char *d_docs, *m_docs;
1274
1275   if (dict_get_label (m) == NULL)
1276     dict_set_label (m, dict_get_label (d));
1277
1278   d_docs = dict_get_documents (d);
1279   m_docs = dict_get_documents (m);
1280   if (d_docs != NULL)
1281     {
1282       if (m_docs == NULL)
1283         dict_set_documents (m, d_docs);
1284       else
1285         {
1286           char *new_docs;
1287           size_t new_len;
1288
1289           new_len = strlen (m_docs) + strlen (d_docs);
1290           new_docs = xmalloc (new_len + 1);
1291           strcpy (new_docs, m_docs);
1292           strcat (new_docs, d_docs);
1293           dict_set_documents (m, new_docs);
1294           free (new_docs);
1295         }
1296     }
1297
1298   dict_compact_values (d);
1299
1300   {
1301     int i;
1302
1303     for (i = 0; i < dict_get_var_cnt (d); i++)
1304       {
1305         struct variable *dv = dict_get_var (d, i);
1306         struct variable *mv = dict_lookup_var (m, dv->name);
1307
1308         assert (dv->type == ALPHA || dv->width == 0);
1309         assert (!mv || mv->type == ALPHA || mv->width == 0);
1310         if (mv && dv->width == mv->width)
1311           {
1312             if (val_labs_count (dv->val_labs)
1313                 && !val_labs_count (mv->val_labs))
1314               mv->val_labs = val_labs_copy (dv->val_labs);
1315             if (dv->miss_type != MISSING_NONE
1316                 && mv->miss_type == MISSING_NONE)
1317               copy_missing_values (mv, dv);
1318           }
1319         if (mv && dv->label && !mv->label)
1320           mv->label = xstrdup (dv->label);
1321         if (!mv)
1322           {
1323             mv = dict_clone_var (m, dv, dv->name);
1324             assert (mv != NULL);
1325           }
1326         else if (mv->width != dv->width)
1327           {
1328             msg (SE, _("Variable %s in file %s (%s) has different "
1329                        "type or width from the same variable in "
1330                        "earlier file (%s)."),
1331                  dv->name, fh_handle_name (f->handle),
1332                  var_type_description (dv), var_type_description (mv));
1333             return 0;
1334           }
1335         dv->p.mtf.master = mv;
1336       }
1337   }
1338
1339   return 1;
1340 }
1341 \f
1342 /* IMPORT command. */
1343
1344 /* Parses the IMPORT command. */
1345 int
1346 cmd_import (void)
1347 {
1348   struct file_handle *handle = NULL;
1349   struct dictionary *dict;
1350   struct get_pgm *pgm;
1351   int options = GTSV_OPT_NONE;
1352   int type;
1353
1354   lex_match_id ("IMPORT");
1355
1356   for (;;)
1357     {
1358       lex_match ('/');
1359
1360       if (lex_match_id ("FILE") || token == T_STRING)
1361         {
1362           lex_match ('=');
1363
1364           handle = fh_parse_file_handle ();
1365           if (handle == NULL)
1366             return CMD_FAILURE;
1367         }
1368       else if (lex_match_id ("TYPE"))
1369         {
1370           lex_match ('=');
1371
1372           if (lex_match_id ("COMM"))
1373             type = PFM_COMM;
1374           else if (lex_match_id ("TAPE"))
1375             type = PFM_TAPE;
1376           else
1377             {
1378               lex_error (_("expecting COMM or TAPE"));
1379               return CMD_FAILURE;
1380             }
1381         }
1382       else break;
1383     }
1384   if (!lex_match ('/') && token != '.')
1385     {
1386       lex_error (NULL);
1387       return CMD_FAILURE;
1388     }
1389
1390   discard_variables ();
1391
1392   dict = pfm_read_dictionary (handle, NULL);
1393   if (dict == NULL)
1394     return CMD_FAILURE;
1395
1396 #if DEBUGGING
1397   dump_dict_variables (dict);
1398 #endif
1399   if (0 == trim_dictionary (dict, &options))
1400     {
1401       fh_close_handle (handle);
1402       return CMD_FAILURE;
1403     }
1404 #if DEBUGGING
1405   dump_dict_variables (dict);
1406 #endif
1407
1408   dict_compact_values (dict);
1409
1410 #if DEBUGGING
1411   printf (_("IMPORT translation table from file to memory:\n"));
1412   for (i = 0; i < dict->nvar; i++)
1413     {
1414       struct variable *v = dict->var[i];
1415
1416       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
1417               v->get.fv, v->get.nv, v->fv, v->nv);
1418     }
1419 #endif
1420
1421   dict_destroy (default_dict);
1422   default_dict = dict;
1423
1424   pgm = xmalloc (sizeof *pgm);
1425   pgm->handle = handle;
1426   pgm->case_size = dict_get_case_size (default_dict);
1427   vfm_source = create_case_source (&import_source_class, default_dict, pgm);
1428
1429   return CMD_SUCCESS;
1430 }
1431
1432 /* Reads all the cases from the data file and passes them to
1433    write_case(). */
1434 static void
1435 import_source_read (struct case_source *source,
1436                     struct ccase *c,
1437                     write_case_func *write_case, write_case_data wc_data)
1438 {
1439   struct get_pgm *pgm = source->aux;
1440
1441   while (pfm_read_case (pgm->handle, c->data, default_dict))
1442     if (!write_case (wc_data))
1443       break;
1444 }
1445
1446 const struct case_source_class import_source_class =
1447   {
1448     "IMPORT",
1449     NULL,
1450     import_source_read,
1451     get_source_destroy,
1452   };
1453 \f
1454 static int export_write_case_func (struct ccase *c, void *);
1455
1456 /* Parses the EXPORT command.  */
1457 /* FIXME: same as cmd_save_internal(). */
1458 int
1459 cmd_export (void)
1460 {
1461   struct file_handle *handle;
1462   struct dictionary *dict;
1463   int options = GTSV_OPT_SAVE;
1464
1465   struct save_trns *t;
1466
1467   int i;
1468
1469   lex_match_id ("EXPORT");
1470
1471   lex_match ('/');
1472   if (lex_match_id ("OUTFILE"))
1473     lex_match ('=');
1474
1475   handle = fh_parse_file_handle ();
1476   if (handle == NULL)
1477     return CMD_FAILURE;
1478
1479   dict = dict_clone (default_dict);
1480 #if DEBUGGING
1481   dump_dict_variables (dict);
1482 #endif
1483   for (i = 0; i < dict_get_var_cnt (dict); i++)
1484     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
1485   if (0 == trim_dictionary (dict, &options))
1486     {
1487       fh_close_handle (handle);
1488       return CMD_FAILURE;
1489     }
1490
1491 #if DEBUGGING
1492   dump_dict_variables (dict);
1493 #endif
1494
1495   /* Write dictionary. */
1496   if (!pfm_write_dictionary (handle, dict))
1497     {
1498       dict_destroy (dict);
1499       fh_close_handle (handle);
1500       return CMD_FAILURE;
1501     }
1502
1503   /* Fill in transformation structure. */
1504   t = xmalloc (sizeof *t);
1505   t->h.proc = save_trns_proc;
1506   t->h.free = save_trns_free;
1507   t->f = handle;
1508   t->nvar = dict_get_var_cnt (dict);
1509   t->var = xmalloc (sizeof *t->var * t->nvar);
1510   for (i = 0; i < t->nvar; i++)
1511     t->var[i] = dict_get_var (dict, i)->aux;
1512   t->case_buf = xmalloc (sizeof *t->case_buf * t->nvar);
1513   dict_destroy (dict);
1514
1515   procedure (NULL, export_write_case_func, NULL, t);
1516   save_trns_free (&t->h);
1517
1518   return CMD_SUCCESS;
1519 }
1520
1521 /* Writes case C to the EXPORT file. */
1522 static int
1523 export_write_case_func (struct ccase *c, void *aux)
1524 {
1525   struct save_trns *t = aux;
1526   union value *p = (union value *) t->case_buf;
1527   int i;
1528
1529   for (i = 0; i < t->nvar; i++)
1530     {
1531       struct variable *v = t->var[i];
1532
1533       if (v->type == NUMERIC)
1534         *p++ = c->data[v->fv];
1535       else
1536         (*p++).c = c->data[v->fv].s;
1537     }
1538
1539   pfm_write_case (t->f, (union value *) t->case_buf);
1540   return 1;
1541 }