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