* psppire-dict.c (psppire_dict_dump): Don't use
[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/casereader.h>
25 #include <data/casewriter.h>
26 #include <data/format.h>
27 #include <data/dictionary.h>
28 #include <data/por-file-writer.h>
29 #include <data/procedure.h>
30 #include <data/settings.h>
31 #include <data/sys-file-writer.h>
32 #include <data/transformations.h>
33 #include <data/value-labels.h>
34 #include <data/variable.h>
35 #include <language/command.h>
36 #include <language/data-io/file-handle.h>
37 #include <language/lexer/lexer.h>
38 #include <language/lexer/variable-parser.h>
39 #include <libpspp/alloc.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 "gettext.h"
49 #define _(msgid) gettext (msgid)
50
51 /* Rearranging and reducing a dictionary. */
52 static void start_case_map (struct dictionary *);
53 static struct case_map *finish_case_map (struct dictionary *);
54 static void map_case (const struct case_map *,
55                       const struct ccase *, struct ccase *);
56 static void destroy_case_map (struct case_map *);
57 static size_t case_map_get_value_cnt (const struct case_map *);
58
59 static bool parse_dict_trim (struct lexer *, struct dictionary *);
60 \f
61 /* Reading system and portable files. */
62
63 /* Type of command. */
64 enum reader_command
65   {
66     GET_CMD,
67     IMPORT_CMD
68   };
69
70 static void get_translate_case (const struct ccase *, struct ccase *,
71                                 void *map_);
72 static bool get_destroy_case_map (void *map_);
73
74 /* Parses a GET or IMPORT command. */
75 static int
76 parse_read_command (struct lexer *lexer, struct dataset *ds, enum reader_command type)
77 {
78   struct casereader *reader = NULL;
79   struct file_handle *fh = NULL;
80   struct dictionary *dict = NULL;
81   struct case_map *map = NULL;
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 = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
92           if (fh == NULL)
93             goto error;
94         }
95       else if (type == IMPORT_CMD && lex_match_id (lexer, "TYPE"))
96         {
97           lex_match (lexer, '=');
98
99           if (lex_match_id (lexer, "COMM"))
100             type = PFM_COMM;
101           else if (lex_match_id (lexer, "TAPE"))
102             type = PFM_TAPE;
103           else
104             {
105               lex_error (lexer, _("expecting COMM or TAPE"));
106               goto error;
107             }
108         }
109       else
110         break;
111     }
112
113   if (fh == NULL)
114     {
115       lex_sbc_missing (lexer, "FILE");
116       goto error;
117     }
118
119   reader = any_reader_open (fh, &dict);
120   if (reader == NULL)
121     goto error;
122
123   start_case_map (dict);
124
125   while (lex_token (lexer) != '.')
126     {
127       lex_match (lexer, '/');
128       if (!parse_dict_trim (lexer, dict))
129         goto error;
130     }
131
132   map = finish_case_map (dict);
133   if (map != NULL)
134     reader = casereader_create_translator (reader,
135                                            dict_get_next_value_idx (dict),
136                                            get_translate_case,
137                                            get_destroy_case_map,
138                                            map);
139
140   proc_set_active_file (ds, reader, dict);
141
142   return CMD_SUCCESS;
143
144  error:
145   casereader_destroy (reader);
146   if (dict != NULL)
147     dict_destroy (dict);
148   return CMD_CASCADING_FAILURE;
149 }
150
151 static void
152 get_translate_case (const struct ccase *input, struct ccase *output,
153                     void *map_)
154 {
155   struct case_map *map = map_;
156   map_case (map, input, output);
157 }
158
159 static bool
160 get_destroy_case_map (void *map_)
161 {
162   struct case_map *map = map_;
163   destroy_case_map (map);
164   return true;
165 }
166 \f
167 /* GET. */
168 int
169 cmd_get (struct lexer *lexer, struct dataset *ds)
170 {
171   return parse_read_command (lexer, ds, GET_CMD);
172 }
173
174 /* IMPORT. */
175 int
176 cmd_import (struct lexer *lexer, struct dataset *ds)
177 {
178   return parse_read_command (lexer, ds, IMPORT_CMD);
179 }
180 \f
181 /* Writing system and portable files. */
182
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 /* Parses SAVE or XSAVE or EXPORT or XEXPORT command.
198    WRITER_TYPE identifies the type of file to write,
199    and COMMAND_TYPE identifies the type of command.
200
201    On success, returns a writer.
202    For procedures only, sets *RETAIN_UNSELECTED to true if cases
203    that would otherwise be excluded by FILTER or USE should be
204    included.
205
206    On failure, returns a null pointer. */
207 static struct casewriter *
208 parse_write_command (struct lexer *lexer, struct dataset *ds,
209                      enum writer_type writer_type,
210                      enum command_type command_type,
211                      bool *retain_unselected)
212 {
213   /* Common data. */
214   struct file_handle *handle; /* Output file. */
215   struct dictionary *dict;    /* Dictionary for output file. */
216   struct casewriter *writer;  /* Writer. */
217   struct case_map *map;       /* Map from input data to data for writer. */
218
219   /* Common options. */
220   bool print_map;             /* Print map?  TODO. */
221   bool print_short_names;     /* Print long-to-short name map.  TODO. */
222   struct sfm_write_options sysfile_opts;
223   struct pfm_write_options porfile_opts;
224
225   assert (writer_type == SYSFILE_WRITER || writer_type == PORFILE_WRITER);
226   assert (command_type == XFORM_CMD || command_type == PROC_CMD);
227   assert ((retain_unselected != NULL) == (command_type == PROC_CMD));
228
229   if (command_type == PROC_CMD)
230     *retain_unselected = true;
231
232   handle = NULL;
233   dict = dict_clone (dataset_dict (ds));
234   writer = NULL;
235   map = NULL;
236   print_map = false;
237   print_short_names = false;
238   sysfile_opts = sfm_writer_default_options ();
239   porfile_opts = pfm_writer_default_options ();
240
241   start_case_map (dict);
242   dict_delete_scratch_vars (dict);
243
244   lex_match (lexer, '/');
245   for (;;)
246     {
247       if (lex_match_id (lexer, "OUTFILE"))
248         {
249           if (handle != NULL)
250             {
251               lex_sbc_only_once ("OUTFILE");
252               goto error;
253             }
254
255           lex_match (lexer, '=');
256
257           handle = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
258           if (handle == NULL)
259             goto error;
260         }
261       else if (lex_match_id (lexer, "NAMES"))
262         print_short_names = true;
263       else if (lex_match_id (lexer, "PERMISSIONS"))
264         {
265           bool cw;
266
267           lex_match (lexer, '=');
268           if (lex_match_id (lexer, "READONLY"))
269             cw = false;
270           else if (lex_match_id (lexer, "WRITEABLE"))
271             cw = true;
272           else
273             {
274               lex_error (lexer, _("expecting %s or %s"), "READONLY", "WRITEABLE");
275               goto error;
276             }
277           sysfile_opts.create_writeable = porfile_opts.create_writeable = cw;
278         }
279       else if (command_type == PROC_CMD && lex_match_id (lexer, "UNSELECTED"))
280         {
281           lex_match (lexer, '=');
282           if (lex_match_id (lexer, "RETAIN"))
283             *retain_unselected = true;
284           else if (lex_match_id (lexer, "DELETE"))
285             *retain_unselected = false;
286           else
287             {
288               lex_error (lexer, _("expecting %s or %s"), "RETAIN", "DELETE");
289               goto error;
290             }
291         }
292       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "COMPRESSED"))
293         sysfile_opts.compress = true;
294       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "UNCOMPRESSED"))
295         sysfile_opts.compress = false;
296       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "VERSION"))
297         {
298           lex_match (lexer, '=');
299           if (!lex_force_int (lexer))
300             goto error;
301           sysfile_opts.version = lex_integer (lexer);
302           lex_get (lexer);
303         }
304       else if (writer_type == PORFILE_WRITER && lex_match_id (lexer, "TYPE"))
305         {
306           lex_match (lexer, '=');
307           if (lex_match_id (lexer, "COMMUNICATIONS"))
308             porfile_opts.type = PFM_COMM;
309           else if (lex_match_id (lexer, "TAPE"))
310             porfile_opts.type = PFM_TAPE;
311           else
312             {
313               lex_error (lexer, _("expecting %s or %s"), "COMM", "TAPE");
314               goto error;
315             }
316         }
317       else if (writer_type == PORFILE_WRITER && lex_match_id (lexer, "DIGITS"))
318         {
319           lex_match (lexer, '=');
320           if (!lex_force_int (lexer))
321             goto error;
322           porfile_opts.digits = lex_integer (lexer);
323           lex_get (lexer);
324         }
325       else if (!parse_dict_trim (lexer, dict))
326         goto error;
327
328       if (!lex_match (lexer, '/'))
329         break;
330     }
331   if (lex_end_of_command (lexer) != CMD_SUCCESS)
332     goto error;
333
334   if (handle == NULL)
335     {
336       lex_sbc_missing (lexer, "OUTFILE");
337       goto error;
338     }
339
340   dict_delete_scratch_vars (dict);
341   dict_compact_values (dict);
342
343   if (fh_get_referent (handle) == FH_REF_FILE)
344     {
345       switch (writer_type)
346         {
347         case SYSFILE_WRITER:
348           writer = sfm_open_writer (handle, dict, sysfile_opts);
349           break;
350         case PORFILE_WRITER:
351           writer = pfm_open_writer (handle, dict, porfile_opts);
352           break;
353         }
354     }
355   else
356     writer = any_writer_open (handle, dict);
357   if (writer == NULL)
358     goto error;
359
360   map = finish_case_map (dict);
361   if (map != NULL)
362     writer = casewriter_create_translator (writer,
363                                            case_map_get_value_cnt (map),
364                                            get_translate_case,
365                                            get_destroy_case_map,
366                                            map);
367   dict_destroy (dict);
368
369   return writer;
370
371  error:
372   casewriter_destroy (writer);
373   dict_destroy (dict);
374   destroy_case_map (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 `=' (%d) does not "
573                      "match number of variables on right side (%d), in "
574                      "parenthesized group %d of RENAME subcommand."),
575                (unsigned) (nv - old_nv), (unsigned) (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[LONG_NAME_LEN + 1] = "";
732   char last_name[LONG_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       casereader_destroy (file->reader);
1091       free (file->by);
1092       dict_destroy (file->dict);
1093       free (file->in_name);
1094       case_destroy (&file->input);
1095       free (file->vars);
1096       free (file);
1097     }
1098
1099   return ok;
1100 }
1101
1102 /* Frees all the data for the MATCH FILES procedure. */
1103 static void
1104 mtf_free (struct mtf_proc *mtf)
1105 {
1106   mtf_close_all_files (mtf);
1107   dict_destroy (mtf->dict);
1108   casewriter_destroy (mtf->output);
1109   case_destroy (&mtf->buffered_case);
1110   case_destroy (&mtf->prev_BY_case);
1111 }
1112
1113 /* Reads the next record into FILE, if possible, and update MTF's
1114    nonempty_files count if not. */
1115 static bool
1116 mtf_read_record (struct mtf_proc *mtf, struct mtf_file *file)
1117 {
1118   case_destroy (&file->input);
1119   if (!casereader_read (file->reader, &file->input))
1120     {
1121       mtf->nonempty_files--;
1122       return false;
1123     }
1124   else
1125     return true;
1126 }
1127
1128 /* Compare the BY variables for files A and B; return -1 if A <
1129    B, 0 if A == B, 1 if A > B.  (If there are no BY variables,
1130    then all records are equal.) */
1131 static inline int
1132 mtf_compare_BY_values (struct mtf_proc *mtf,
1133                        struct mtf_file *a, struct mtf_file *b)
1134 {
1135   return case_compare_2dict (&a->input, &b->input, a->by, b->by, mtf->by_cnt);
1136 }
1137
1138 /* Processes input files and write one case to the output file. */
1139 static void
1140 mtf_process_case (struct mtf_proc *mtf)
1141 {
1142   struct ccase c;
1143   struct mtf_file *min;
1144   struct mtf_file *file;
1145   int min_sequence;
1146   size_t i;
1147
1148   /* Find the set of one or more FILEs whose BY values are
1149      minimal, as well as the set of zero or more TABLEs whose BY
1150      values equal those of the minimum FILEs.
1151
1152      After each iteration of the loop, this invariant holds: the
1153      FILEs with minimum BY values thus far have "sequence"
1154      members equal to min_sequence, and "min" points to one of
1155      the mtf_files whose case has those minimum BY values, and
1156      similarly for TABLEs. */
1157   min_sequence = 0;
1158   min = NULL;
1159   ll_for_each (file, struct mtf_file, ll, &mtf->files)
1160     if (case_is_null (&file->input))
1161       file->sequence = -1;
1162     else if (file->type == MTF_FILE)
1163       {
1164         int cmp = min != NULL ? mtf_compare_BY_values (mtf, min, file) : 1;
1165         if (cmp <= 0)
1166           file->sequence = cmp < 0 ? -1 : min_sequence;
1167         else
1168           {
1169             file->sequence = ++min_sequence;
1170             min = file;
1171           }
1172       }
1173     else
1174       {
1175         int cmp;
1176         assert (min != NULL);
1177         do
1178           {
1179             cmp = mtf_compare_BY_values (mtf, min, file);
1180           }
1181         while (cmp > 0 && mtf_read_record (mtf, file));
1182         file->sequence = cmp == 0 ? min_sequence : -1;
1183       }
1184
1185   /* Form the output case from the input cases. */
1186   case_create (&c, dict_get_next_value_idx (mtf->dict));
1187   for (i = 0; i < dict_get_var_cnt (mtf->dict); i++)
1188     {
1189       struct variable *v = dict_get_var (mtf->dict, i);
1190       value_set_missing (case_data_rw (&c, v), var_get_width (v));
1191     }
1192   ll_for_each_reverse (file, struct mtf_file, ll, &mtf->files)
1193     {
1194       bool include_file = file->sequence == min_sequence;
1195       if (include_file)
1196         for (i = 0; i < file->var_cnt; i++)
1197           {
1198             const struct mtf_variable *mv = &file->vars[i];
1199             const union value *in = case_data (&file->input, mv->in_var);
1200             union value *out = case_data_rw (&c, mv->out_var);
1201             value_copy (out, in, var_get_width (mv->in_var));
1202           }
1203       if (file->in_var != NULL)
1204         case_data_rw (&c, file->in_var)->f = include_file;
1205     }
1206
1207   /* Write the output case. */
1208   if (mtf->first == NULL && mtf->last == NULL)
1209     {
1210       /* With no FIRST or LAST variables, it's trivial. */
1211       casewriter_write (mtf->output, &c);
1212     }
1213   else
1214     {
1215       /* It's harder with LAST, because we can't know whether
1216          this case is the last in a group until we've prepared
1217          the *next* case also.  Thus, we buffer the previous
1218          output case until the next one is ready.
1219
1220          We also have to save a copy of one of the previous input
1221          cases, so that we can compare the BY variables.  We
1222          can't compare the BY variables between the current
1223          output case and the saved one because the BY variables
1224          might not be in the output (the user is allowed to drop
1225          them). */
1226       bool new_BY;
1227       if (mtf->prev_BY != NULL)
1228         {
1229           new_BY = case_compare_2dict (&min->input, &mtf->prev_BY_case,
1230                                        min->by, mtf->prev_BY,
1231                                        mtf->by_cnt);
1232           if (mtf->last != NULL)
1233             case_data_rw (&mtf->buffered_case, mtf->last)->f = new_BY;
1234           casewriter_write (mtf->output, &mtf->buffered_case);
1235         }
1236       else
1237         new_BY = true;
1238
1239       case_move (&mtf->buffered_case, &c);
1240       if (mtf->first != NULL)
1241         case_data_rw (&mtf->buffered_case, mtf->first)->f = new_BY;
1242
1243       if (new_BY)
1244         {
1245           mtf->prev_BY = min->by;
1246           case_destroy (&mtf->prev_BY_case);
1247           case_clone (&mtf->prev_BY_case, &min->input);
1248         }
1249     }
1250
1251   /* Read another record from each input file FILE with minimum
1252      values. */
1253   ll_for_each (file, struct mtf_file, ll, &mtf->files)
1254     if (file->type == MTF_FILE)
1255       {
1256         if (file->sequence == min_sequence)
1257           mtf_read_record (mtf, file);
1258       }
1259     else
1260       break;
1261 }
1262
1263 /* Merge the dictionary for file F into master dictionary M. */
1264 static bool
1265 mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
1266 {
1267   struct dictionary *d = f->dict;
1268   const char *d_docs, *m_docs;
1269   int i;
1270
1271   if (dict_get_label (m) == NULL)
1272     dict_set_label (m, dict_get_label (d));
1273
1274   d_docs = dict_get_documents (d);
1275   m_docs = dict_get_documents (m);
1276   if (d_docs != NULL)
1277     {
1278       if (m_docs == NULL)
1279         dict_set_documents (m, d_docs);
1280       else
1281         {
1282           char *new_docs = xasprintf ("%s%s", m_docs, d_docs);
1283           dict_set_documents (m, new_docs);
1284           free (new_docs);
1285         }
1286     }
1287
1288   for (i = 0; i < dict_get_var_cnt (d); i++)
1289     {
1290       struct variable *dv = dict_get_var (d, i);
1291       struct variable *mv = dict_lookup_var (m, var_get_name (dv));
1292
1293       if (dict_class_from_id (var_get_name (dv)) == DC_SCRATCH)
1294         continue;
1295
1296       if (mv != NULL)
1297         {
1298           if (var_get_width (mv) != var_get_width (dv))
1299             {
1300               char *dv_description = var_type_description (dv);
1301               char *mv_description = var_type_description (mv);
1302               msg (SE, _("Variable %s in file %s (%s) has different "
1303                          "type or width from the same variable in "
1304                          "earlier file (%s)."),
1305                    var_get_name (dv), fh_get_name (f->handle),
1306                    dv_description, mv_description);
1307               free (dv_description);
1308               free (mv_description);
1309               return false;
1310             }
1311
1312           if (var_get_width (dv) == var_get_width (mv))
1313             {
1314               if (var_has_value_labels (dv) && !var_has_value_labels (mv))
1315                 var_set_value_labels (mv, var_get_value_labels (dv));
1316               if (var_has_missing_values (dv) && !var_has_missing_values (mv))
1317                 var_set_missing_values (mv, var_get_missing_values (dv));
1318             }
1319
1320           if (var_get_label (dv) && !var_get_label (mv))
1321             var_set_label (mv, var_get_label (dv));
1322         }
1323       else
1324         mv = dict_clone_var_assert (m, dv, var_get_name (dv));
1325     }
1326
1327   return true;
1328 }
1329 \f
1330 /* Case map.
1331
1332    A case map copies data from a case that corresponds for one
1333    dictionary to a case that corresponds to a second dictionary
1334    derived from the first by, optionally, deleting, reordering,
1335    or renaming variables.  (No new variables may be created.)
1336    */
1337
1338 /* A case map. */
1339 struct case_map
1340   {
1341     size_t value_cnt;   /* Number of values in map. */
1342     int *map;           /* For each destination index, the
1343                            corresponding source index. */
1344   };
1345
1346 /* Prepares dictionary D for producing a case map.  Afterward,
1347    the caller may delete, reorder, or rename variables within D
1348    at will before using finish_case_map() to produce the case
1349    map.
1350
1351    Uses D's aux members, which must otherwise not be in use. */
1352 static void
1353 start_case_map (struct dictionary *d)
1354 {
1355   size_t var_cnt = dict_get_var_cnt (d);
1356   size_t i;
1357
1358   for (i = 0; i < var_cnt; i++)
1359     {
1360       struct variable *v = dict_get_var (d, i);
1361       int *src_fv = xmalloc (sizeof *src_fv);
1362       *src_fv = var_get_case_index (v);
1363       var_attach_aux (v, src_fv, var_dtor_free);
1364     }
1365 }
1366
1367 /* Produces a case map from dictionary D, which must have been
1368    previously prepared with start_case_map().
1369
1370    Does not retain any reference to D, and clears the aux members
1371    set up by start_case_map().
1372
1373    Returns the new case map, or a null pointer if no mapping is
1374    required (that is, no data has changed position). */
1375 static struct case_map *
1376 finish_case_map (struct dictionary *d)
1377 {
1378   struct case_map *map;
1379   size_t var_cnt = dict_get_var_cnt (d);
1380   size_t i;
1381   int identity_map;
1382
1383   map = xmalloc (sizeof *map);
1384   map->value_cnt = dict_get_next_value_idx (d);
1385   map->map = xnmalloc (map->value_cnt, sizeof *map->map);
1386   for (i = 0; i < map->value_cnt; i++)
1387     map->map[i] = -1;
1388
1389   identity_map = 1;
1390   for (i = 0; i < var_cnt; i++)
1391     {
1392       struct variable *v = dict_get_var (d, i);
1393       size_t value_cnt = var_get_value_cnt (v);
1394       int *src_fv = (int *) var_detach_aux (v);
1395       size_t idx;
1396
1397       if (var_get_case_index (v) != *src_fv)
1398         identity_map = 0;
1399
1400       for (idx = 0; idx < value_cnt; idx++)
1401         {
1402           int src_idx = *src_fv + idx;
1403           int dst_idx = var_get_case_index (v) + idx;
1404
1405           assert (map->map[dst_idx] == -1);
1406           map->map[dst_idx] = src_idx;
1407         }
1408       free (src_fv);
1409     }
1410
1411   if (identity_map)
1412     {
1413       destroy_case_map (map);
1414       return NULL;
1415     }
1416
1417   while (map->value_cnt > 0 && map->map[map->value_cnt - 1] == -1)
1418     map->value_cnt--;
1419
1420   return map;
1421 }
1422
1423 /* Maps from SRC to DST, applying case map MAP. */
1424 static void
1425 map_case (const struct case_map *map,
1426           const struct ccase *src, struct ccase *dst)
1427 {
1428   size_t dst_idx;
1429
1430   case_create (dst, map->value_cnt);
1431   for (dst_idx = 0; dst_idx < map->value_cnt; dst_idx++)
1432     {
1433       int src_idx = map->map[dst_idx];
1434       if (src_idx != -1)
1435         *case_data_rw_idx (dst, dst_idx) = *case_data_idx (src, src_idx);
1436     }
1437 }
1438
1439 /* Destroys case map MAP. */
1440 static void
1441 destroy_case_map (struct case_map *map)
1442 {
1443   if (map != NULL)
1444     {
1445       free (map->map);
1446       free (map);
1447     }
1448 }
1449
1450 /* Returns the number of `union value's in cases created by
1451    MAP. */
1452 static size_t
1453 case_map_get_value_cnt (const struct case_map *map)
1454 {
1455   return map->value_cnt;
1456 }