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