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