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., 51 Franklin Street, Fifth Floor, Boston, MA
  18    02110-1301, USA. */
  19
  20 #include <config.h>
  21 #include "error.h"
  22 #include <stdlib.h>
  23 #include "alloc.h"
  24 #include "case.h"
  25 #include "command.h"
  26 #include "dictionary.h"
  27 #include "error.h"
  28 #include "file-handle.h"
  29 #include "hash.h"
  30 #include "lexer.h"
  31 #include "misc.h"
  32 #include "pfm-read.h"
  33 #include "pfm-write.h"
  34 #include "settings.h"
  35 #include "sfm-read.h"
  36 #include "sfm-write.h"
  37 #include "str.h"
  38 #include "value-labels.h"
  39 #include "var.h"
  40 #include "vfm.h"
  41 #include "vfmP.h"
  42
  43 #include "gettext.h"
  44 #define _(msgid) gettext (msgid)
  45
  46 #include "debug-print.h"
  47
  48 /* Rearranging and reducing a dictionary. */
  49 static void start_case_map (struct dictionary *);
  50 static struct case_map *finish_case_map (struct dictionary *);
  51 static void map_case (const struct case_map *,
  52                       const struct ccase *, struct ccase *);
  53 static void destroy_case_map (struct case_map *);
  54
  55 /* Operation type. */
  56 enum operation
  57   {
  58     OP_READ,    /* GET or IMPORT. */
  59     OP_SAVE,    /* SAVE or XSAVE. */
  60     OP_EXPORT   /* EXPORT. */
  61   };
  62
  63 static bool parse_dict_trim (struct dictionary *);
  64 \f
  65 /* GET input program. */
  66 struct get_pgm
  67   {
  68     struct sfm_reader *reader;  /* System file reader. */
  69     struct case_map *map;       /* Map from system file to active file dict. */
  70     struct ccase bounce;        /* Bounce buffer. */
  71   };
  72
  73 static void get_pgm_free (struct get_pgm *);
  74
  75 /* Parses the GET command. */
  76 int
  77 cmd_get (void)
  78 {
  79   struct get_pgm *pgm = NULL;
  80   struct file_handle *fh;
  81   struct dictionary *dict = NULL;
  82
  83   pgm = xmalloc (sizeof *pgm);
  84   pgm->reader = NULL;
  85   pgm->map = NULL;
  86   case_nullify (&pgm->bounce);
  87
  88   discard_variables ();
  89
  90   lex_match ('/');
  91   if (lex_match_id ("FILE"))
  92     lex_match ('=');
  93   fh = fh_parse ();
  94   if (fh == NULL)
  95     goto error;
  96
  97   pgm->reader = sfm_open_reader (fh, &dict, NULL);
  98   if (pgm->reader == NULL)
  99     goto error;
 100   case_create (&pgm->bounce, dict_get_next_value_idx (dict));
 101
 102   start_case_map (dict);
 103   while (lex_match ('/'))
 104     if (!parse_dict_trim (dict))
 105       goto error;
 106
 107   if (!lex_end_of_command ())
 108     return false;
 109
 110   dict_compact_values (dict);
 111   pgm->map = finish_case_map (dict);
 112
 113   dict_destroy (default_dict);
 114   default_dict = dict;
 115
 116   vfm_source = create_case_source (&get_source_class, pgm);
 117
 118   return CMD_SUCCESS;
 119
 120  error:
 121   get_pgm_free (pgm);
 122   if (dict != NULL)
 123     dict_destroy (dict);
 124   return CMD_FAILURE;
 125 }
 126
 127 /* Frees a struct get_pgm. */
 128 static void
 129 get_pgm_free (struct get_pgm *pgm)
 130 {
 131   if (pgm != NULL)
 132     {
 133       sfm_close_reader (pgm->reader);
 134       destroy_case_map (pgm->map);
 135       case_destroy (&pgm->bounce);
 136       free (pgm);
 137     }
 138 }
 139
 140 /* Clears internal state related to GET input procedure. */
 141 static void
 142 get_source_destroy (struct case_source *source)
 143 {
 144   struct get_pgm *pgm = source->aux;
 145   get_pgm_free (pgm);
 146 }
 147
 148 /* Reads all the cases from the data file into C and passes them
 149    to WRITE_CASE one by one, passing WC_DATA. */
 150 static void
 151 get_source_read (struct case_source *source,
 152                  struct ccase *c,
 153                  write_case_func *write_case, write_case_data wc_data)
 154 {
 155   struct get_pgm *pgm = source->aux;
 156   int ok;
 157
 158   do
 159     {
 160       if (pgm->map == NULL)
 161         ok = sfm_read_case (pgm->reader, c);
 162       else
 163         {
 164           ok = sfm_read_case (pgm->reader, &pgm->bounce);
 165           if (ok)
 166             map_case (pgm->map, &pgm->bounce, c);
 167         }
 168
 169       if (ok)
 170         ok = write_case (wc_data);
 171     }
 172   while (ok);
 173 }
 174
 175 const struct case_source_class get_source_class =
 176   {
 177     "GET",
 178     NULL,
 179     get_source_read,
 180     get_source_destroy,
 181   };
 182 \f
 183 /* Type of output file. */
 184 enum writer_type
 185   {
 186     SYSFILE_WRITER,     /* System file. */
 187     PORFILE_WRITER      /* Portable file. */
 188   };
 189
 190 /* Type of a command. */
 191 enum command_type
 192   {
 193     XFORM_CMD,          /* Transformation. */
 194     PROC_CMD            /* Procedure. */
 195   };
 196
 197 /* Portable or system file writer plus a case map. */
 198 struct any_writer
 199   {
 200     enum writer_type writer_type;
 201     void *writer;
 202     struct case_map *map;       /* Map to output file dictionary
 203                                    (null pointer for identity mapping). */
 204     struct ccase bounce;        /* Bounce buffer for mapping (if needed). */
 205   };
 206
 207 /* Destroys AW. */
 208 static void
 209 any_writer_destroy (struct any_writer *aw)
 210 {
 211   if (aw != NULL)
 212     {
 213       switch (aw->writer_type)
 214         {
 215         case PORFILE_WRITER:
 216           pfm_close_writer (aw->writer);
 217           break;
 218         case SYSFILE_WRITER:
 219           sfm_close_writer (aw->writer);
 220           break;
 221         }
 222       destroy_case_map (aw->map);
 223       case_destroy (&aw->bounce);
 224       free (aw);
 225     }
 226 }
 227
 228 /* Parses SAVE or XSAVE or EXPORT or XEXPORT command.
 229    WRITER_TYPE identifies the type of file to write,
 230    and COMMAND_TYPE identifies the type of command.
 231
 232    On success, returns a writer.
 233    For procedures only, sets *RETAIN_UNSELECTED to true if cases
 234    that would otherwise be excluded by FILTER or USE should be
 235    included.
 236
 237    On failure, returns a null pointer. */
 238 static struct any_writer *
 239 parse_write_command (enum writer_type writer_type,
 240                      enum command_type command_type,
 241                      bool *retain_unselected)
 242 {
 243   /* Common data. */
 244   struct file_handle *handle; /* Output file. */
 245   struct dictionary *dict;    /* Dictionary for output file. */
 246   struct any_writer *aw;      /* Writer. */
 247
 248   /* Common options. */
 249   bool print_map;             /* Print map?  TODO. */
 250   bool print_short_names;     /* Print long-to-short name map.  TODO. */
 251   struct sfm_write_options sysfile_opts;
 252   struct pfm_write_options porfile_opts;
 253
 254   assert (writer_type == SYSFILE_WRITER || writer_type == PORFILE_WRITER);
 255   assert (command_type == XFORM_CMD || command_type == PROC_CMD);
 256   assert ((retain_unselected != NULL) == (command_type == PROC_CMD));
 257
 258   if (command_type == PROC_CMD)
 259     *retain_unselected = true;
 260
 261   handle = NULL;
 262   dict = dict_clone (default_dict);
 263   aw = xmalloc (sizeof *aw);
 264   aw->writer_type = writer_type;
 265   aw->writer = NULL;
 266   aw->map = NULL;
 267   case_nullify (&aw->bounce);
 268   print_map = false;
 269   print_short_names = false;
 270   sysfile_opts = sfm_writer_default_options ();
 271   porfile_opts = pfm_writer_default_options ();
 272
 273   start_case_map (dict);
 274   dict_delete_scratch_vars (dict);
 275
 276   lex_match ('/');
 277   for (;;)
 278     {
 279       if (lex_match_id ("OUTFILE"))
 280         {
 281           if (handle != NULL)
 282             {
 283               lex_sbc_only_once ("OUTFILE");
 284               goto error;
 285             }
 286
 287           lex_match ('=');
 288
 289           handle = fh_parse ();
 290           if (handle == NULL)
 291             goto error;
 292         }
 293       else if (lex_match_id ("NAMES"))
 294         print_short_names = true;
 295       else if (lex_match_id ("PERMISSIONS"))
 296         {
 297           bool cw;
 298
 299           lex_match ('=');
 300           if (lex_match_id ("READONLY"))
 301             cw = false;
 302           else if (lex_match_id ("WRITEABLE"))
 303             cw = true;
 304           else
 305             {
 306               lex_error (_("expecting %s or %s"), "READONLY", "WRITEABLE");
 307               goto error;
 308             }
 309           sysfile_opts.create_writeable = porfile_opts.create_writeable = cw;
 310         }
 311       else if (command_type == PROC_CMD && lex_match_id ("UNSELECTED"))
 312         {
 313           lex_match ('=');
 314           if (lex_match_id ("RETAIN"))
 315             *retain_unselected = true;
 316           else if (lex_match_id ("DELETE"))
 317             *retain_unselected = false;
 318           else
 319             {
 320               lex_error (_("expecting %s or %s"), "RETAIN", "DELETE");
 321               goto error;
 322             }
 323         }
 324       else if (writer_type == SYSFILE_WRITER && lex_match_id ("COMPRESSED"))
 325         sysfile_opts.compress = true;
 326       else if (writer_type == SYSFILE_WRITER && lex_match_id ("UNCOMPRESSED"))
 327         sysfile_opts.compress = false;
 328       else if (writer_type == SYSFILE_WRITER && lex_match_id ("VERSION"))
 329         {
 330           lex_match ('=');
 331           if (!lex_force_int ())
 332             goto error;
 333           sysfile_opts.version = lex_integer ();
 334           lex_get ();
 335         }
 336       else if (writer_type == PORFILE_WRITER && lex_match_id ("TYPE"))
 337         {
 338           lex_match ('=');
 339           if (lex_match_id ("COMMUNICATIONS"))
 340             porfile_opts.type = PFM_COMM;
 341           else if (lex_match_id ("TAPE"))
 342             porfile_opts.type = PFM_TAPE;
 343           else
 344             {
 345               lex_error (_("expecting %s or %s"), "COMM", "TAPE");
 346               goto error;
 347             }
 348         }
 349       else if (writer_type == PORFILE_WRITER && lex_match_id ("DIGITS"))
 350         {
 351           lex_match ('=');
 352           if (!lex_force_int ())
 353             goto error;
 354           porfile_opts.digits = lex_integer ();
 355           lex_get ();
 356         }
 357       else if (!parse_dict_trim (dict))
 358         goto error;
 359
 360       if (!lex_match ('/'))
 361         break;
 362     }
 363   if (lex_end_of_command () != CMD_SUCCESS)
 364     goto error;
 365
 366   if (handle == NULL)
 367     {
 368       lex_sbc_missing ("OUTFILE");
 369       goto error;
 370     }
 371
 372   dict_compact_values (dict);
 373   aw->map = finish_case_map (dict);
 374   if (aw->map != NULL)
 375     case_create (&aw->bounce, dict_get_next_value_idx (dict));
 376
 377   switch (writer_type)
 378     {
 379     case SYSFILE_WRITER:
 380       aw->writer = sfm_open_writer (handle, dict, sysfile_opts);
 381       break;
 382     case PORFILE_WRITER:
 383       aw->writer = pfm_open_writer (handle, dict, porfile_opts);
 384       break;
 385     }
 386
 387   return aw;
 388
 389  error:
 390   any_writer_destroy (aw);
 391   dict_destroy (dict);
 392   return NULL;
 393 }
 394
 395 /* Writes case C to writer AW. */
 396 static void
 397 any_writer_write_case (struct any_writer *aw, struct ccase *c)
 398 {
 399   if (aw->map != NULL)
 400     {
 401       map_case (aw->map, c, &aw->bounce);
 402       c = &aw->bounce;
 403     }
 404
 405   switch (aw->writer_type)
 406     {
 407     case SYSFILE_WRITER:
 408       sfm_write_case (aw->writer, c);
 409       break;
 410     case PORFILE_WRITER:
 411       pfm_write_case (aw->writer, c);
 412       break;
 413     }
 414 }
 415 \f
 416 /* SAVE and EXPORT. */
 417
 418 static int output_proc (struct ccase *, void *);
 419
 420 /* Parses and performs the SAVE or EXPORT procedure. */
 421 static int
 422 parse_output_proc (enum writer_type writer_type)
 423 {
 424   bool retain_unselected;
 425   struct variable *saved_filter_variable;
 426   struct any_writer *aw;
 427
 428   aw = parse_write_command (writer_type, PROC_CMD, &retain_unselected);
 429   if (aw == NULL)
 430     return CMD_FAILURE;
 431
 432   saved_filter_variable = dict_get_filter (default_dict);
 433   if (retain_unselected)
 434     dict_set_filter (default_dict, NULL);
 435   procedure (output_proc, aw);
 436   dict_set_filter (default_dict, saved_filter_variable);
 437
 438   any_writer_destroy (aw);
 439   return CMD_SUCCESS;
 440 }
 441
 442 /* Writes case C to file. */
 443 static int
 444 output_proc (struct ccase *c, void *aw_)
 445 {
 446   struct any_writer *aw = aw_;
 447   any_writer_write_case (aw, c);
 448   return 0;
 449 }
 450
 451 int
 452 cmd_save (void)
 453 {
 454   return parse_output_proc (SYSFILE_WRITER);
 455 }
 456
 457 int
 458 cmd_export (void)
 459 {
 460   return parse_output_proc (PORFILE_WRITER);
 461 }
 462 \f
 463 /* XSAVE and XEXPORT. */
 464
 465 /* Transformation. */
 466 struct output_trns
 467   {
 468     struct trns_header h;       /* Header. */
 469     struct any_writer *aw;      /* Writer. */
 470   };
 471
 472 static trns_proc_func output_trns_proc;
 473 static trns_free_func output_trns_free;
 474
 475 /* Parses the XSAVE or XEXPORT transformation command. */
 476 static int
 477 parse_output_trns (enum writer_type writer_type)
 478 {
 479   struct output_trns *t = xmalloc (sizeof *t);
 480   t->h.proc = output_trns_proc;
 481   t->h.free = output_trns_free;
 482   t->aw = parse_write_command (writer_type, XFORM_CMD, NULL);
 483   if (t->aw == NULL)
 484     {
 485       free (t);
 486       return CMD_FAILURE;
 487     }
 488
 489   add_transformation (&t->h);
 490   return CMD_SUCCESS;
 491 }
 492
 493 /* Writes case C to the system file specified on XSAVE or XEXPORT. */
 494 static int
 495 output_trns_proc (struct trns_header *h, struct ccase *c, int case_num UNUSED)
 496 {
 497   struct output_trns *t = (struct output_trns *) h;
 498   any_writer_write_case (t->aw, c);
 499   return -1;
 500 }
 501
 502 /* Frees an XSAVE or XEXPORT transformation. */
 503 static void
 504 output_trns_free (struct trns_header *h)
 505 {
 506   struct output_trns *t = (struct output_trns *) h;
 507
 508   if (t != NULL)
 509     {
 510       any_writer_destroy (t->aw);
 511       free (t);
 512     }
 513 }
 514
 515 /* XSAVE command. */
 516 int
 517 cmd_xsave (void)
 518 {
 519   return parse_output_trns (SYSFILE_WRITER);
 520 }
 521
 522 /* XEXPORT command. */
 523 int
 524 cmd_xexport (void)
 525 {
 526   return parse_output_trns (PORFILE_WRITER);
 527 }
 528 \f
 529 static bool rename_variables (struct dictionary *dict);
 530 static bool drop_variables (struct dictionary *dict);
 531 static bool keep_variables (struct dictionary *dict);
 532
 533 /* Commands that read and write system files share a great deal
 534    of common syntactic structure for rearranging and dropping
 535    variables.  This function parses this syntax and modifies DICT
 536    appropriately.  Returns true on success, false on failure. */
 537 static bool
 538 parse_dict_trim (struct dictionary *dict)
 539 {
 540   if (lex_match_id ("MAP"))
 541     {
 542       /* FIXME. */
 543       return true;
 544     }
 545   else if (lex_match_id ("DROP"))
 546     return drop_variables (dict);
 547   else if (lex_match_id ("KEEP"))
 548     return keep_variables (dict);
 549   else if (lex_match_id ("RENAME"))
 550     return rename_variables (dict);
 551   else
 552     {
 553       lex_error (_("expecting a valid subcommand"));
 554       return false;
 555     }
 556 }
 557
 558 /* Parses and performs the RENAME subcommand of GET and SAVE. */
 559 static bool
 560 rename_variables (struct dictionary *dict)
 561 {
 562   size_t i;
 563
 564   int success = 0;
 565
 566   struct variable **v;
 567   char **new_names;
 568   size_t nv, nn;
 569   char *err_name;
 570
 571   int group;
 572
 573   lex_match ('=');
 574   if (token != '(')
 575     {
 576       struct variable *v;
 577
 578       v = parse_dict_variable (dict);
 579       if (v == NULL)
 580         return 0;
 581       if (!lex_force_match ('=')
 582           || !lex_force_id ())
 583         return 0;
 584       if (dict_lookup_var (dict, tokid) != NULL)
 585         {
 586           msg (SE, _("Cannot rename %s as %s because there already exists "
 587                      "a variable named %s.  To rename variables with "
 588                      "overlapping names, use a single RENAME subcommand "
 589                      "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
 590                      "\"/RENAME (A B C=B C A)\"."), v->name, tokid, tokid);
 591           return 0;
 592         }
 593
 594       dict_rename_var (dict, v, tokid);
 595       lex_get ();
 596       return 1;
 597     }
 598
 599   nv = nn = 0;
 600   v = NULL;
 601   new_names = 0;
 602   group = 1;
 603   while (lex_match ('('))
 604     {
 605       size_t old_nv = nv;
 606
 607       if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
 608         goto done;
 609       if (!lex_match ('='))
 610         {
 611           msg (SE, _("`=' expected after variable list."));
 612           goto done;
 613         }
 614       if (!parse_DATA_LIST_vars (&new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
 615         goto done;
 616       if (nn != nv)
 617         {
 618           msg (SE, _("Number of variables on left side of `=' (%d) does not "
 619                      "match number of variables on right side (%d), in "
 620                      "parenthesized group %d of RENAME subcommand."),
 621                (unsigned) (nv - old_nv), (unsigned) (nn - old_nv), group);
 622           goto done;
 623         }
 624       if (!lex_force_match (')'))
 625         goto done;
 626       group++;
 627     }
 628
 629   if (!dict_rename_vars (dict, v, new_names, nv, &err_name))
 630     {
 631       msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
 632       goto done;
 633     }
 634   success = 1;
 635
 636  done:
 637   for (i = 0; i < nn; i++)
 638     free (new_names[i]);
 639   free (new_names);
 640   free (v);
 641
 642   return success;
 643 }
 644
 645 /* Parses and performs the DROP subcommand of GET and SAVE.
 646    Returns true if successful, false on failure.*/
 647 static bool
 648 drop_variables (struct dictionary *dict)
 649 {
 650   struct variable **v;
 651   size_t nv;
 652
 653   lex_match ('=');
 654   if (!parse_variables (dict, &v, &nv, PV_NONE))
 655     return false;
 656   dict_delete_vars (dict, v, nv);
 657   free (v);
 658
 659   if (dict_get_var_cnt (dict) == 0)
 660     {
 661       msg (SE, _("Cannot DROP all variables from dictionary."));
 662       return false;
 663     }
 664   return true;
 665 }
 666
 667 /* Parses and performs the KEEP subcommand of GET and SAVE.
 668    Returns true if successful, false on failure.*/
 669 static bool
 670 keep_variables (struct dictionary *dict)
 671 {
 672   struct variable **v;
 673   size_t nv;
 674   size_t i;
 675
 676   lex_match ('=');
 677   if (!parse_variables (dict, &v, &nv, PV_NONE))
 678     return false;
 679
 680   /* Move the specified variables to the beginning. */
 681   dict_reorder_vars (dict, v, nv);
 682
 683   /* Delete the remaining variables. */
 684   v = xnrealloc (v, dict_get_var_cnt (dict) - nv, sizeof *v);
 685   for (i = nv; i < dict_get_var_cnt (dict); i++)
 686     v[i - nv] = dict_get_var (dict, i);
 687   dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
 688   free (v);
 689
 690   return true;
 691 }
 692 \f
 693 /* MATCH FILES. */
 694
 695 #include "debug-print.h"
 696
 697 /* File types. */
 698 enum
 699   {
 700     MTF_FILE,                   /* Specified on FILE= subcommand. */
 701     MTF_TABLE                   /* Specified on TABLE= subcommand. */
 702   };
 703
 704 /* One of the files on MATCH FILES. */
 705 struct mtf_file
 706   {
 707     struct mtf_file *next, *prev; /* Next, previous in the list of files. */
 708     struct mtf_file *next_min;  /* Next in the chain of minimums. */
 709
 710     int type;                   /* One of MTF_*. */
 711     struct variable **by;       /* List of BY variables for this file. */
 712     struct file_handle *handle; /* File handle. */
 713     struct sfm_reader *reader;  /* System file reader. */
 714     struct dictionary *dict;    /* Dictionary from system file. */
 715
 716     /* IN subcommand. */
 717     char *in_name;              /* Variable name. */
 718     struct variable *in_var;    /* Variable (in master dictionary). */
 719
 720     struct ccase input;         /* Input record. */
 721   };
 722
 723 /* MATCH FILES procedure. */
 724 struct mtf_proc
 725   {
 726     struct mtf_file *head;      /* First file mentioned on FILE or TABLE. */
 727     struct mtf_file *tail;      /* Last file mentioned on FILE or TABLE. */
 728
 729     size_t by_cnt;              /* Number of variables on BY subcommand. */
 730
 731     /* Names of FIRST, LAST variables. */
 732     char first[LONG_NAME_LEN + 1], last[LONG_NAME_LEN + 1];
 733
 734     struct dictionary *dict;    /* Dictionary of output file. */
 735     struct case_sink *sink;     /* Sink to receive output. */
 736     struct ccase mtf_case;      /* Case used for output. */
 737
 738     unsigned seq_num;           /* Have we initialized this variable? */
 739     unsigned *seq_nums;         /* Sequence numbers for each var in dict. */
 740   };
 741
 742 static void mtf_free (struct mtf_proc *);
 743 static void mtf_free_file (struct mtf_file *);
 744 static int mtf_merge_dictionary (struct dictionary *const, struct mtf_file *);
 745 static void mtf_delete_file_in_place (struct mtf_proc *, struct mtf_file **);
 746
 747 static void mtf_read_nonactive_records (void *);
 748 static void mtf_processing_finish (void *);
 749 static int mtf_processing (struct ccase *, void *);
 750
 751 static char *var_type_description (struct variable *);
 752
 753 static void set_master (struct variable *, struct variable *master);
 754 static struct variable *get_master (struct variable *);
 755
 756 /* Parse and execute the MATCH FILES command. */
 757 int
 758 cmd_match_files (void)
 759 {
 760   struct mtf_proc mtf;
 761   struct mtf_file *first_table = NULL;
 762   struct mtf_file *iter;
 763
 764   bool used_active_file = false;
 765   bool saw_table = false;
 766   bool saw_in = false;
 767
 768   mtf.head = mtf.tail = NULL;
 769   mtf.by_cnt = 0;
 770   mtf.first[0] = '\0';
 771   mtf.last[0] = '\0';
 772   mtf.dict = dict_create ();
 773   mtf.sink = NULL;
 774   case_nullify (&mtf.mtf_case);
 775   mtf.seq_num = 0;
 776   mtf.seq_nums = NULL;
 777   dict_set_case_limit (mtf.dict, dict_get_case_limit (default_dict));
 778
 779   lex_match ('/');
 780   while (token == T_ID
 781          && (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid)))
 782     {
 783       struct mtf_file *file = xmalloc (sizeof *file);
 784
 785       if (lex_match_id ("FILE"))
 786         file->type = MTF_FILE;
 787       else if (lex_match_id ("TABLE"))
 788         {
 789           file->type = MTF_TABLE;
 790           saw_table = true;
 791         }
 792       else
 793         assert (0);
 794       lex_match ('=');
 795
 796       file->by = NULL;
 797       file->handle = NULL;
 798       file->reader = NULL;
 799       file->dict = NULL;
 800       file->in_name = NULL;
 801       file->in_var = NULL;
 802       case_nullify (&file->input);
 803
 804       /* FILEs go first, then TABLEs. */
 805       if (file->type == MTF_TABLE || first_table == NULL)
 806         {
 807           file->next = NULL;
 808           file->prev = mtf.tail;
 809           if (mtf.tail)
 810             mtf.tail->next = file;
 811           mtf.tail = file;
 812           if (mtf.head == NULL)
 813             mtf.head = file;
 814           if (file->type == MTF_TABLE && first_table == NULL)
 815             first_table = file;
 816         }
 817       else
 818         {
 819           assert (file->type == MTF_FILE);
 820           file->next = first_table;
 821           file->prev = first_table->prev;
 822           if (first_table->prev)
 823             first_table->prev->next = file;
 824           else
 825             mtf.head = file;
 826           first_table->prev = file;
 827         }
 828
 829       if (lex_match ('*'))
 830         {
 831           file->handle = NULL;
 832           file->reader = NULL;
 833
 834           if (used_active_file)
 835             {
 836               msg (SE, _("The active file may not be specified more "
 837                          "than once."));
 838               goto error;
 839             }
 840           used_active_file = true;
 841
 842           assert (pgm_state != STATE_INPUT);
 843           if (pgm_state == STATE_INIT)
 844             {
 845               msg (SE, _("Cannot specify the active file since no active "
 846                          "file has been defined."));
 847               goto error;
 848             }
 849
 850           if (temporary != 0)
 851             {
 852               msg (SE,
 853                    _("MATCH FILES may not be used after TEMPORARY when "
 854                      "the active file is an input source.  "
 855                      "Temporary transformations will be made permanent."));
 856               cancel_temporary ();
 857             }
 858
 859           file->dict = default_dict;
 860         }
 861       else
 862         {
 863           file->handle = fh_parse ();
 864           if (file->handle == NULL)
 865             goto error;
 866
 867           file->reader = sfm_open_reader (file->handle, &file->dict, NULL);
 868           if (file->reader == NULL)
 869             goto error;
 870
 871           case_create (&file->input, dict_get_next_value_idx (file->dict));
 872         }
 873
 874       while (lex_match ('/'))
 875         if (lex_match_id ("RENAME"))
 876           {
 877             if (!rename_variables (file->dict))
 878               goto error;
 879           }
 880         else if (lex_match_id ("IN"))
 881           {
 882             lex_match ('=');
 883             if (token != T_ID)
 884               {
 885                 lex_error (NULL);
 886                 goto error;
 887               }
 888
 889             if (file->in_name != NULL)
 890               {
 891                 msg (SE, _("Multiple IN subcommands for a single FILE or "
 892                            "TABLE."));
 893                 goto error;
 894               }
 895             file->in_name = xstrdup (tokid);
 896             lex_get ();
 897             saw_in = true;
 898           }
 899
 900       mtf_merge_dictionary (mtf.dict, file);
 901     }
 902
 903   while (token != '.')
 904     {
 905       if (lex_match (T_BY))
 906         {
 907           struct variable **by;
 908
 909           if (mtf.by_cnt)
 910             {
 911               msg (SE, _("BY may appear at most once."));
 912               goto error;
 913             }
 914
 915           lex_match ('=');
 916           if (!parse_variables (mtf.dict, &by, &mtf.by_cnt,
 917                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
 918             goto error;
 919
 920           for (iter = mtf.head; iter != NULL; iter = iter->next)
 921             {
 922               size_t i;
 923
 924               iter->by = xnmalloc (mtf.by_cnt, sizeof *iter->by);
 925
 926               for (i = 0; i < mtf.by_cnt; i++)
 927                 {
 928                   iter->by[i] = dict_lookup_var (iter->dict, by[i]->name);
 929                   if (iter->by[i] == NULL)
 930                     {
 931                       msg (SE, _("File %s lacks BY variable %s."),
 932                            iter->handle ? handle_get_name (iter->handle) : "*",
 933                            by[i]->name);
 934                       free (by);
 935                       goto error;
 936                     }
 937                 }
 938             }
 939           free (by);
 940         }
 941       else if (lex_match_id ("FIRST"))
 942         {
 943           if (mtf.first[0] != '\0')
 944             {
 945               msg (SE, _("FIRST may appear at most once."));
 946               goto error;
 947             }
 948
 949           lex_match ('=');
 950           if (!lex_force_id ())
 951             goto error;
 952           strcpy (mtf.first, tokid);
 953           lex_get ();
 954         }
 955       else if (lex_match_id ("LAST"))
 956         {
 957           if (mtf.last[0] != '\0')
 958             {
 959               msg (SE, _("LAST may appear at most once."));
 960               goto error;
 961             }
 962
 963           lex_match ('=');
 964           if (!lex_force_id ())
 965             goto error;
 966           strcpy (mtf.last, tokid);
 967           lex_get ();
 968         }
 969       else if (lex_match_id ("MAP"))
 970         {
 971           /* FIXME. */
 972         }
 973       else if (lex_match_id ("DROP"))
 974         {
 975           if (!drop_variables (mtf.dict))
 976             goto error;
 977         }
 978       else if (lex_match_id ("KEEP"))
 979         {
 980           if (!keep_variables (mtf.dict))
 981             goto error;
 982         }
 983       else
 984         {
 985           lex_error (NULL);
 986           goto error;
 987         }
 988
 989       if (!lex_match ('/') && token != '.')
 990         {
 991           lex_end_of_command ();
 992           goto error;
 993         }
 994     }
 995
 996   if (mtf.by_cnt == 0)
 997     {
 998       if (saw_table)
 999         {
1000           msg (SE, _("BY is required when TABLE is specified."));
1001           goto error;
1002         }
1003       if (saw_in)
1004         {
1005           msg (SE, _("BY is required when IN is specified."));
1006           goto error;
1007         }
1008     }
1009
1010   /* Set up mapping from each file's variables to master
1011      variables. */
1012   for (iter = mtf.head; iter != NULL; iter = iter->next)
1013     {
1014       struct dictionary *d = iter->dict;
1015       int i;
1016
1017       for (i = 0; i < dict_get_var_cnt (d); i++)
1018         {
1019           struct variable *v = dict_get_var (d, i);
1020           struct variable *mv = dict_lookup_var (mtf.dict, v->name);
1021           if (mv != NULL)
1022             set_master (v, mv);
1023         }
1024     }
1025
1026   /* Add IN variables to master dictionary. */
1027   for (iter = mtf.head; iter != NULL; iter = iter->next)
1028     if (iter->in_name != NULL)
1029       {
1030         iter->in_var = dict_create_var (mtf.dict, iter->in_name, 0);
1031         if (iter->in_var == NULL)
1032           {
1033             msg (SE, _("IN variable name %s duplicates an "
1034                        "existing variable name."),
1035                  iter->in_var->name);
1036             goto error;
1037           }
1038         iter->in_var->print = iter->in_var->write
1039           = make_output_format (FMT_F, 1, 0);
1040       }
1041
1042   /* MATCH FILES performs an n-way merge on all its input files.
1043      Abstract algorithm:
1044
1045      1. Read one input record from every input FILE.
1046
1047      2. If no FILEs are left, stop.  Otherwise, proceed to step 3.
1048
1049      3. Find the FILE input record(s) that have minimum BY
1050      values.  Store all the values from these input records into
1051      the output record.
1052
1053      4. For every TABLE, read another record as long as the BY values
1054      on the TABLE's input record are less than the FILEs' BY values.
1055      If an exact match is found, store all the values from the TABLE
1056      input record into the output record.
1057
1058      5. Write the output record.
1059
1060      6. Read another record from each input file FILE and TABLE that
1061      we stored values from above.  If we come to the end of one of the
1062      input files, remove it from the list of input files.
1063
1064      7. Repeat from step 2.
1065
1066      Unfortunately, this algorithm can't be implemented in a
1067      straightforward way because there's no function to read a
1068      record from the active file.  Instead, it has to be written
1069      as a state machine.
1070
1071      FIXME: For merging large numbers of files (more than 10?) a
1072      better algorithm would use a heap for finding minimum
1073      values. */
1074
1075   if (!used_active_file)
1076     discard_variables ();
1077
1078   dict_compact_values (mtf.dict);
1079   mtf.sink = create_case_sink (&storage_sink_class, mtf.dict, NULL);
1080   if (mtf.sink->class->open != NULL)
1081     mtf.sink->class->open (mtf.sink);
1082
1083   mtf.seq_nums = xcalloc (dict_get_var_cnt (mtf.dict), sizeof *mtf.seq_nums);
1084   case_create (&mtf.mtf_case, dict_get_next_value_idx (mtf.dict));
1085
1086   mtf_read_nonactive_records (&mtf);
1087   if (used_active_file)
1088     procedure (mtf_processing, &mtf);
1089   mtf_processing_finish (&mtf);
1090
1091   free_case_source (vfm_source);
1092   vfm_source = NULL;
1093
1094   dict_destroy (default_dict);
1095   default_dict = mtf.dict;
1096   mtf.dict = NULL;
1097   vfm_source = mtf.sink->class->make_source (mtf.sink);
1098   free_case_sink (mtf.sink);
1099
1100   mtf_free (&mtf);
1101   return CMD_SUCCESS;
1102
1103  error:
1104   mtf_free (&mtf);
1105   return CMD_FAILURE;
1106 }
1107
1108 /* Repeats 2...7 an arbitrary number of times. */
1109 static void
1110 mtf_processing_finish (void *mtf_)
1111 {
1112   struct mtf_proc *mtf = mtf_;
1113   struct mtf_file *iter;
1114
1115   /* Find the active file and delete it. */
1116   for (iter = mtf->head; iter; iter = iter->next)
1117     if (iter->handle == NULL)
1118       {
1119         mtf_delete_file_in_place (mtf, &iter);
1120         break;
1121       }
1122
1123   while (mtf->head && mtf->head->type == MTF_FILE)
1124     if (!mtf_processing (NULL, mtf))
1125       break;
1126 }
1127
1128 /* Return a string in a static buffer describing V's variable type and
1129    width. */
1130 static char *
1131 var_type_description (struct variable *v)
1132 {
1133   static char buf[2][32];
1134   static int x = 0;
1135   char *s;
1136
1137   x ^= 1;
1138   s = buf[x];
1139
1140   if (v->type == NUMERIC)
1141     strcpy (s, "numeric");
1142   else
1143     {
1144       assert (v->type == ALPHA);
1145       sprintf (s, "string with width %d", v->width);
1146     }
1147   return s;
1148 }
1149
1150 /* Free FILE and associated data. */
1151 static void
1152 mtf_free_file (struct mtf_file *file)
1153 {
1154   free (file->by);
1155   sfm_close_reader (file->reader);
1156   if (file->dict != default_dict)
1157     dict_destroy (file->dict);
1158   case_destroy (&file->input);
1159   free (file->in_name);
1160   free (file);
1161 }
1162
1163 /* Free all the data for the MATCH FILES procedure. */
1164 static void
1165 mtf_free (struct mtf_proc *mtf)
1166 {
1167   struct mtf_file *iter, *next;
1168
1169   for (iter = mtf->head; iter; iter = next)
1170     {
1171       next = iter->next;
1172       mtf_free_file (iter);
1173     }
1174
1175   if (mtf->dict)
1176     dict_destroy (mtf->dict);
1177   case_destroy (&mtf->mtf_case);
1178   free (mtf->seq_nums);
1179 }
1180
1181 /* Remove *FILE from the mtf_file chain.  Make *FILE point to the next
1182    file in the chain, or to NULL if was the last in the chain. */
1183 static void
1184 mtf_delete_file_in_place (struct mtf_proc *mtf, struct mtf_file **file)
1185 {
1186   struct mtf_file *f = *file;
1187   int i;
1188
1189   if (f->prev)
1190     f->prev->next = f->next;
1191   if (f->next)
1192     f->next->prev = f->prev;
1193   if (f == mtf->head)
1194     mtf->head = f->next;
1195   if (f == mtf->tail)
1196     mtf->tail = f->prev;
1197   *file = f->next;
1198
1199   if (f->in_var != NULL)
1200     case_data_rw (&mtf->mtf_case, f->in_var->fv)->f = 0.;
1201   for (i = 0; i < dict_get_var_cnt (f->dict); i++)
1202     {
1203       struct variable *v = dict_get_var (f->dict, i);
1204       struct variable *mv = get_master (v);
1205       if (mv != NULL)
1206         {
1207           union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
1208
1209           if (v->type == NUMERIC)
1210             out->f = SYSMIS;
1211           else
1212             memset (out->s, ' ', v->width);
1213         }
1214     }
1215
1216   mtf_free_file (f);
1217 }
1218
1219 /* Read a record from every input file except the active file. */
1220 static void
1221 mtf_read_nonactive_records (void *mtf_)
1222 {
1223   struct mtf_proc *mtf = mtf_;
1224   struct mtf_file *iter, *next;
1225
1226   for (iter = mtf->head; iter != NULL; iter = next)
1227     {
1228       next = iter->next;
1229       if (iter->handle && !sfm_read_case (iter->reader, &iter->input))
1230         mtf_delete_file_in_place (mtf, &iter);
1231     }
1232 }
1233
1234 /* Compare the BY variables for files A and B; return -1 if A < B, 0
1235    if A == B, 1 if A > B. */
1236 static inline int
1237 mtf_compare_BY_values (struct mtf_proc *mtf,
1238                        struct mtf_file *a, struct mtf_file *b,
1239                        struct ccase *c)
1240 {
1241   struct ccase *ca = case_is_null (&a->input) ? c : &a->input;
1242   struct ccase *cb = case_is_null (&b->input) ? c : &b->input;
1243   assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
1244   return case_compare_2dict (ca, cb, a->by, b->by, mtf->by_cnt);
1245 }
1246
1247 /* Perform one iteration of steps 3...7 above. */
1248 static int
1249 mtf_processing (struct ccase *c, void *mtf_)
1250 {
1251   struct mtf_proc *mtf = mtf_;
1252
1253   /* Do we need another record from the active file? */
1254   bool read_active_file;
1255
1256   assert (mtf->head != NULL);
1257   if (mtf->head->type == MTF_TABLE)
1258     return 1;
1259
1260   do
1261     {
1262       struct mtf_file *min_head, *min_tail; /* Files with minimum BY values. */
1263       struct mtf_file *max_head, *max_tail; /* Files with non-minimum BYs. */
1264       struct mtf_file *iter, *next;
1265
1266       read_active_file = false;
1267
1268       /* 3. Find the FILE input record(s) that have minimum BY
1269          values.  Store all the values from these input records into
1270          the output record. */
1271       min_head = min_tail = mtf->head;
1272       max_head = max_tail = NULL;
1273       for (iter = mtf->head->next; iter && iter->type == MTF_FILE;
1274            iter = iter->next)
1275         {
1276           int cmp = mtf_compare_BY_values (mtf, min_head, iter, c);
1277           if (cmp < 0)
1278             {
1279               if (max_head)
1280                 max_tail = max_tail->next_min = iter;
1281               else
1282                 max_head = max_tail = iter;
1283             }
1284           else if (cmp == 0)
1285             min_tail = min_tail->next_min = iter;
1286           else /* cmp > 0 */
1287             {
1288               if (max_head)
1289                 {
1290                   max_tail->next_min = min_head;
1291                   max_tail = min_tail;
1292                 }
1293               else
1294                 {
1295                   max_head = min_head;
1296                   max_tail = min_tail;
1297                 }
1298               min_head = min_tail = iter;
1299             }
1300         }
1301
1302       /* 4. For every TABLE, read another record as long as the BY
1303          values on the TABLE's input record are less than the FILEs'
1304          BY values.  If an exact match is found, store all the values
1305          from the TABLE input record into the output record. */
1306       for (; iter != NULL; iter = next)
1307         {
1308           assert (iter->type == MTF_TABLE);
1309
1310           next = iter->next;
1311           for (;;)
1312             {
1313               int cmp = mtf_compare_BY_values (mtf, min_head, iter, c);
1314               if (cmp < 0)
1315                 {
1316                   if (max_head)
1317                     max_tail = max_tail->next_min = iter;
1318                   else
1319                     max_head = max_tail = iter;
1320                 }
1321               else if (cmp == 0)
1322                 min_tail = min_tail->next_min = iter;
1323               else /* cmp > 0 */
1324                 {
1325                   if (iter->handle == NULL)
1326                     return 1;
1327                   if (sfm_read_case (iter->reader, &iter->input))
1328                     continue;
1329                   mtf_delete_file_in_place (mtf, &iter);
1330                 }
1331               break;
1332             }
1333         }
1334
1335       /* Next sequence number. */
1336       mtf->seq_num++;
1337
1338       /* Store data to all the records we are using. */
1339       if (min_tail)
1340         min_tail->next_min = NULL;
1341       for (iter = min_head; iter; iter = iter->next_min)
1342         {
1343           int i;
1344
1345           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1346             {
1347               struct variable *v = dict_get_var (iter->dict, i);
1348               struct variable *mv = get_master (v);
1349
1350               if (mv != NULL && mtf->seq_nums[mv->index] != mtf->seq_num)
1351                 {
1352                   struct ccase *record
1353                     = case_is_null (&iter->input) ? c : &iter->input;
1354                   union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
1355
1356                   mtf->seq_nums[mv->index] = mtf->seq_num;
1357                   if (v->type == NUMERIC)
1358                     out->f = case_num (record, v->fv);
1359                   else
1360                     memcpy (out->s, case_str (record, v->fv), v->width);
1361                 }
1362             }
1363           if (iter->in_var != NULL)
1364             case_data_rw (&mtf->mtf_case, iter->in_var->fv)->f = 1.;
1365
1366           if (iter->type == MTF_FILE && iter->handle == NULL)
1367             read_active_file = true;
1368         }
1369
1370       /* Store missing values to all the records we're not
1371          using. */
1372       if (max_tail)
1373         max_tail->next_min = NULL;
1374       for (iter = max_head; iter; iter = iter->next_min)
1375         {
1376           int i;
1377
1378           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1379             {
1380               struct variable *v = dict_get_var (iter->dict, i);
1381               struct variable *mv = get_master (v);
1382
1383               if (mv != NULL && mtf->seq_nums[mv->index] != mtf->seq_num)
1384                 {
1385                   union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
1386                   mtf->seq_nums[mv->index] = mtf->seq_num;
1387
1388                   if (v->type == NUMERIC)
1389                     out->f = SYSMIS;
1390                   else
1391                     memset (out->s, ' ', v->width);
1392                 }
1393             }
1394           if (iter->in_var != NULL)
1395             case_data_rw (&mtf->mtf_case, iter->in_var->fv)->f = 0.;
1396         }
1397
1398       /* 5. Write the output record. */
1399       mtf->sink->class->write (mtf->sink, &mtf->mtf_case);
1400
1401       /* 6. Read another record from each input file FILE and TABLE
1402          that we stored values from above.  If we come to the end of
1403          one of the input files, remove it from the list of input
1404          files. */
1405       for (iter = min_head; iter && iter->type == MTF_FILE; iter = next)
1406         {
1407           next = iter->next_min;
1408           if (iter->reader != NULL
1409               && !sfm_read_case (iter->reader, &iter->input))
1410             mtf_delete_file_in_place (mtf, &iter);
1411         }
1412     }
1413   while (!read_active_file
1414          && mtf->head != NULL && mtf->head->type == MTF_FILE);
1415
1416   return mtf->head != NULL && mtf->head->type == MTF_FILE;
1417 }
1418
1419 /* Merge the dictionary for file F into master dictionary M. */
1420 static int
1421 mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
1422 {
1423   struct dictionary *d = f->dict;
1424   const char *d_docs, *m_docs;
1425   int i;
1426
1427   if (dict_get_label (m) == NULL)
1428     dict_set_label (m, dict_get_label (d));
1429
1430   d_docs = dict_get_documents (d);
1431   m_docs = dict_get_documents (m);
1432   if (d_docs != NULL)
1433     {
1434       if (m_docs == NULL)
1435         dict_set_documents (m, d_docs);
1436       else
1437         {
1438           char *new_docs;
1439           size_t new_len;
1440
1441           new_len = strlen (m_docs) + strlen (d_docs);
1442           new_docs = xmalloc (new_len + 1);
1443           strcpy (new_docs, m_docs);
1444           strcat (new_docs, d_docs);
1445           dict_set_documents (m, new_docs);
1446           free (new_docs);
1447         }
1448     }
1449
1450   for (i = 0; i < dict_get_var_cnt (d); i++)
1451     {
1452       struct variable *dv = dict_get_var (d, i);
1453       struct variable *mv = dict_lookup_var (m, dv->name);
1454
1455       if (dict_class_from_id (dv->name) == DC_SCRATCH)
1456         continue;
1457
1458       if (mv != NULL)
1459         {
1460           if (mv->width != dv->width)
1461             {
1462               msg (SE, _("Variable %s in file %s (%s) has different "
1463                          "type or width from the same variable in "
1464                          "earlier file (%s)."),
1465                    dv->name, handle_get_name (f->handle),
1466                    var_type_description (dv), var_type_description (mv));
1467               return 0;
1468             }
1469
1470           if (dv->width == mv->width)
1471             {
1472               if (val_labs_count (dv->val_labs)
1473                   && !val_labs_count (mv->val_labs))
1474                 mv->val_labs = val_labs_copy (dv->val_labs);
1475               if (!mv_is_empty (&dv->miss) && mv_is_empty (&mv->miss))
1476                 mv_copy (&mv->miss, &dv->miss);
1477             }
1478
1479           if (dv->label && !mv->label)
1480             mv->label = xstrdup (dv->label);
1481         }
1482       else
1483         mv = dict_clone_var_assert (m, dv, dv->name);
1484     }
1485
1486   return 1;
1487 }
1488
1489 /* Marks V's master variable as MASTER. */
1490 static void
1491 set_master (struct variable *v, struct variable *master)
1492 {
1493   var_attach_aux (v, master, NULL);
1494 }
1495
1496 /* Returns the master variable corresponding to V,
1497    as set with set_master(). */
1498 static struct variable *
1499 get_master (struct variable *v)
1500 {
1501   return v->aux;
1502 }
1503 \f
1504 /* IMPORT command. */
1505
1506 /* IMPORT input program. */
1507 struct import_pgm
1508   {
1509     struct pfm_reader *reader;  /* Portable file reader. */
1510     struct case_map *map;       /* Map from system file to active file dict. */
1511     struct ccase bounce;        /* Bounce buffer. */
1512   };
1513
1514 static void import_pgm_free (struct import_pgm *);
1515
1516 /* Parses the IMPORT command. */
1517 int
1518 cmd_import (void)
1519 {
1520   struct import_pgm *pgm = NULL;
1521   struct file_handle *fh = NULL;
1522   struct dictionary *dict = NULL;
1523   enum pfm_type type;
1524
1525   lex_match ('/');
1526   for (;;)
1527     {
1528       if (pgm == NULL && (lex_match_id ("FILE") || token == T_STRING))
1529         {
1530           lex_match ('=');
1531
1532           fh = fh_parse ();
1533           if (fh == NULL)
1534             goto error;
1535         }
1536       else if (pgm == NULL && lex_match_id ("TYPE"))
1537         {
1538           lex_match ('=');
1539
1540           if (lex_match_id ("COMM"))
1541             type = PFM_COMM;
1542           else if (lex_match_id ("TAPE"))
1543             type = PFM_TAPE;
1544           else
1545             {
1546               lex_error (_("expecting COMM or TAPE"));
1547               goto error;
1548             }
1549         }
1550       else
1551         {
1552           if (pgm == NULL)
1553             {
1554               if (fh == NULL)
1555                 {
1556                   lex_sbc_missing ("FILE");
1557                   goto error;
1558                 }
1559
1560               discard_variables ();
1561
1562               pgm = xmalloc (sizeof *pgm);
1563               pgm->reader = pfm_open_reader (fh, &dict, NULL);
1564               pgm->map = NULL;
1565               case_nullify (&pgm->bounce);
1566               if (pgm->reader == NULL)
1567                 goto error;
1568
1569               case_create (&pgm->bounce, dict_get_next_value_idx (dict));
1570
1571               start_case_map (dict);
1572             }
1573
1574           if (token == '.')
1575             break;
1576
1577           if (!parse_dict_trim (dict))
1578             goto error;
1579         }
1580
1581       lex_match ('/');
1582     }
1583   if (pgm == NULL)
1584     {
1585       lex_error (NULL);
1586       goto error;
1587     }
1588
1589   pgm->map = finish_case_map (dict);
1590
1591   dict_destroy (default_dict);
1592   default_dict = dict;
1593
1594   vfm_source = create_case_source (&import_source_class, pgm);
1595
1596   return CMD_SUCCESS;
1597
1598  error:
1599   import_pgm_free (pgm);
1600   if (dict != NULL)
1601     dict_destroy (dict);
1602   return CMD_FAILURE;
1603 }
1604
1605 /* Frees a struct import_pgm. */
1606 static void
1607 import_pgm_free (struct import_pgm *pgm)
1608 {
1609   if (pgm != NULL)
1610     {
1611       pfm_close_reader (pgm->reader);
1612       destroy_case_map (pgm->map);
1613       case_destroy (&pgm->bounce);
1614       free (pgm);
1615     }
1616 }
1617
1618 /* Clears internal state related to IMPORT input procedure. */
1619 static void
1620 import_source_destroy (struct case_source *source)
1621 {
1622   struct import_pgm *pgm = source->aux;
1623   import_pgm_free (pgm);
1624 }
1625
1626 /* Reads all the cases from the data file into C and passes them
1627    to WRITE_CASE one by one, passing WC_DATA. */
1628 static void
1629 import_source_read (struct case_source *source,
1630                  struct ccase *c,
1631                  write_case_func *write_case, write_case_data wc_data)
1632 {
1633   struct import_pgm *pgm = source->aux;
1634   int ok;
1635
1636   do
1637     {
1638       if (pgm->map == NULL)
1639         ok = pfm_read_case (pgm->reader, c);
1640       else
1641         {
1642           ok = pfm_read_case (pgm->reader, &pgm->bounce);
1643           if (ok)
1644             map_case (pgm->map, &pgm->bounce, c);
1645         }
1646
1647       if (ok)
1648         ok = write_case (wc_data);
1649     }
1650   while (ok);
1651 }
1652
1653 const struct case_source_class import_source_class =
1654   {
1655     "IMPORT",
1656     NULL,
1657     import_source_read,
1658     import_source_destroy,
1659   };
1660
1661 \f
1662 /* Case map.
1663
1664    A case map copies data from a case that corresponds for one
1665    dictionary to a case that corresponds to a second dictionary
1666    derived from the first by, optionally, deleting, reordering,
1667    or renaming variables.  (No new variables may be created.)
1668    */
1669
1670 /* A case map. */
1671 struct case_map
1672   {
1673     size_t value_cnt;   /* Number of values in map. */
1674     int *map;           /* For each destination index, the
1675                            corresponding source index. */
1676   };
1677
1678 /* Prepares dictionary D for producing a case map.  Afterward,
1679    the caller may delete, reorder, or rename variables within D
1680    at will before using finish_case_map() to produce the case
1681    map.
1682
1683    Uses D's aux members, which must otherwise not be in use. */
1684 static void
1685 start_case_map (struct dictionary *d)
1686 {
1687   size_t var_cnt = dict_get_var_cnt (d);
1688   size_t i;
1689
1690   for (i = 0; i < var_cnt; i++)
1691     {
1692       struct variable *v = dict_get_var (d, i);
1693       int *src_fv = xmalloc (sizeof *src_fv);
1694       *src_fv = v->fv;
1695       var_attach_aux (v, src_fv, var_dtor_free);
1696     }
1697 }
1698
1699 /* Produces a case map from dictionary D, which must have been
1700    previously prepared with start_case_map().
1701
1702    Does not retain any reference to D, and clears the aux members
1703    set up by start_case_map().
1704
1705    Returns the new case map, or a null pointer if no mapping is
1706    required (that is, no data has changed position). */
1707 static struct case_map *
1708 finish_case_map (struct dictionary *d)
1709 {
1710   struct case_map *map;
1711   size_t var_cnt = dict_get_var_cnt (d);
1712   size_t i;
1713   int identity_map;
1714
1715   map = xmalloc (sizeof *map);
1716   map->value_cnt = dict_get_next_value_idx (d);
1717   map->map = xnmalloc (map->value_cnt, sizeof *map->map);
1718   for (i = 0; i < map->value_cnt; i++)
1719     map->map[i] = -1;
1720
1721   identity_map = 1;
1722   for (i = 0; i < var_cnt; i++)
1723     {
1724       struct variable *v = dict_get_var (d, i);
1725       int *src_fv = (int *) var_detach_aux (v);
1726       size_t idx;
1727
1728       if (v->fv != *src_fv)
1729         identity_map = 0;
1730
1731       for (idx = 0; idx < v->nv; idx++)
1732         {
1733           int src_idx = *src_fv + idx;
1734           int dst_idx = v->fv + idx;
1735
1736           assert (map->map[dst_idx] == -1);
1737           map->map[dst_idx] = src_idx;
1738         }
1739       free (src_fv);
1740     }
1741
1742   if (identity_map)
1743     {
1744       destroy_case_map (map);
1745       return NULL;
1746     }
1747
1748   while (map->value_cnt > 0 && map->map[map->value_cnt - 1] == -1)
1749     map->value_cnt--;
1750
1751   return map;
1752 }
1753
1754 /* Maps from SRC to DST, applying case map MAP. */
1755 static void
1756 map_case (const struct case_map *map,
1757           const struct ccase *src, struct ccase *dst)
1758 {
1759   size_t dst_idx;
1760
1761   assert (map != NULL);
1762   assert (src != NULL);
1763   assert (dst != NULL);
1764   assert (src != dst);
1765
1766   for (dst_idx = 0; dst_idx < map->value_cnt; dst_idx++)
1767     {
1768       int src_idx = map->map[dst_idx];
1769       if (src_idx != -1)
1770         *case_data_rw (dst, dst_idx) = *case_data (src, src_idx);
1771     }
1772 }
1773
1774 /* Destroys case map MAP. */
1775 static void
1776 destroy_case_map (struct case_map *map)
1777 {
1778   if (map != NULL)
1779     {
1780       free (map->map);
1781       free (map);
1782     }
1783 }