Allow output files to overwrite input files (bug #21280). Thanks to
[pspp-builds.git] / src / language / data-io / get.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006, 2007 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18
19 #include <stdlib.h>
20
21 #include <data/any-reader.h>
22 #include <data/any-writer.h>
23 #include <data/case.h>
24 #include <data/case-map.h>
25 #include <data/casereader.h>
26 #include <data/casewriter.h>
27 #include <data/format.h>
28 #include <data/dictionary.h>
29 #include <data/por-file-writer.h>
30 #include <data/procedure.h>
31 #include <data/settings.h>
32 #include <data/sys-file-writer.h>
33 #include <data/transformations.h>
34 #include <data/value-labels.h>
35 #include <data/variable.h>
36 #include <language/command.h>
37 #include <language/data-io/file-handle.h>
38 #include <language/lexer/lexer.h>
39 #include <language/lexer/variable-parser.h>
40 #include <libpspp/assertion.h>
41 #include <libpspp/compiler.h>
42 #include <libpspp/hash.h>
43 #include <libpspp/message.h>
44 #include <libpspp/misc.h>
45 #include <libpspp/str.h>
46 #include <libpspp/taint.h>
47
48 #include "get-data.h"
49
50 #include "xalloc.h"
51
52 #include "gettext.h"
53 #define _(msgid) gettext (msgid)
54
55 static bool parse_dict_trim (struct lexer *, struct dictionary *);
56 \f
57 /* Reading system and portable files. */
58
59 /* Type of command. */
60 enum reader_command
61   {
62     GET_CMD,
63     IMPORT_CMD
64   };
65
66 static void get_translate_case (struct ccase *, struct ccase *, void *map_);
67 static bool get_destroy_case_map (void *map_);
68
69 /* Parses a GET or IMPORT command. */
70 static int
71 parse_read_command (struct lexer *lexer, struct dataset *ds, enum reader_command type)
72 {
73   struct casereader *reader = NULL;
74   struct file_handle *fh = NULL;
75   struct dictionary *dict = NULL;
76   struct case_map *map = NULL;
77
78   if ( type == GET_CMD && lex_match_id (lexer, "DATA") )
79     {
80       return parse_get_data_command (lexer, ds);
81     }
82
83   for (;;)
84     {
85       lex_match (lexer, '/');
86
87       if (lex_match_id (lexer, "FILE") || lex_token (lexer) == T_STRING)
88         {
89           lex_match (lexer, '=');
90
91           fh_unref (fh);
92           fh = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
93           if (fh == NULL)
94             goto error;
95         }
96       else if (type == IMPORT_CMD && lex_match_id (lexer, "TYPE"))
97         {
98           lex_match (lexer, '=');
99
100           if (lex_match_id (lexer, "COMM"))
101             type = PFM_COMM;
102           else if (lex_match_id (lexer, "TAPE"))
103             type = PFM_TAPE;
104           else
105             {
106               lex_error (lexer, _("expecting COMM or TAPE"));
107               goto error;
108             }
109         }
110       else
111         break;
112     }
113
114   if (fh == NULL)
115     {
116       lex_sbc_missing (lexer, "FILE");
117       goto error;
118     }
119
120   reader = any_reader_open (fh, &dict);
121   if (reader == NULL)
122     goto error;
123
124   case_map_prepare_dict (dict);
125
126   while (lex_token (lexer) != '.')
127     {
128       lex_match (lexer, '/');
129       if (!parse_dict_trim (lexer, dict))
130         goto error;
131     }
132   dict_compact_values (dict);
133
134   map = case_map_from_dict (dict);
135   if (map != NULL)
136     reader = casereader_create_translator (reader,
137                                            dict_get_next_value_idx (dict),
138                                            get_translate_case,
139                                            get_destroy_case_map,
140                                            map);
141
142   proc_set_active_file (ds, reader, dict);
143
144   fh_unref (fh);
145   return CMD_SUCCESS;
146
147  error:
148   fh_unref (fh);
149   casereader_destroy (reader);
150   if (dict != NULL)
151     dict_destroy (dict);
152   return CMD_CASCADING_FAILURE;
153 }
154
155 static void
156 get_translate_case (struct ccase *input, struct ccase *output,
157                     void *map_)
158 {
159   struct case_map *map = map_;
160   case_map_execute (map, input, output);
161   case_destroy (input);
162 }
163
164 static bool
165 get_destroy_case_map (void *map_)
166 {
167   struct case_map *map = map_;
168   case_map_destroy (map);
169   return true;
170 }
171 \f
172 /* GET. */
173 int
174 cmd_get (struct lexer *lexer, struct dataset *ds)
175 {
176   return parse_read_command (lexer, ds, GET_CMD);
177 }
178
179 /* IMPORT. */
180 int
181 cmd_import (struct lexer *lexer, struct dataset *ds)
182 {
183   return parse_read_command (lexer, ds, IMPORT_CMD);
184 }
185 \f
186 /* Writing system and portable files. */
187
188 /* Type of output file. */
189 enum writer_type
190   {
191     SYSFILE_WRITER,     /* System file. */
192     PORFILE_WRITER      /* Portable file. */
193   };
194
195 /* Type of a command. */
196 enum command_type
197   {
198     XFORM_CMD,          /* Transformation. */
199     PROC_CMD            /* Procedure. */
200   };
201
202 /* Parses SAVE or XSAVE or EXPORT or XEXPORT command.
203    WRITER_TYPE identifies the type of file to write,
204    and COMMAND_TYPE identifies the type of command.
205
206    On success, returns a writer.
207    For procedures only, sets *RETAIN_UNSELECTED to true if cases
208    that would otherwise be excluded by FILTER or USE should be
209    included.
210
211    On failure, returns a null pointer. */
212 static struct casewriter *
213 parse_write_command (struct lexer *lexer, struct dataset *ds,
214                      enum writer_type writer_type,
215                      enum command_type command_type,
216                      bool *retain_unselected)
217 {
218   /* Common data. */
219   struct file_handle *handle; /* Output file. */
220   struct dictionary *dict;    /* Dictionary for output file. */
221   struct casewriter *writer;  /* Writer. */
222   struct case_map *map;       /* Map from input data to data for writer. */
223
224   /* Common options. */
225   bool print_map;             /* Print map?  TODO. */
226   bool print_short_names;     /* Print long-to-short name map.  TODO. */
227   struct sfm_write_options sysfile_opts;
228   struct pfm_write_options porfile_opts;
229
230   assert (writer_type == SYSFILE_WRITER || writer_type == PORFILE_WRITER);
231   assert (command_type == XFORM_CMD || command_type == PROC_CMD);
232   assert ((retain_unselected != NULL) == (command_type == PROC_CMD));
233
234   if (command_type == PROC_CMD)
235     *retain_unselected = true;
236
237   handle = NULL;
238   dict = dict_clone (dataset_dict (ds));
239   writer = NULL;
240   map = NULL;
241   print_map = false;
242   print_short_names = false;
243   sysfile_opts = sfm_writer_default_options ();
244   porfile_opts = pfm_writer_default_options ();
245
246   case_map_prepare_dict (dict);
247   dict_delete_scratch_vars (dict);
248
249   lex_match (lexer, '/');
250   for (;;)
251     {
252       if (lex_match_id (lexer, "OUTFILE"))
253         {
254           if (handle != NULL)
255             {
256               lex_sbc_only_once ("OUTFILE");
257               goto error;
258             }
259
260           lex_match (lexer, '=');
261
262           handle = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
263           if (handle == NULL)
264             goto error;
265         }
266       else if (lex_match_id (lexer, "NAMES"))
267         print_short_names = true;
268       else if (lex_match_id (lexer, "PERMISSIONS"))
269         {
270           bool cw;
271
272           lex_match (lexer, '=');
273           if (lex_match_id (lexer, "READONLY"))
274             cw = false;
275           else if (lex_match_id (lexer, "WRITEABLE"))
276             cw = true;
277           else
278             {
279               lex_error (lexer, _("expecting %s or %s"), "READONLY", "WRITEABLE");
280               goto error;
281             }
282           sysfile_opts.create_writeable = porfile_opts.create_writeable = cw;
283         }
284       else if (command_type == PROC_CMD && lex_match_id (lexer, "UNSELECTED"))
285         {
286           lex_match (lexer, '=');
287           if (lex_match_id (lexer, "RETAIN"))
288             *retain_unselected = true;
289           else if (lex_match_id (lexer, "DELETE"))
290             *retain_unselected = false;
291           else
292             {
293               lex_error (lexer, _("expecting %s or %s"), "RETAIN", "DELETE");
294               goto error;
295             }
296         }
297       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "COMPRESSED"))
298         sysfile_opts.compress = true;
299       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "UNCOMPRESSED"))
300         sysfile_opts.compress = false;
301       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "VERSION"))
302         {
303           lex_match (lexer, '=');
304           if (!lex_force_int (lexer))
305             goto error;
306           sysfile_opts.version = lex_integer (lexer);
307           lex_get (lexer);
308         }
309       else if (writer_type == PORFILE_WRITER && lex_match_id (lexer, "TYPE"))
310         {
311           lex_match (lexer, '=');
312           if (lex_match_id (lexer, "COMMUNICATIONS"))
313             porfile_opts.type = PFM_COMM;
314           else if (lex_match_id (lexer, "TAPE"))
315             porfile_opts.type = PFM_TAPE;
316           else
317             {
318               lex_error (lexer, _("expecting %s or %s"), "COMM", "TAPE");
319               goto error;
320             }
321         }
322       else if (writer_type == PORFILE_WRITER && lex_match_id (lexer, "DIGITS"))
323         {
324           lex_match (lexer, '=');
325           if (!lex_force_int (lexer))
326             goto error;
327           porfile_opts.digits = lex_integer (lexer);
328           lex_get (lexer);
329         }
330       else if (!parse_dict_trim (lexer, dict))
331         goto error;
332
333       if (!lex_match (lexer, '/'))
334         break;
335     }
336   if (lex_end_of_command (lexer) != CMD_SUCCESS)
337     goto error;
338
339   if (handle == NULL)
340     {
341       lex_sbc_missing (lexer, "OUTFILE");
342       goto error;
343     }
344
345   dict_delete_scratch_vars (dict);
346   dict_compact_values (dict);
347
348   if (fh_get_referent (handle) == FH_REF_FILE)
349     {
350       switch (writer_type)
351         {
352         case SYSFILE_WRITER:
353           writer = sfm_open_writer (handle, dict, sysfile_opts);
354           break;
355         case PORFILE_WRITER:
356           writer = pfm_open_writer (handle, dict, porfile_opts);
357           break;
358         }
359     }
360   else
361     writer = any_writer_open (handle, dict);
362   if (writer == NULL)
363     goto error;
364
365   map = case_map_from_dict (dict);
366   if (map != NULL)
367     writer = casewriter_create_translator (writer,
368                                            case_map_get_value_cnt (map),
369                                            get_translate_case,
370                                            get_destroy_case_map,
371                                            map);
372   dict_destroy (dict);
373
374   fh_unref (handle);
375   return writer;
376
377  error:
378   fh_unref (handle);
379   casewriter_destroy (writer);
380   dict_destroy (dict);
381   case_map_destroy (map);
382   return NULL;
383 }
384 \f
385 /* SAVE and EXPORT. */
386
387 /* Parses and performs the SAVE or EXPORT procedure. */
388 static int
389 parse_output_proc (struct lexer *lexer, struct dataset *ds, enum writer_type writer_type)
390 {
391   bool retain_unselected;
392   struct variable *saved_filter_variable;
393   struct casewriter *output;
394   bool ok;
395
396   output = parse_write_command (lexer, ds, writer_type, PROC_CMD,
397                                 &retain_unselected);
398   if (output == NULL)
399     return CMD_CASCADING_FAILURE;
400
401   saved_filter_variable = dict_get_filter (dataset_dict (ds));
402   if (retain_unselected)
403     dict_set_filter (dataset_dict (ds), NULL);
404
405   casereader_transfer (proc_open (ds), output);
406   ok = casewriter_destroy (output);
407   ok = proc_commit (ds) && ok;
408
409   dict_set_filter (dataset_dict (ds), saved_filter_variable);
410
411   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
412 }
413
414 int
415 cmd_save (struct lexer *lexer, struct dataset *ds)
416 {
417   return parse_output_proc (lexer, ds, SYSFILE_WRITER);
418 }
419
420 int
421 cmd_export (struct lexer *lexer, struct dataset *ds)
422 {
423   return parse_output_proc (lexer, ds, PORFILE_WRITER);
424 }
425 \f
426 /* XSAVE and XEXPORT. */
427
428 /* Transformation. */
429 struct output_trns
430   {
431     struct casewriter *writer;          /* Writer. */
432   };
433
434 static trns_proc_func output_trns_proc;
435 static trns_free_func output_trns_free;
436
437 /* Parses the XSAVE or XEXPORT transformation command. */
438 static int
439 parse_output_trns (struct lexer *lexer, struct dataset *ds, enum writer_type writer_type)
440 {
441   struct output_trns *t = xmalloc (sizeof *t);
442   t->writer = parse_write_command (lexer, ds, writer_type, XFORM_CMD, NULL);
443   if (t->writer == NULL)
444     {
445       free (t);
446       return CMD_CASCADING_FAILURE;
447     }
448
449   add_transformation (ds, output_trns_proc, output_trns_free, t);
450   return CMD_SUCCESS;
451 }
452
453 /* Writes case C to the system file specified on XSAVE or XEXPORT. */
454 static int
455 output_trns_proc (void *trns_, struct ccase *c, casenumber case_num UNUSED)
456 {
457   struct output_trns *t = trns_;
458   struct ccase tmp;
459   case_clone (&tmp, c);
460   casewriter_write (t->writer, &tmp);
461   return TRNS_CONTINUE;
462 }
463
464 /* Frees an XSAVE or XEXPORT transformation.
465    Returns true if successful, false if an I/O error occurred. */
466 static bool
467 output_trns_free (void *trns_)
468 {
469   struct output_trns *t = trns_;
470   bool ok = casewriter_destroy (t->writer);
471   free (t);
472   return ok;
473 }
474
475 /* XSAVE command. */
476 int
477 cmd_xsave (struct lexer *lexer, struct dataset *ds)
478 {
479   return parse_output_trns (lexer, ds, SYSFILE_WRITER);
480 }
481
482 /* XEXPORT command. */
483 int
484 cmd_xexport (struct lexer *lexer, struct dataset *ds)
485 {
486   return parse_output_trns (lexer, ds, PORFILE_WRITER);
487 }
488 \f
489 static bool rename_variables (struct lexer *lexer, struct dictionary *dict);
490 static bool drop_variables (struct lexer *, struct dictionary *dict);
491 static bool keep_variables (struct lexer *, struct dictionary *dict);
492
493 /* Commands that read and write system files share a great deal
494    of common syntactic structure for rearranging and dropping
495    variables.  This function parses this syntax and modifies DICT
496    appropriately.  Returns true on success, false on failure. */
497 static bool
498 parse_dict_trim (struct lexer *lexer, struct dictionary *dict)
499 {
500   if (lex_match_id (lexer, "MAP"))
501     {
502       /* FIXME. */
503       return true;
504     }
505   else if (lex_match_id (lexer, "DROP"))
506     return drop_variables (lexer, dict);
507   else if (lex_match_id (lexer, "KEEP"))
508     return keep_variables (lexer, dict);
509   else if (lex_match_id (lexer, "RENAME"))
510     return rename_variables (lexer, dict);
511   else
512     {
513       lex_error (lexer, _("expecting a valid subcommand"));
514       return false;
515     }
516 }
517
518 /* Parses and performs the RENAME subcommand of GET and SAVE. */
519 static bool
520 rename_variables (struct lexer *lexer, struct dictionary *dict)
521 {
522   size_t i;
523
524   int success = 0;
525
526   struct variable **v;
527   char **new_names;
528   size_t nv, nn;
529   char *err_name;
530
531   int group;
532
533   lex_match (lexer, '=');
534   if (lex_token (lexer) != '(')
535     {
536       struct variable *v;
537
538       v = parse_variable (lexer, dict);
539       if (v == NULL)
540         return 0;
541       if (!lex_force_match (lexer, '=')
542           || !lex_force_id (lexer))
543         return 0;
544       if (dict_lookup_var (dict, lex_tokid (lexer)) != NULL)
545         {
546           msg (SE, _("Cannot rename %s as %s because there already exists "
547                      "a variable named %s.  To rename variables with "
548                      "overlapping names, use a single RENAME subcommand "
549                      "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
550                      "\"/RENAME (A B C=B C A)\"."),
551                var_get_name (v), lex_tokid (lexer), lex_tokid (lexer));
552           return 0;
553         }
554
555       dict_rename_var (dict, v, lex_tokid (lexer));
556       lex_get (lexer);
557       return 1;
558     }
559
560   nv = nn = 0;
561   v = NULL;
562   new_names = 0;
563   group = 1;
564   while (lex_match (lexer, '('))
565     {
566       size_t old_nv = nv;
567
568       if (!parse_variables (lexer, dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
569         goto done;
570       if (!lex_match (lexer, '='))
571         {
572           msg (SE, _("`=' expected after variable list."));
573           goto done;
574         }
575       if (!parse_DATA_LIST_vars (lexer, &new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
576         goto done;
577       if (nn != nv)
578         {
579           msg (SE, _("Number of variables on left side of `=' (%zu) does not "
580                      "match number of variables on right side (%zu), in "
581                      "parenthesized group %d of RENAME subcommand."),
582                nv - old_nv, nn - old_nv, group);
583           goto done;
584         }
585       if (!lex_force_match (lexer, ')'))
586         goto done;
587       group++;
588     }
589
590   if (!dict_rename_vars (dict, v, new_names, nv, &err_name))
591     {
592       msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
593       goto done;
594     }
595   success = 1;
596
597  done:
598   for (i = 0; i < nn; i++)
599     free (new_names[i]);
600   free (new_names);
601   free (v);
602
603   return success;
604 }
605
606 /* Parses and performs the DROP subcommand of GET and SAVE.
607    Returns true if successful, false on failure.*/
608 static bool
609 drop_variables (struct lexer *lexer, struct dictionary *dict)
610 {
611   struct variable **v;
612   size_t nv;
613
614   lex_match (lexer, '=');
615   if (!parse_variables (lexer, dict, &v, &nv, PV_NONE))
616     return false;
617   dict_delete_vars (dict, v, nv);
618   free (v);
619
620   if (dict_get_var_cnt (dict) == 0)
621     {
622       msg (SE, _("Cannot DROP all variables from dictionary."));
623       return false;
624     }
625   return true;
626 }
627
628 /* Parses and performs the KEEP subcommand of GET and SAVE.
629    Returns true if successful, false on failure.*/
630 static bool
631 keep_variables (struct lexer *lexer, struct dictionary *dict)
632 {
633   struct variable **v;
634   size_t nv;
635   size_t i;
636
637   lex_match (lexer, '=');
638   if (!parse_variables (lexer, dict, &v, &nv, PV_NONE))
639     return false;
640
641   /* Move the specified variables to the beginning. */
642   dict_reorder_vars (dict, v, nv);
643
644   /* Delete the remaining variables. */
645   v = xnrealloc (v, dict_get_var_cnt (dict) - nv, sizeof *v);
646   for (i = nv; i < dict_get_var_cnt (dict); i++)
647     v[i - nv] = dict_get_var (dict, i);
648   dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
649   free (v);
650
651   return true;
652 }
653 \f
654 /* MATCH FILES. */
655
656 /* File types. */
657 enum mtf_type
658   {
659     MTF_FILE,                   /* Specified on FILE= subcommand. */
660     MTF_TABLE                   /* Specified on TABLE= subcommand. */
661   };
662
663 /* One of the FILEs or TABLEs on MATCH FILES. */
664 struct mtf_file
665   {
666     struct ll ll;               /* In list of all files and tables. */
667
668     enum mtf_type type;
669     int sequence;
670
671     const struct variable **by; /* List of BY variables for this file. */
672     struct mtf_variable *vars;  /* Variables to copy to output. */
673     size_t var_cnt;             /* Number of other variables. */
674
675     struct file_handle *handle; /* Input file handle. */
676     struct dictionary *dict;    /* Input file dictionary. */
677     struct casereader *reader;  /* Input reader. */
678     struct ccase input;         /* Input record (null at end of file). */
679
680     /* IN subcommand. */
681     char *in_name;              /* Variable name. */
682     struct variable *in_var;    /* Variable (in master dictionary). */
683   };
684
685 struct mtf_variable
686   {
687     struct variable *in_var;
688     struct variable *out_var;
689   };
690
691 /* MATCH FILES procedure. */
692 struct mtf_proc
693   {
694     struct ll_list files;       /* List of "struct mtf_file"s. */
695     int nonempty_files;         /* FILEs that are not at end-of-file. */
696
697     bool ok;                    /* False if I/O error occurs. */
698
699     struct dictionary *dict;    /* Dictionary of output file. */
700     struct casewriter *output;  /* MATCH FILES output. */
701
702     size_t by_cnt;              /* Number of variables on BY subcommand. */
703
704     /* FIRST, LAST.
705        Only if "first" or "last" is nonnull are the remaining
706        members used. */
707     struct variable *first;     /* Variable specified on FIRST (if any). */
708     struct variable *last;      /* Variable specified on LAST (if any). */
709     struct ccase buffered_case; /* Case ready for output except that we don't
710                                    know the value for the LAST variable yet. */
711     struct ccase prev_BY_case;  /* Case with values of last set of BY vars. */
712     const struct variable **prev_BY;  /* Last set of BY variables. */
713   };
714
715 static void mtf_free (struct mtf_proc *);
716
717 static bool mtf_close_all_files (struct mtf_proc *);
718 static bool mtf_merge_dictionary (struct dictionary *const, struct mtf_file *);
719 static bool mtf_read_record (struct mtf_proc *mtf, struct mtf_file *);
720
721 static void mtf_process_case (struct mtf_proc *);
722
723 static bool create_flag_var (const char *subcommand_name, const char *var_name,
724                              struct dictionary *, struct variable **);
725 static char *var_type_description (struct variable *);
726
727 /* Parse and execute the MATCH FILES command. */
728 int
729 cmd_match_files (struct lexer *lexer, struct dataset *ds)
730 {
731   struct mtf_proc mtf;
732   struct ll *first_table;
733   struct mtf_file *file, *next;
734
735   bool saw_in = false;
736   struct casereader *active_file = NULL;
737
738   char first_name[LONG_NAME_LEN + 1] = "";
739   char last_name[LONG_NAME_LEN + 1] = "";
740
741   struct taint *taint = NULL;
742
743   size_t i;
744
745   ll_init (&mtf.files);
746   mtf.nonempty_files = 0;
747   first_table = ll_null (&mtf.files);
748   mtf.dict = dict_create ();
749   mtf.output = NULL;
750   mtf.by_cnt = 0;
751   mtf.first = mtf.last = NULL;
752   case_nullify (&mtf.buffered_case);
753   case_nullify (&mtf.prev_BY_case);
754   mtf.prev_BY = NULL;
755
756   dict_set_case_limit (mtf.dict, dict_get_case_limit (dataset_dict (ds)));
757
758   lex_match (lexer, '/');
759   while (lex_token (lexer) == T_ID
760          && (lex_id_match (ss_cstr ("FILE"), ss_cstr (lex_tokid (lexer)))
761              || lex_id_match (ss_cstr ("TABLE"), ss_cstr (lex_tokid (lexer)))))
762     {
763       struct mtf_file *file = xmalloc (sizeof *file);
764       file->by = NULL;
765       file->handle = NULL;
766       file->reader = NULL;
767       file->dict = NULL;
768       file->in_name = NULL;
769       file->in_var = NULL;
770       file->var_cnt = 0;
771       file->vars = NULL;
772       case_nullify (&file->input);
773
774       if (lex_match_id (lexer, "FILE"))
775         {
776           file->type = MTF_FILE;
777           ll_insert (first_table, &file->ll);
778           mtf.nonempty_files++;
779         }
780       else if (lex_match_id (lexer, "TABLE"))
781         {
782           file->type = MTF_TABLE;
783           ll_push_tail (&mtf.files, &file->ll);
784           if (first_table == ll_null (&mtf.files))
785             first_table = &file->ll;
786         }
787       else
788         NOT_REACHED ();
789       lex_match (lexer, '=');
790
791       if (lex_match (lexer, '*'))
792         {
793           if (!proc_has_active_file (ds))
794             {
795               msg (SE, _("Cannot specify the active file since no active "
796                          "file has been defined."));
797               goto error;
798             }
799
800           if (proc_make_temporary_transformations_permanent (ds))
801             msg (SE,
802                  _("MATCH FILES may not be used after TEMPORARY when "
803                    "the active file is an input source.  "
804                    "Temporary transformations will be made permanent."));
805
806           file->dict = dict_clone (dataset_dict (ds));
807         }
808       else
809         {
810           file->handle = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
811           if (file->handle == NULL)
812             goto error;
813
814           file->reader = any_reader_open (file->handle, &file->dict);
815           if (file->reader == NULL)
816             goto error;
817         }
818
819       while (lex_match (lexer, '/'))
820         if (lex_match_id (lexer, "RENAME"))
821           {
822             if (!rename_variables (lexer, file->dict))
823               goto error;
824           }
825         else if (lex_match_id (lexer, "IN"))
826           {
827             lex_match (lexer, '=');
828             if (lex_token (lexer) != T_ID)
829               {
830                 lex_error (lexer, NULL);
831                 goto error;
832               }
833
834             if (file->in_name != NULL)
835               {
836                 msg (SE, _("Multiple IN subcommands for a single FILE or "
837                            "TABLE."));
838                 goto error;
839               }
840             file->in_name = xstrdup (lex_tokid (lexer));
841             lex_get (lexer);
842             saw_in = true;
843           }
844
845       mtf_merge_dictionary (mtf.dict, file);
846     }
847
848   while (lex_token (lexer) != '.')
849     {
850       if (lex_match (lexer, T_BY))
851         {
852           struct mtf_file *file;
853           struct variable **by;
854           bool ok;
855
856           if (mtf.by_cnt)
857             {
858               lex_sbc_only_once ("BY");
859               goto error;
860             }
861
862           lex_match (lexer, '=');
863           if (!parse_variables (lexer, mtf.dict, &by, &mtf.by_cnt,
864                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
865             goto error;
866
867           ok = true;
868           ll_for_each (file, struct mtf_file, ll, &mtf.files)
869             {
870               size_t i;
871
872               file->by = xnmalloc (mtf.by_cnt, sizeof *file->by);
873               for (i = 0; i < mtf.by_cnt; i++)
874                 {
875                   const char *var_name = var_get_name (by[i]);
876                   file->by[i] = dict_lookup_var (file->dict, var_name);
877                   if (file->by[i] == NULL)
878                     {
879                       if (file->handle != NULL)
880                         msg (SE, _("File %s lacks BY variable %s."),
881                              fh_get_name (file->handle), var_name);
882                       else
883                         msg (SE, _("Active file lacks BY variable %s."),
884                              var_name);
885                       ok = false;
886                     }
887                 }
888             }
889           free (by);
890
891           if (!ok)
892             goto error;
893         }
894       else if (lex_match_id (lexer, "FIRST"))
895         {
896           if (first_name[0] != '\0')
897             {
898               lex_sbc_only_once ("FIRST");
899               goto error;
900             }
901
902           lex_match (lexer, '=');
903           if (!lex_force_id (lexer))
904             goto error;
905           strcpy (first_name, lex_tokid (lexer));
906           lex_get (lexer);
907         }
908       else if (lex_match_id (lexer, "LAST"))
909         {
910           if (last_name[0] != '\0')
911             {
912               lex_sbc_only_once ("LAST");
913               goto error;
914             }
915
916           lex_match (lexer, '=');
917           if (!lex_force_id (lexer))
918             goto error;
919           strcpy (last_name, lex_tokid (lexer));
920           lex_get (lexer);
921         }
922       else if (lex_match_id (lexer, "MAP"))
923         {
924           /* FIXME. */
925         }
926       else if (lex_match_id (lexer, "DROP"))
927         {
928           if (!drop_variables (lexer, mtf.dict))
929             goto error;
930         }
931       else if (lex_match_id (lexer, "KEEP"))
932         {
933           if (!keep_variables (lexer, mtf.dict))
934             goto error;
935         }
936       else
937         {
938           lex_error (lexer, NULL);
939           goto error;
940         }
941
942       if (!lex_match (lexer, '/') && lex_token (lexer) != '.')
943         {
944           lex_end_of_command (lexer);
945           goto error;
946         }
947     }
948
949   if (mtf.by_cnt == 0)
950     {
951       if (first_table != ll_null (&mtf.files))
952         {
953           msg (SE, _("BY is required when TABLE is specified."));
954           goto error;
955         }
956       if (saw_in)
957         {
958           msg (SE, _("BY is required when IN is specified."));
959           goto error;
960         }
961     }
962
963   /* Set up mapping from each file's variables to master
964      variables. */
965   ll_for_each (file, struct mtf_file, ll, &mtf.files)
966     {
967       size_t in_var_cnt = dict_get_var_cnt (file->dict);
968
969       file->vars = xnmalloc (in_var_cnt, sizeof *file->vars);
970       file->var_cnt = 0;
971       for (i = 0; i < in_var_cnt; i++)
972         {
973           struct variable *in_var = dict_get_var (file->dict, i);
974           struct variable *out_var = dict_lookup_var (mtf.dict,
975                                                       var_get_name (in_var));
976
977           if (out_var != NULL)
978             {
979               struct mtf_variable *mv = &file->vars[file->var_cnt++];
980               mv->in_var = in_var;
981               mv->out_var = out_var;
982             }
983         }
984     }
985
986   /* Add IN, FIRST, and LAST variables to master dictionary. */
987   ll_for_each (file, struct mtf_file, ll, &mtf.files)
988     if (!create_flag_var ("IN", file->in_name, mtf.dict, &file->in_var))
989       goto error;
990   if (!create_flag_var ("FIRST", first_name, mtf.dict, &mtf.first)
991       || !create_flag_var ("LAST", last_name, mtf.dict, &mtf.last))
992     goto error;
993
994   dict_delete_scratch_vars (mtf.dict);
995   dict_compact_values (mtf.dict);
996   mtf.output = autopaging_writer_create (dict_get_next_value_idx (mtf.dict));
997   taint = taint_clone (casewriter_get_taint (mtf.output));
998
999   ll_for_each (file, struct mtf_file, ll, &mtf.files)
1000     {
1001       if (file->reader == NULL)
1002         {
1003           if (active_file == NULL)
1004             {
1005               proc_discard_output (ds);
1006               file->reader = active_file = proc_open (ds);
1007             }
1008           else
1009             file->reader = casereader_clone (active_file);
1010         }
1011       taint_propagate (casereader_get_taint (file->reader), taint);
1012     }
1013
1014   ll_for_each_safe (file, next, struct mtf_file, ll, &mtf.files)
1015     mtf_read_record (&mtf, file);
1016   while (mtf.nonempty_files > 0)
1017     mtf_process_case (&mtf);
1018   if ((mtf.first != NULL || mtf.last != NULL) && mtf.prev_BY != NULL)
1019     {
1020       if (mtf.last != NULL)
1021         case_data_rw (&mtf.buffered_case, mtf.last)->f = 1.0;
1022       casewriter_write (mtf.output, &mtf.buffered_case);
1023       case_nullify (&mtf.buffered_case);
1024     }
1025   mtf_close_all_files (&mtf);
1026   if (active_file != NULL)
1027     proc_commit (ds);
1028
1029   proc_set_active_file (ds, casewriter_make_reader (mtf.output), mtf.dict);
1030   mtf.dict = NULL;
1031   mtf.output = NULL;
1032
1033   mtf_free (&mtf);
1034
1035   return taint_destroy (taint) ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
1036
1037  error:
1038   if (active_file != NULL)
1039     proc_commit (ds);
1040   mtf_free (&mtf);
1041   taint_destroy (taint);
1042   return CMD_CASCADING_FAILURE;
1043 }
1044
1045 /* If VAR_NAME is a nonnull pointer to a non-empty string,
1046    attempts to create a variable named VAR_NAME, with format
1047    F1.0, in DICT, and stores a pointer to the variable in *VAR.
1048    Returns true if successful, false if the variable name is a
1049    duplicate (in which case a message saying that the variable
1050    specified on the given SUBCOMMAND is a duplicate is emitted).
1051    Also returns true, without doing anything, if VAR_NAME is null
1052    or empty. */
1053 static bool
1054 create_flag_var (const char *subcommand, const char *var_name,
1055                  struct dictionary *dict, struct variable **var)
1056 {
1057   if (var_name != NULL && var_name[0] != '\0')
1058     {
1059       struct fmt_spec format = fmt_for_output (FMT_F, 1, 0);
1060       *var = dict_create_var (dict, var_name, 0);
1061       if (*var == NULL)
1062         {
1063           msg (SE, _("Variable name %s specified on %s subcommand "
1064                      "duplicates an existing variable name."),
1065                subcommand, var_name);
1066           return false;
1067         }
1068       var_set_both_formats (*var, &format);
1069     }
1070   else
1071     *var = NULL;
1072   return true;
1073 }
1074
1075 /* Return a string in an allocated buffer describing V's variable
1076    type and width. */
1077 static char *
1078 var_type_description (struct variable *v)
1079 {
1080   if (var_is_numeric (v))
1081     return xstrdup ("numeric");
1082   else
1083     return xasprintf ("string with width %d", var_get_width (v));
1084 }
1085
1086 /* Closes all the files in MTF and frees their associated data.
1087    Returns true if successful, false if an I/O error occurred on
1088    any of the files. */
1089 static bool
1090 mtf_close_all_files (struct mtf_proc *mtf)
1091 {
1092   struct mtf_file *file;
1093   bool ok = true;
1094
1095   ll_for_each_preremove (file, struct mtf_file, ll, &mtf->files)
1096     {
1097       fh_unref (file->handle);
1098       casereader_destroy (file->reader);
1099       free (file->by);
1100       dict_destroy (file->dict);
1101       free (file->in_name);
1102       case_destroy (&file->input);
1103       free (file->vars);
1104       free (file);
1105     }
1106
1107   return ok;
1108 }
1109
1110 /* Frees all the data for the MATCH FILES procedure. */
1111 static void
1112 mtf_free (struct mtf_proc *mtf)
1113 {
1114   mtf_close_all_files (mtf);
1115   dict_destroy (mtf->dict);
1116   casewriter_destroy (mtf->output);
1117   case_destroy (&mtf->buffered_case);
1118   case_destroy (&mtf->prev_BY_case);
1119 }
1120
1121 /* Reads the next record into FILE, if possible, and update MTF's
1122    nonempty_files count if not. */
1123 static bool
1124 mtf_read_record (struct mtf_proc *mtf, struct mtf_file *file)
1125 {
1126   case_destroy (&file->input);
1127   if (!casereader_read (file->reader, &file->input))
1128     {
1129       mtf->nonempty_files--;
1130       return false;
1131     }
1132   else
1133     return true;
1134 }
1135
1136 /* Compare the BY variables for files A and B; return -1 if A <
1137    B, 0 if A == B, 1 if A > B.  (If there are no BY variables,
1138    then all records are equal.) */
1139 static inline int
1140 mtf_compare_BY_values (struct mtf_proc *mtf,
1141                        struct mtf_file *a, struct mtf_file *b)
1142 {
1143   return case_compare_2dict (&a->input, &b->input, a->by, b->by, mtf->by_cnt);
1144 }
1145
1146 /* Processes input files and write one case to the output file. */
1147 static void
1148 mtf_process_case (struct mtf_proc *mtf)
1149 {
1150   struct ccase c;
1151   struct mtf_file *min;
1152   struct mtf_file *file;
1153   int min_sequence;
1154   size_t i;
1155
1156   /* Find the set of one or more FILEs whose BY values are
1157      minimal, as well as the set of zero or more TABLEs whose BY
1158      values equal those of the minimum FILEs.
1159
1160      After each iteration of the loop, this invariant holds: the
1161      FILEs with minimum BY values thus far have "sequence"
1162      members equal to min_sequence, and "min" points to one of
1163      the mtf_files whose case has those minimum BY values, and
1164      similarly for TABLEs. */
1165   min_sequence = 0;
1166   min = NULL;
1167   ll_for_each (file, struct mtf_file, ll, &mtf->files)
1168     if (case_is_null (&file->input))
1169       file->sequence = -1;
1170     else if (file->type == MTF_FILE)
1171       {
1172         int cmp = min != NULL ? mtf_compare_BY_values (mtf, min, file) : 1;
1173         if (cmp <= 0)
1174           file->sequence = cmp < 0 ? -1 : min_sequence;
1175         else
1176           {
1177             file->sequence = ++min_sequence;
1178             min = file;
1179           }
1180       }
1181     else
1182       {
1183         int cmp;
1184         assert (min != NULL);
1185         do
1186           {
1187             cmp = mtf_compare_BY_values (mtf, min, file);
1188           }
1189         while (cmp > 0 && mtf_read_record (mtf, file));
1190         file->sequence = cmp == 0 ? min_sequence : -1;
1191       }
1192
1193   /* Form the output case from the input cases. */
1194   case_create (&c, dict_get_next_value_idx (mtf->dict));
1195   for (i = 0; i < dict_get_var_cnt (mtf->dict); i++)
1196     {
1197       struct variable *v = dict_get_var (mtf->dict, i);
1198       value_set_missing (case_data_rw (&c, v), var_get_width (v));
1199     }
1200   ll_for_each_reverse (file, struct mtf_file, ll, &mtf->files)
1201     {
1202       bool include_file = file->sequence == min_sequence;
1203       if (include_file)
1204         for (i = 0; i < file->var_cnt; i++)
1205           {
1206             const struct mtf_variable *mv = &file->vars[i];
1207             const union value *in = case_data (&file->input, mv->in_var);
1208             union value *out = case_data_rw (&c, mv->out_var);
1209             value_copy (out, in, var_get_width (mv->in_var));
1210           }
1211       if (file->in_var != NULL)
1212         case_data_rw (&c, file->in_var)->f = include_file;
1213     }
1214
1215   /* Write the output case. */
1216   if (mtf->first == NULL && mtf->last == NULL)
1217     {
1218       /* With no FIRST or LAST variables, it's trivial. */
1219       casewriter_write (mtf->output, &c);
1220     }
1221   else
1222     {
1223       /* It's harder with LAST, because we can't know whether
1224          this case is the last in a group until we've prepared
1225          the *next* case also.  Thus, we buffer the previous
1226          output case until the next one is ready.
1227
1228          We also have to save a copy of one of the previous input
1229          cases, so that we can compare the BY variables.  We
1230          can't compare the BY variables between the current
1231          output case and the saved one because the BY variables
1232          might not be in the output (the user is allowed to drop
1233          them). */
1234       bool new_BY;
1235       if (mtf->prev_BY != NULL)
1236         {
1237           new_BY = case_compare_2dict (&min->input, &mtf->prev_BY_case,
1238                                        min->by, mtf->prev_BY,
1239                                        mtf->by_cnt);
1240           if (mtf->last != NULL)
1241             case_data_rw (&mtf->buffered_case, mtf->last)->f = new_BY;
1242           casewriter_write (mtf->output, &mtf->buffered_case);
1243         }
1244       else
1245         new_BY = true;
1246
1247       case_move (&mtf->buffered_case, &c);
1248       if (mtf->first != NULL)
1249         case_data_rw (&mtf->buffered_case, mtf->first)->f = new_BY;
1250
1251       if (new_BY)
1252         {
1253           mtf->prev_BY = min->by;
1254           case_destroy (&mtf->prev_BY_case);
1255           case_clone (&mtf->prev_BY_case, &min->input);
1256         }
1257     }
1258
1259   /* Read another record from each input file FILE with minimum
1260      values. */
1261   ll_for_each (file, struct mtf_file, ll, &mtf->files)
1262     if (file->type == MTF_FILE)
1263       {
1264         if (file->sequence == min_sequence)
1265           mtf_read_record (mtf, file);
1266       }
1267     else
1268       break;
1269 }
1270
1271 /* Merge the dictionary for file F into master dictionary M. */
1272 static bool
1273 mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
1274 {
1275   struct dictionary *d = f->dict;
1276   const char *d_docs, *m_docs;
1277   int i;
1278
1279   if (dict_get_label (m) == NULL)
1280     dict_set_label (m, dict_get_label (d));
1281
1282   d_docs = dict_get_documents (d);
1283   m_docs = dict_get_documents (m);
1284   if (d_docs != NULL)
1285     {
1286       if (m_docs == NULL)
1287         dict_set_documents (m, d_docs);
1288       else
1289         {
1290           char *new_docs = xasprintf ("%s%s", m_docs, d_docs);
1291           dict_set_documents (m, new_docs);
1292           free (new_docs);
1293         }
1294     }
1295
1296   for (i = 0; i < dict_get_var_cnt (d); i++)
1297     {
1298       struct variable *dv = dict_get_var (d, i);
1299       struct variable *mv = dict_lookup_var (m, var_get_name (dv));
1300
1301       if (dict_class_from_id (var_get_name (dv)) == DC_SCRATCH)
1302         continue;
1303
1304       if (mv != NULL)
1305         {
1306           if (var_get_width (mv) != var_get_width (dv))
1307             {
1308               char *dv_description = var_type_description (dv);
1309               char *mv_description = var_type_description (mv);
1310               msg (SE, _("Variable %s in file %s (%s) has different "
1311                          "type or width from the same variable in "
1312                          "earlier file (%s)."),
1313                    var_get_name (dv), fh_get_name (f->handle),
1314                    dv_description, mv_description);
1315               free (dv_description);
1316               free (mv_description);
1317               return false;
1318             }
1319
1320           if (var_get_width (dv) == var_get_width (mv))
1321             {
1322               if (var_has_value_labels (dv) && !var_has_value_labels (mv))
1323                 var_set_value_labels (mv, var_get_value_labels (dv));
1324               if (var_has_missing_values (dv) && !var_has_missing_values (mv))
1325                 var_set_missing_values (mv, var_get_missing_values (dv));
1326             }
1327
1328           if (var_get_label (dv) && !var_get_label (mv))
1329             var_set_label (mv, var_get_label (dv));
1330         }
1331       else
1332         mv = dict_clone_var_assert (m, dv, var_get_name (dv));
1333     }
1334
1335   return true;
1336 }