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