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