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