src/get.c

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