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