5b28a7fcc3ad74b20f74c08176ef66067ea116ad
[pspp] / src / get.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3    Written by Ben Pfaff <blp@gnu.org>.
4
5    This program is free software; you can redistribute it and/or
6    modify it under the terms of the GNU General Public License as
7    published by the Free Software Foundation; either version 2 of the
8    License, or (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful, but
11    WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
18    02111-1307, USA. */
19
20 #include <config.h>
21 #include <assert.h>
22 #include <stdlib.h>
23 #include "alloc.h"
24 #include "command.h"
25 #include "error.h"
26 #include "file-handle.h"
27 #include "hash.h"
28 #include "lexer.h"
29 #include "misc.h"
30 #include "pfm.h"
31 #include "settings.h"
32 #include "sfm.h"
33 #include "str.h"
34 #include "value-labels.h"
35 #include "var.h"
36 #include "vfm.h"
37 #include "vfmP.h"
38
39 #include "debug-print.h"
40
41 /* GET or IMPORT input program. */
42 struct get_pgm 
43   {
44     struct file_handle *handle; /* File to GET or IMPORT from. */
45     size_t case_size;           /* Case size in bytes. */
46   };
47
48 /* XSAVE transformation (and related SAVE, EXPORT procedures). */
49 struct save_trns
50   {
51     struct trns_header h;
52     struct file_handle *f;      /* Associated system file. */
53     int nvar;                   /* Number of variables. */
54     struct variable **var;      /* Variables. */
55     flt64 *case_buf;            /* Case transfer buffer. */
56   };
57
58 /* Options bits set by trim_dictionary(). */
59 #define GTSV_OPT_COMPRESSED     001     /* Compression; (X)SAVE only. */
60 #define GTSV_OPT_SAVE           002     /* The SAVE/XSAVE/EXPORT procedures. */
61 #define GTSV_OPT_MATCH_FILES    004     /* The MATCH FILES procedure. */
62 #define GTSV_OPT_NONE           0
63
64 static int trim_dictionary (struct dictionary * dict, int *options);
65 static int save_write_case_func (struct ccase *, void *);
66 static trns_proc_func save_trns_proc;
67 static trns_free_func save_trns_free;
68
69 #if DEBUGGING
70 void dump_dict_variables (struct dictionary *);
71 #endif
72
73 /* Parses the GET command. */
74 int
75 cmd_get (void)
76 {
77   struct file_handle *handle;
78   struct dictionary *dict;
79   struct get_pgm *pgm;
80   int options = GTSV_OPT_NONE;
81
82   lex_match_id ("GET");
83   discard_variables ();
84
85   lex_match ('/');
86   if (lex_match_id ("FILE"))
87     lex_match ('=');
88
89   handle = fh_parse_file_handle ();
90   if (handle == NULL)
91     return CMD_FAILURE;
92
93   dict = sfm_read_dictionary (handle, NULL);
94   if (dict == NULL)
95     return CMD_FAILURE;
96
97 #if DEBUGGING
98   dump_dict_variables (dict);
99 #endif
100   if (0 == trim_dictionary (dict, &options))
101     {
102       fh_close_handle (handle);
103       return CMD_FAILURE;
104     }
105 #if DEBUGGING
106   dump_dict_variables (dict);
107 #endif
108
109   dict_compact_values (dict);
110
111 #if DEBUGGING
112   printf (_("GET translation table from file to memory:\n"));
113   for (i = 0; i < dict->nvar; i++)
114     {
115       struct variable *v = dict->var[i];
116
117       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
118               v->get.fv, v->get.nv, v->fv, v->nv);
119     }
120 #endif
121
122   dict_destroy (default_dict);
123   default_dict = dict;
124
125   pgm = xmalloc (sizeof *pgm);
126   pgm->handle = handle;
127   pgm->case_size = dict_get_case_size (default_dict);
128   vfm_source = create_case_source (&get_source_class, default_dict, pgm);
129
130   return CMD_SUCCESS;
131 }
132
133 /* SAVE or XSAVE command? */
134 enum save_cmd 
135   {
136     CMD_SAVE,
137     CMD_XSAVE
138   };
139
140 /* Parses the SAVE and XSAVE commands.  */
141 static int
142 cmd_save_internal (enum save_cmd save_cmd)
143 {
144   struct file_handle *handle;
145   struct dictionary *dict;
146   int options = GTSV_OPT_SAVE;
147
148   struct save_trns *t;
149   struct sfm_write_info inf;
150
151   int i;
152
153   lex_match_id ("SAVE");
154
155   lex_match ('/');
156   if (lex_match_id ("OUTFILE"))
157     lex_match ('=');
158
159   handle = fh_parse_file_handle ();
160   if (handle == NULL)
161     return CMD_FAILURE;
162
163   dict = dict_clone (default_dict);
164 #if DEBUGGING
165   dump_dict_variables (dict);
166 #endif
167   for (i = 0; i < dict_get_var_cnt (dict); i++) 
168     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
169   if (0 == trim_dictionary (dict, &options))
170     {
171       fh_close_handle (handle);
172       return CMD_FAILURE;
173     }
174
175 #if DEBUGGING
176   dump_dict_variables (dict);
177 #endif
178
179   /* Write dictionary. */
180   inf.h = handle;
181   inf.dict = dict;
182   inf.compress = !!(options & GTSV_OPT_COMPRESSED);
183   if (!sfm_write_dictionary (&inf))
184     {
185       dict_destroy (dict);
186       fh_close_handle (handle);
187       return CMD_FAILURE;
188     }
189
190   /* Fill in transformation structure. */
191   t = xmalloc (sizeof *t);
192   t->h.proc = save_trns_proc;
193   t->h.free = save_trns_free;
194   t->f = handle;
195   t->nvar = dict_get_var_cnt (dict);
196   t->var = xmalloc (sizeof *t->var * t->nvar);
197   for (i = 0; i < t->nvar; i++)
198     t->var[i] = dict_get_var (dict, i)->aux;
199   t->case_buf = xmalloc (sizeof *t->case_buf * inf.case_size);
200   dict_destroy (dict);
201
202   if (save_cmd == CMD_SAVE)
203     {
204       procedure (save_write_case_func, t);
205       save_trns_free (&t->h);
206     }
207   else 
208     {
209       assert (save_cmd == CMD_XSAVE);
210       add_transformation (&t->h); 
211     }
212
213   return CMD_SUCCESS;
214 }
215
216 /* Parses and performs the SAVE procedure. */
217 int
218 cmd_save (void)
219 {
220   return cmd_save_internal (CMD_SAVE);
221 }
222
223 /* Parses the XSAVE transformation command. */
224 int
225 cmd_xsave (void)
226 {
227   return cmd_save_internal (CMD_XSAVE);
228 }
229
230 /* Writes the given C to the file specified by T. */
231 static void
232 do_write_case (struct save_trns *t, struct ccase *c) 
233 {
234   flt64 *p = t->case_buf;
235   int i;
236
237   for (i = 0; i < t->nvar; i++)
238     {
239       struct variable *v = t->var[i];
240       if (v->type == NUMERIC)
241         {
242           double src = c->data[v->fv].f;
243           if (src == SYSMIS)
244             *p++ = -FLT64_MAX;
245           else
246             *p++ = src;
247         }
248       else
249         {
250           memcpy (p, c->data[v->fv].s, v->width);
251           memset (&((char *) p)[v->width], ' ',
252                   REM_RND_UP (v->width, sizeof *p));
253           p += DIV_RND_UP (v->width, sizeof *p);
254         }
255     }
256
257   sfm_write_case (t->f, t->case_buf, p - t->case_buf);
258 }
259
260 /* Writes case C to the system file specified on SAVE. */
261 static int
262 save_write_case_func (struct ccase *c, void *aux UNUSED)
263 {
264   do_write_case (aux, c);
265   return 1;
266 }
267
268 /* Writes case C to the system file specified on XSAVE. */
269 static int
270 save_trns_proc (struct trns_header *h, struct ccase *c, int case_num UNUSED)
271 {
272   struct save_trns *t = (struct save_trns *) h;
273   do_write_case (t, c);
274   return -1;
275 }
276
277 /* Frees a SAVE transformation. */
278 static void
279 save_trns_free (struct trns_header *pt)
280 {
281   struct save_trns *t = (struct save_trns *) pt;
282
283   fh_close_handle (t->f);
284   free (t->var);
285   free (t->case_buf);
286   free (t);
287 }
288
289 static int rename_variables (struct dictionary * dict);
290
291 /* The GET and SAVE commands have a common structure after the
292    FILE/OUTFILE subcommand.  This function parses this structure and
293    returns nonzero on success, zero on failure.  It both reads
294    *OPTIONS, for the GTSV_OPT_SAVE bit, and writes it, for the
295    GTSV_OPT_COMPRESSED bit. */
296 /* FIXME: IN, FIRST, LAST, MAP. */
297 /* FIXME?  Should we call dict_compact_values() on dict as a
298    final step? */
299 static int
300 trim_dictionary (struct dictionary *dict, int *options)
301 {
302   if (set_scompression)
303     *options |= GTSV_OPT_COMPRESSED;
304
305   if (*options & GTSV_OPT_SAVE)
306     {
307       /* Delete all the scratch variables. */
308       struct variable **v;
309       size_t nv;
310       size_t i;
311
312       v = xmalloc (sizeof *v * dict_get_var_cnt (dict));
313       nv = 0;
314       for (i = 0; i < dict_get_var_cnt (dict); i++) 
315         if (dict_class_from_id (dict_get_var (dict, i)->name) == DC_SCRATCH)
316           v[nv++] = dict_get_var (dict, i);
317       dict_delete_vars (dict, v, nv);
318       free (v);
319     }
320   
321   while ((*options & GTSV_OPT_MATCH_FILES) || lex_match ('/'))
322     {
323       if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("COMPRESSED"))
324         *options |= GTSV_OPT_COMPRESSED;
325       else if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("UNCOMPRESSED"))
326         *options &= ~GTSV_OPT_COMPRESSED;
327       else if (lex_match_id ("DROP"))
328         {
329           struct variable **v;
330           int nv;
331
332           lex_match ('=');
333           if (!parse_variables (dict, &v, &nv, PV_NONE))
334             return 0;
335           dict_delete_vars (dict, v, nv);
336           free (v);
337         }
338       else if (lex_match_id ("KEEP"))
339         {
340           struct variable **v;
341           int nv;
342           int i;
343
344           lex_match ('=');
345           if (!parse_variables (dict, &v, &nv, PV_NONE))
346             return 0;
347
348           /* Move the specified variables to the beginning. */
349           dict_reorder_vars (dict, v, nv);
350           
351           /* Delete the remaining variables. */
352           v = xrealloc (v, (dict_get_var_cnt (dict) - nv) * sizeof *v);
353           for (i = nv; i < dict_get_var_cnt (dict); i++)
354             v[i - nv] = dict_get_var (dict, i);
355           dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
356           free (v);
357         }
358       else if (lex_match_id ("RENAME"))
359         {
360           if (!rename_variables (dict))
361             return 0;
362         }
363       else
364         {
365           lex_error (_("while expecting a valid subcommand"));
366           return 0;
367         }
368
369       if (dict_get_var_cnt (dict) == 0)
370         {
371           msg (SE, _("All variables deleted from system file dictionary."));
372           return 0;
373         }
374
375       if (*options & GTSV_OPT_MATCH_FILES)
376         return 1;
377     }
378
379   if (token != '.')
380     {
381       lex_error (_("expecting end of command"));
382       return 0;
383     }
384   
385   return 1;
386 }
387
388 /* Parses and performs the RENAME subcommand of GET and SAVE. */
389 static int
390 rename_variables (struct dictionary * dict)
391 {
392   int i;
393
394   int success = 0;
395
396   struct variable **v;
397   char **new_names;
398   int nv, nn;
399   char *err_name;
400
401   int group;
402
403   lex_match ('=');
404   if (token != '(')
405     {
406       struct variable *v;
407
408       v = parse_dict_variable (dict);
409       if (v == NULL)
410         return 0;
411       if (!lex_force_match ('=')
412           || !lex_force_id ())
413         return 0;
414       if (!strncmp (tokid, v->name, 8))
415         return 1;
416       if (dict_lookup_var (dict, tokid) != NULL)
417         {
418           msg (SE, _("Cannot rename %s as %s because there already exists "
419                      "a variable named %s.  To rename variables with "
420                      "overlapping names, use a single RENAME subcommand "
421                      "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
422                      "\"/RENAME (A B C=B C A)\"."), v->name, tokid, tokid);
423           return 0;
424         }
425       
426       dict_rename_var (dict, v, tokid);
427       lex_get ();
428       return 1;
429     }
430
431   nv = nn = 0;
432   v = NULL;
433   new_names = 0;
434   group = 1;
435   while (lex_match ('('))
436     {
437       int old_nv = nv;
438
439       if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
440         goto done;
441       if (!lex_match ('='))
442         {
443           msg (SE, _("`=' expected after variable list."));
444           goto done;
445         }
446       if (!parse_DATA_LIST_vars (&new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
447         goto done;
448       if (nn != nv)
449         {
450           msg (SE, _("Number of variables on left side of `=' (%d) does not "
451                "match number of variables on right side (%d), in "
452                "parenthesized group %d of RENAME subcommand."),
453                nv - old_nv, nn - old_nv, group);
454           goto done;
455         }
456       if (!lex_force_match (')'))
457         goto done;
458       group++;
459     }
460
461   if (!dict_rename_vars (dict, v, new_names, nv, &err_name)) 
462     {
463       msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
464       goto done;
465     }
466   success = 1;
467
468 done:
469   for (i = 0; i < nn; i++)
470     free (new_names[i]);
471   free (new_names);
472   free (v);
473
474   return success;
475 }
476
477 #if DEBUGGING
478 void
479 dump_dict_variables (struct dictionary * dict)
480 {
481   int i;
482
483   printf (_("\nVariables in dictionary:\n"));
484   for (i = 0; i < dict->nvar; i++)
485     printf ("%s, ", dict->var[i]->name);
486   printf ("\n");
487 }
488 #endif
489 \f
490 /* Clears internal state related to GET input procedure. */
491 static void
492 get_source_destroy (struct case_source *source)
493 {
494   struct get_pgm *pgm = source->aux;
495
496   /* It is not necessary to destroy the dictionary because if we get
497      to this point then the dictionary is default_dict. */
498   fh_close_handle (pgm->handle);
499   free (pgm);
500 }
501
502 /* Reads all the cases from the data file into C and passes them
503    to WRITE_CASE one by one, passing WC_DATA. */
504 static void
505 get_source_read (struct case_source *source,
506                  struct ccase *c,
507                  write_case_func *write_case, write_case_data wc_data)
508 {
509   struct get_pgm *pgm = source->aux;
510
511   while (sfm_read_case (pgm->handle, c->data, default_dict)
512          && write_case (wc_data))
513     ;
514 }
515
516 const struct case_source_class get_source_class =
517   {
518     "GET",
519     NULL,
520     get_source_read,
521     get_source_destroy,
522   };
523
524 \f
525 /* MATCH FILES. */
526
527 #include "debug-print.h"
528
529 /* File types. */
530 enum
531   {
532     MTF_FILE,                   /* Specified on FILE= subcommand. */
533     MTF_TABLE                   /* Specified on TABLE= subcommand. */
534   };
535
536 /* One of the files on MATCH FILES. */
537 struct mtf_file
538   {
539     struct mtf_file *next, *prev;
540                                 /* Next, previous in the list of files. */
541     struct mtf_file *next_min;  /* Next in the chain of minimums. */
542     
543     int type;                   /* One of MTF_*. */
544     struct variable **by;       /* List of BY variables for this file. */
545     struct file_handle *handle; /* File handle for the file. */
546     struct dictionary *dict;    /* Dictionary from system file. */
547     char in[9];                 /* Name of the variable from IN=. */
548     char first[9], last[9];     /* Name of the variables from FIRST=, LAST=. */
549     union value *input;         /* Input record. */
550   };
551
552 /* All the files mentioned on FILE or TABLE. */
553 static struct mtf_file *mtf_head, *mtf_tail;
554
555 /* Variables on the BY subcommand. */
556 static struct variable **mtf_by;
557 static int mtf_n_by;
558
559 /* Master dictionary. */
560 static struct dictionary *mtf_master;
561
562 /* Used to determine whether we've already initialized this
563    variable. */
564 static unsigned mtf_seq_num;
565
566 /* Sequence numbers for each variable in mtf_master. */
567 static unsigned *mtf_seq_nums;
568
569 /* Sink for MATCH FILES output. */
570 static struct case_sink *mtf_sink;
571
572 /* Case used for MATCH FILES output. */
573 static struct ccase *mtf_case;
574
575 static void mtf_free (void);
576 static void mtf_free_file (struct mtf_file *file);
577 static int mtf_merge_dictionary (struct mtf_file *f);
578 static void mtf_delete_file_in_place (struct mtf_file **file);
579
580 static void mtf_read_nonactive_records (void *);
581 static void mtf_processing_finish (void *);
582 static int mtf_processing (struct ccase *, void *);
583
584 static char *var_type_description (struct variable *);
585
586 /* Parse and execute the MATCH FILES command. */
587 int
588 cmd_match_files (void)
589 {
590   struct mtf_file *first_table = NULL;
591   
592   int seen = 0;
593   
594   lex_match_id ("MATCH");
595   lex_match_id ("FILES");
596
597   mtf_head = mtf_tail = NULL;
598   mtf_by = NULL;
599   mtf_n_by = 0;
600   mtf_master = dict_create ();
601   mtf_seq_num = 0;
602   mtf_seq_nums = NULL;
603   dict_set_case_limit (mtf_master, dict_get_case_limit (default_dict));
604   
605   do
606     {
607       lex_match ('/');
608
609       if (lex_match (T_BY))
610         {
611           if (seen & 1)
612             {
613               msg (SE, _("The BY subcommand may be given once at most."));
614               goto lossage;
615             }
616           seen |= 1;
617               
618           lex_match ('=');
619           if (!parse_variables (mtf_master, &mtf_by, &mtf_n_by,
620                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
621             goto lossage;
622         }
623       else if (token != T_ID)
624         {
625           lex_error (NULL);
626           goto lossage;
627         }
628       else if (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid))
629         {
630           struct mtf_file *file = xmalloc (sizeof *file);
631
632           file->in[0] = file->first[0] = file->last[0] = '\0';
633           file->dict = NULL;
634           file->by = NULL;
635           file->input = NULL;
636
637           if (lex_match_id ("FILE"))
638             file->type = MTF_FILE;
639           else if (lex_match_id ("TABLE"))
640             {
641               file->type = MTF_TABLE;
642               seen |= 4;
643             }
644           else
645             assert (0);
646
647           /* FILEs go first, then TABLEs. */
648           if (file->type == MTF_TABLE || first_table == NULL)
649             {
650               file->next = NULL;
651               file->prev = mtf_tail;
652               if (mtf_tail)
653                 mtf_tail->next = file;
654               mtf_tail = file;
655               if (mtf_head == NULL)
656                 mtf_head = file;
657               if (file->type == MTF_TABLE && first_table == NULL)
658                 first_table = file;
659             }
660           else 
661             {
662               assert (file->type == MTF_FILE);
663               file->next = first_table;
664               file->prev = first_table->prev;
665               if (first_table->prev)
666                 first_table->prev->next = file;
667               else
668                 mtf_head = file;
669               first_table->prev = file;
670             }
671           
672           lex_match ('=');
673           
674           if (lex_match ('*'))
675             {
676               file->handle = NULL;
677
678               if (seen & 2)
679                 {
680                   msg (SE, _("The active file may not be specified more "
681                              "than once."));
682                   goto lossage;
683                 }
684               seen |= 2;
685
686               assert (pgm_state != STATE_INPUT);
687               if (pgm_state == STATE_INIT)
688                 {
689                   msg (SE, _("Cannot specify the active file since no active "
690                              "file has been defined."));
691                   goto lossage;
692                 }
693
694               if (temporary != 0)
695                 {
696                   msg (SE,
697                        _("MATCH FILES may not be used after TEMPORARY when "
698                          "the active file is an input source.  "
699                          "Temporary transformations will be made permanent."));
700                   cancel_temporary (); 
701                 }
702             }
703           else
704             {
705               file->handle = fh_parse_file_handle ();
706               if (!file->handle)
707                 goto lossage;
708             }
709
710           if (file->handle)
711             {
712               file->dict = sfm_read_dictionary (file->handle, NULL);
713               if (!file->dict)
714                 goto lossage;
715             }
716           else
717             file->dict = default_dict;
718           if (!mtf_merge_dictionary (file))
719             goto lossage;
720         }
721       else if (lex_id_match ("IN", tokid)
722                || lex_id_match ("FIRST", tokid)
723                || lex_id_match ("LAST", tokid))
724         {
725           const char *sbc;
726           char *name;
727           
728           if (mtf_tail == NULL)
729             {
730               msg (SE, _("IN, FIRST, and LAST subcommands may not occur "
731                          "before the first FILE or TABLE."));
732               goto lossage;
733             }
734
735           if (lex_match_id ("IN"))
736             {
737               name = mtf_tail->in;
738               sbc = "IN";
739             }
740           else if (lex_match_id ("FIRST"))
741             {
742               name = mtf_tail->first;
743               sbc = "FIRST";
744             }
745           else if (lex_match_id ("LAST"))
746             {
747               name = mtf_tail->last;
748               sbc = "LAST";
749             }
750           else
751             assert (0);
752
753           lex_match ('=');
754           if (token != T_ID)
755             {
756               lex_error (NULL);
757               goto lossage;
758             }
759
760           if (*name)
761             {
762               msg (SE, _("Multiple %s subcommands for a single FILE or "
763                          "TABLE."),
764                    sbc);
765               goto lossage;
766             }
767           strcpy (name, tokid);
768           lex_get ();
769
770           if (!dict_create_var (mtf_master, name, 0))
771             {
772               msg (SE, _("Duplicate variable name %s while creating %s "
773                          "variable."),
774                    name, sbc);
775               goto lossage;
776             }
777         }
778       else if (lex_id_match ("RENAME", tokid)
779                || lex_id_match ("KEEP", tokid)
780                || lex_id_match ("DROP", tokid))
781         {
782           int options = GTSV_OPT_MATCH_FILES;
783           
784           if (mtf_tail == NULL)
785             {
786               msg (SE, _("RENAME, KEEP, and DROP subcommands may not occur "
787                          "before the first FILE or TABLE."));
788               goto lossage;
789             }
790
791           if (!trim_dictionary (mtf_tail->dict, &options))
792             goto lossage;
793         }
794       else if (lex_match_id ("MAP"))
795         {
796           /* FIXME. */
797         }
798       else
799         {
800           lex_error (NULL);
801           goto lossage;
802         }
803     }
804   while (token != '.');
805
806   if (seen & 4)
807     {
808       if (!(seen & 1))
809         {
810           msg (SE, _("The BY subcommand is required when a TABLE subcommand "
811                      "is given."));
812           goto lossage;
813         }
814     }
815
816   if (seen & 1)
817     {
818       struct mtf_file *iter;
819
820       for (iter = mtf_head; iter; iter = iter->next)
821         {
822           int i;
823           
824           iter->by = xmalloc (sizeof *iter->by * mtf_n_by);
825
826           for (i = 0; i < mtf_n_by; i++)
827             {
828               iter->by[i] = dict_lookup_var (iter->dict, mtf_by[i]->name);
829               if (iter->by[i] == NULL)
830                 {
831                   msg (SE, _("File %s lacks BY variable %s."),
832                        iter->handle ? fh_handle_name (iter->handle) : "*",
833                        mtf_by[i]->name);
834                   goto lossage;
835                 }
836             }
837         }
838     }
839
840 #if DEBUGGING
841   {
842     /* From sfm-read.c. */
843     extern void dump_dictionary (struct dictionary *);
844
845     dump_dictionary (mtf_master);
846   }
847 #endif
848
849   /* MATCH FILES performs an n-way merge on all its input files.
850      Abstract algorithm:
851
852      1. Read one input record from every input FILE.
853
854      2. If no FILEs are left, stop.  Otherwise, proceed to step 3.
855
856      3. Find the FILE input record with minimum BY values.  Store all
857      the values from this input record into the output record.
858
859      4. Find all the FILE input records with BY values identical to
860      the minimums.  Store all the values from these input records into
861      the output record.
862
863      5. For every TABLE, read another record as long as the BY values
864      on the TABLE's input record are less than the FILEs' BY values.
865      If an exact match is found, store all the values from the TABLE
866      input record into the output record.
867
868      6. Write the output record.
869
870      7. Read another record from each input file FILE and TABLE that
871      we stored values from above.  If we come to the end of one of the
872      input files, remove it from the list of input files.
873
874      8. Repeat from step 2.
875
876      Unfortunately, this algorithm can't be directly implemented
877      because there's no function to read a record from the active
878      file; instead, it has to be done using callbacks.
879
880      FIXME: For merging large numbers of files (more than 10?) a
881      better algorithm would use a heap for finding minimum
882      values. */
883
884   if (!(seen & 2))
885     discard_variables ();
886
887   mtf_sink = create_case_sink (&storage_sink_class, mtf_master, NULL);
888
889   mtf_seq_nums = xmalloc (dict_get_var_cnt (mtf_master)
890                           * sizeof *mtf_seq_nums);
891   memset (mtf_seq_nums, 0,
892           dict_get_var_cnt (mtf_master) * sizeof *mtf_seq_nums);
893   mtf_case = xmalloc (dict_get_case_size (mtf_master));
894
895   mtf_read_nonactive_records (NULL);
896   if (seen & 2)
897     procedure (mtf_processing, NULL);
898   mtf_processing_finish (NULL);
899
900   dict_destroy (default_dict);
901   default_dict = mtf_master;
902   mtf_master = NULL;
903   vfm_source = mtf_sink->class->make_source (mtf_sink);
904   free_case_sink (mtf_sink);
905   
906   mtf_free ();
907   return CMD_SUCCESS;
908   
909 lossage:
910   mtf_free ();
911   return CMD_FAILURE;
912 }
913
914 /* Repeats 2...8 an arbitrary number of times. */
915 static void
916 mtf_processing_finish (void *aux UNUSED)
917 {
918   /* Find the active file and delete it. */
919   {
920     struct mtf_file *iter;
921     
922     for (iter = mtf_head; iter; iter = iter->next)
923       if (iter->handle == NULL)
924         {
925           mtf_delete_file_in_place (&iter);
926           break;
927         }
928   }
929   
930   while (mtf_head && mtf_head->type == MTF_FILE)
931     if (!mtf_processing (NULL, NULL))
932       break;
933 }
934
935 /* Return a string in a static buffer describing V's variable type and
936    width. */
937 static char *
938 var_type_description (struct variable *v)
939 {
940   static char buf[2][32];
941   static int x = 0;
942   char *s;
943
944   x ^= 1;
945   s = buf[x];
946
947   if (v->type == NUMERIC)
948     strcpy (s, "numeric");
949   else
950     {
951       assert (v->type == ALPHA);
952       sprintf (s, "string with width %d", v->width);
953     }
954   return s;
955 }
956
957 /* Free FILE and associated data. */
958 static void
959 mtf_free_file (struct mtf_file *file)
960 {
961   fh_close_handle (file->handle);
962   if (file->dict != NULL && file->dict != default_dict)
963     dict_destroy (file->dict);
964   free (file->by);
965   if (file->handle)
966     free (file->input);
967   free (file);
968 }
969
970 /* Free all the data for the MATCH FILES procedure. */
971 static void
972 mtf_free (void)
973 {
974   struct mtf_file *iter, *next;
975
976   for (iter = mtf_head; iter; iter = next)
977     {
978       next = iter->next;
979
980       mtf_free_file (iter);
981     }
982   
983   free (mtf_by);
984   if (mtf_master)
985     dict_destroy (mtf_master);
986   free (mtf_seq_nums);
987 }
988
989 /* Remove *FILE from the mtf_file chain.  Make *FILE point to the next
990    file in the chain, or to NULL if was the last in the chain. */
991 static void
992 mtf_delete_file_in_place (struct mtf_file **file)
993 {
994   struct mtf_file *f = *file;
995
996   if (f->prev)
997     f->prev->next = f->next;
998   if (f->next)
999     f->next->prev = f->prev;
1000   if (f == mtf_head)
1001     mtf_head = f->next;
1002   if (f == mtf_tail)
1003     mtf_tail = f->prev;
1004   *file = f->next;
1005
1006   {
1007     int i;
1008
1009     for (i = 0; i < dict_get_var_cnt (f->dict); i++)
1010       {
1011         struct variable *v = dict_get_var (f->dict, i);
1012           
1013         if (v->type == NUMERIC)
1014           mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1015         else
1016           memset (mtf_case->data[v->p.mtf.master->fv].s, ' ', v->width);
1017       }
1018   }
1019
1020   mtf_free_file (f);
1021 }
1022
1023 /* Read a record from every input file except the active file. */
1024 static void
1025 mtf_read_nonactive_records (void *aux UNUSED)
1026 {
1027   struct mtf_file *iter;
1028
1029   for (iter = mtf_head; iter; )
1030     {
1031       if (iter->handle)
1032         {
1033           assert (iter->input == NULL);
1034           iter->input = xmalloc (dict_get_case_size (iter->dict));
1035           
1036           if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1037             mtf_delete_file_in_place (&iter);
1038           else
1039             iter = iter->next;
1040         }
1041       else
1042         iter = iter->next;
1043     }
1044 }
1045
1046 /* Compare the BY variables for files A and B; return -1 if A < B, 0
1047    if A == B, 1 if A > B. */
1048 static inline int
1049 mtf_compare_BY_values (struct mtf_file *a, struct mtf_file *b,
1050                        struct ccase *c)
1051 {
1052   union value *a_input, *b_input;
1053   int i;
1054
1055   assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
1056   a_input = a->input != NULL ? a->input : c->data;
1057   b_input = b->input != NULL ? b->input : c->data;
1058   for (i = 0; i < mtf_n_by; i++)
1059     {
1060       assert (a->by[i]->type == b->by[i]->type);
1061       assert (a->by[i]->width == b->by[i]->width);
1062       
1063       if (a->by[i]->type == NUMERIC)
1064         {
1065           double af = a_input[a->by[i]->fv].f;
1066           double bf = b_input[b->by[i]->fv].f;
1067
1068           if (af < bf)
1069             return -1;
1070           else if (af > bf)
1071             return 1;
1072         }
1073       else 
1074         {
1075           int result;
1076           
1077           assert (a->by[i]->type == ALPHA);
1078           result = memcmp (a_input[a->by[i]->fv].s,
1079                            b_input[b->by[i]->fv].s,
1080                            a->by[i]->width);
1081           if (result < 0)
1082             return -1;
1083           else if (result > 0)
1084             return 1;
1085         }
1086     }
1087   return 0;
1088 }
1089
1090 /* Perform one iteration of steps 3...7 above. */
1091 static int
1092 mtf_processing (struct ccase *c, void *aux UNUSED)
1093 {
1094   /* List of files with minimum BY values. */
1095   struct mtf_file *min_head, *min_tail;
1096
1097   /* List of files with non-minimum BY values. */
1098   struct mtf_file *max_head, *max_tail;
1099
1100   /* Iterator. */
1101   struct mtf_file *iter;
1102
1103   for (;;)
1104     {
1105       /* If the active file doesn't have the minimum BY values, don't
1106          return because that would cause a record to be skipped. */
1107       int advance = 1;
1108
1109       if (mtf_head->type == MTF_TABLE)
1110         return 0;
1111       
1112       /* 3. Find the FILE input record with minimum BY values.  Store
1113          all the values from this input record into the output record.
1114
1115          4. Find all the FILE input records with BY values identical
1116          to the minimums.  Store all the values from these input
1117          records into the output record. */
1118       min_head = min_tail = mtf_head;
1119       max_head = max_tail = NULL;
1120       for (iter = mtf_head->next; iter && iter->type == MTF_FILE;
1121            iter = iter->next)
1122         switch (mtf_compare_BY_values (min_head, iter, c))
1123           {
1124           case -1:
1125             if (max_head)
1126               max_tail = max_tail->next_min = iter;
1127             else
1128               max_head = max_tail = iter;
1129             break;
1130
1131           case 0:
1132             min_tail = min_tail->next_min = iter;
1133             break;
1134
1135           case 1:
1136             if (max_head)
1137               {
1138                 max_tail->next_min = min_head;
1139                 max_tail = min_tail;
1140               }
1141             else
1142               {
1143                 max_head = min_head;
1144                 max_tail = min_tail;
1145               }
1146             min_head = min_tail = iter;
1147             break;
1148
1149           default:
1150             assert (0);
1151           }
1152
1153       /* 5. For every TABLE, read another record as long as the BY
1154          values on the TABLE's input record are less than the FILEs'
1155          BY values.  If an exact match is found, store all the values
1156          from the TABLE input record into the output record. */
1157       while (iter)
1158         {
1159           struct mtf_file *next = iter->next;
1160           
1161           assert (iter->type == MTF_TABLE);
1162       
1163           if (iter->handle == NULL)
1164             advance = 0;
1165
1166         again:
1167           switch (mtf_compare_BY_values (min_head, iter, c))
1168             {
1169             case -1:
1170               if (max_head)
1171                 max_tail = max_tail->next_min = iter;
1172               else
1173                 max_head = max_tail = iter;
1174               break;
1175
1176             case 0:
1177               min_tail = min_tail->next_min = iter;
1178               break;
1179
1180             case 1:
1181               if (iter->handle == NULL)
1182                 return 1;
1183               if (sfm_read_case (iter->handle, iter->input, iter->dict))
1184                 goto again;
1185               mtf_delete_file_in_place (&iter);
1186               break;
1187
1188             default:
1189               assert (0);
1190             }
1191
1192           iter = next;
1193         }
1194
1195       /* Next sequence number. */
1196       mtf_seq_num++;
1197   
1198       /* Store data to all the records we are using. */
1199       if (min_tail)
1200         min_tail->next_min = NULL;
1201       for (iter = min_head; iter; iter = iter->next_min)
1202         {
1203           int i;
1204
1205           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1206             {
1207               struct variable *v = dict_get_var (iter->dict, i);
1208               union value *record;
1209           
1210               if (mtf_seq_nums[v->p.mtf.master->index] == mtf_seq_num)
1211                 continue;
1212               mtf_seq_nums[v->p.mtf.master->index] = mtf_seq_num;
1213
1214               record = iter->input != NULL ? iter->input : c->data;
1215
1216               assert (v->type == NUMERIC || v->type == ALPHA);
1217               if (v->type == NUMERIC)
1218                 mtf_case->data[v->p.mtf.master->fv].f = record[v->fv].f;
1219               else
1220                 memcpy (mtf_case->data[v->p.mtf.master->fv].s,
1221                         record[v->fv].s, v->width);
1222             }
1223         }
1224
1225       /* Store missing values to all the records we're not using. */
1226       if (max_tail)
1227         max_tail->next_min = NULL;
1228       for (iter = max_head; iter; iter = iter->next_min)
1229         {
1230           int i;
1231
1232           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1233             {
1234               struct variable *v = dict_get_var (iter->dict, i);
1235           
1236               if (mtf_seq_nums[v->p.mtf.master->index] == mtf_seq_num)
1237                 continue;
1238               mtf_seq_nums[v->p.mtf.master->index] = mtf_seq_num;
1239
1240 #if 0
1241               printf ("%s/%s: dest-fv=%d\n",
1242                       fh_handle_name (iter->handle),
1243                       v->name,
1244                       v->p.mtf.master->fv);
1245 #endif
1246               if (v->type == NUMERIC)
1247                 mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1248               else
1249                 memset (mtf_case->data[v->p.mtf.master->fv].s, ' ',
1250                         v->width);
1251             }
1252
1253           if (iter->handle == NULL)
1254             advance = 0;
1255         }
1256
1257       /* 6. Write the output record. */
1258       mtf_sink->class->write (mtf_sink, mtf_case);
1259
1260       /* 7. Read another record from each input file FILE and TABLE
1261          that we stored values from above.  If we come to the end of
1262          one of the input files, remove it from the list of input
1263          files. */
1264       for (iter = min_head; iter && iter->type == MTF_FILE; )
1265         {
1266           struct mtf_file *next = iter->next_min;
1267           
1268           if (iter->handle)
1269             {
1270               assert (iter->input != NULL);
1271
1272               if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1273                 mtf_delete_file_in_place (&iter);
1274             }
1275
1276           iter = next;
1277         }
1278       
1279       if (advance)
1280         break;
1281     }
1282
1283   return (mtf_head && mtf_head->type != MTF_TABLE);
1284 }
1285
1286 /* Merge the dictionary for file F into the master dictionary
1287    mtf_master. */
1288 static int
1289 mtf_merge_dictionary (struct mtf_file *f)
1290 {
1291   struct dictionary *const m = mtf_master;
1292   struct dictionary *d = f->dict;
1293   const char *d_docs, *m_docs;
1294
1295   if (dict_get_label (m) == NULL)
1296     dict_set_label (m, dict_get_label (d));
1297
1298   d_docs = dict_get_documents (d);
1299   m_docs = dict_get_documents (m);
1300   if (d_docs != NULL) 
1301     {
1302       if (m_docs == NULL)
1303         dict_set_documents (m, d_docs);
1304       else
1305         {
1306           char *new_docs;
1307           size_t new_len;
1308
1309           new_len = strlen (m_docs) + strlen (d_docs);
1310           new_docs = xmalloc (new_len + 1);
1311           strcpy (new_docs, m_docs);
1312           strcat (new_docs, d_docs);
1313           dict_set_documents (m, new_docs);
1314           free (new_docs);
1315         }
1316     }
1317   
1318   dict_compact_values (d);
1319
1320   {
1321     int i;
1322
1323     for (i = 0; i < dict_get_var_cnt (d); i++)
1324       {
1325         struct variable *dv = dict_get_var (d, i);
1326         struct variable *mv = dict_lookup_var (m, dv->name);
1327
1328         assert (dv->type == ALPHA || dv->width == 0);
1329         assert (!mv || mv->type == ALPHA || mv->width == 0);
1330         if (mv && dv->width == mv->width)
1331           {
1332             if (val_labs_count (dv->val_labs)
1333                 && !val_labs_count (mv->val_labs))
1334               mv->val_labs = val_labs_copy (dv->val_labs);
1335             if (dv->miss_type != MISSING_NONE
1336                 && mv->miss_type == MISSING_NONE)
1337               copy_missing_values (mv, dv);
1338           }
1339         if (mv && dv->label && !mv->label)
1340           mv->label = xstrdup (dv->label);
1341         if (!mv) 
1342           {
1343             mv = dict_clone_var (m, dv, dv->name);
1344             assert (mv != NULL);
1345           }
1346         else if (mv->width != dv->width)
1347           {
1348             msg (SE, _("Variable %s in file %s (%s) has different "
1349                        "type or width from the same variable in "
1350                        "earlier file (%s)."),
1351                  dv->name, fh_handle_name (f->handle),
1352                  var_type_description (dv), var_type_description (mv));
1353             return 0;
1354           }
1355         dv->p.mtf.master = mv;
1356       }
1357   }
1358
1359   return 1;
1360 }
1361 \f
1362 /* IMPORT command. */
1363
1364 /* Parses the IMPORT command. */
1365 int
1366 cmd_import (void)
1367 {
1368   struct file_handle *handle = NULL;
1369   struct dictionary *dict;
1370   struct get_pgm *pgm;
1371   int options = GTSV_OPT_NONE;
1372   int type;
1373
1374   lex_match_id ("IMPORT");
1375
1376   for (;;)
1377     {
1378       lex_match ('/');
1379       
1380       if (lex_match_id ("FILE") || token == T_STRING)
1381         {
1382           lex_match ('=');
1383
1384           handle = fh_parse_file_handle ();
1385           if (handle == NULL)
1386             return CMD_FAILURE;
1387         }
1388       else if (lex_match_id ("TYPE"))
1389         {
1390           lex_match ('=');
1391
1392           if (lex_match_id ("COMM"))
1393             type = PFM_COMM;
1394           else if (lex_match_id ("TAPE"))
1395             type = PFM_TAPE;
1396           else
1397             {
1398               lex_error (_("expecting COMM or TAPE"));
1399               return CMD_FAILURE;
1400             }
1401         }
1402       else break;
1403     }
1404   if (!lex_match ('/') && token != '.')
1405     {
1406       lex_error (NULL);
1407       return CMD_FAILURE;
1408     }
1409
1410   discard_variables ();
1411
1412   dict = pfm_read_dictionary (handle, NULL);
1413   if (dict == NULL)
1414     return CMD_FAILURE;
1415
1416 #if DEBUGGING
1417   dump_dict_variables (dict);
1418 #endif
1419   if (0 == trim_dictionary (dict, &options))
1420     {
1421       fh_close_handle (handle);
1422       return CMD_FAILURE;
1423     }
1424 #if DEBUGGING
1425   dump_dict_variables (dict);
1426 #endif
1427
1428   dict_compact_values (dict);
1429
1430 #if DEBUGGING
1431   printf (_("IMPORT translation table from file to memory:\n"));
1432   for (i = 0; i < dict->nvar; i++)
1433     {
1434       struct variable *v = dict->var[i];
1435
1436       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
1437               v->get.fv, v->get.nv, v->fv, v->nv);
1438     }
1439 #endif
1440
1441   dict_destroy (default_dict);
1442   default_dict = dict;
1443
1444   pgm = xmalloc (sizeof *pgm);
1445   pgm->handle = handle;
1446   pgm->case_size = dict_get_case_size (default_dict);
1447   vfm_source = create_case_source (&import_source_class, default_dict, pgm);
1448
1449   return CMD_SUCCESS;
1450 }
1451
1452 /* Reads all the cases from the data file and passes them to
1453    write_case(). */
1454 static void
1455 import_source_read (struct case_source *source,
1456                     struct ccase *c,
1457                     write_case_func *write_case, write_case_data wc_data)
1458 {
1459   struct get_pgm *pgm = source->aux;
1460   
1461   while (pfm_read_case (pgm->handle, c->data, default_dict))
1462     if (!write_case (wc_data))
1463       break;
1464 }
1465
1466 const struct case_source_class import_source_class =
1467   {
1468     "IMPORT",
1469     NULL,
1470     import_source_read,
1471     get_source_destroy,
1472   };
1473 \f
1474 static int export_write_case_func (struct ccase *c, void *);
1475      
1476 /* Parses the EXPORT command.  */
1477 /* FIXME: same as cmd_save_internal(). */
1478 int
1479 cmd_export (void)
1480 {
1481   struct file_handle *handle;
1482   struct dictionary *dict;
1483   int options = GTSV_OPT_SAVE;
1484
1485   struct save_trns *t;
1486
1487   int i;
1488
1489   lex_match_id ("EXPORT");
1490
1491   lex_match ('/');
1492   if (lex_match_id ("OUTFILE"))
1493     lex_match ('=');
1494
1495   handle = fh_parse_file_handle ();
1496   if (handle == NULL)
1497     return CMD_FAILURE;
1498
1499   dict = dict_clone (default_dict);
1500 #if DEBUGGING
1501   dump_dict_variables (dict);
1502 #endif
1503   for (i = 0; i < dict_get_var_cnt (dict); i++)
1504     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
1505   if (0 == trim_dictionary (dict, &options))
1506     {
1507       fh_close_handle (handle);
1508       return CMD_FAILURE;
1509     }
1510
1511 #if DEBUGGING
1512   dump_dict_variables (dict);
1513 #endif
1514
1515   /* Write dictionary. */
1516   if (!pfm_write_dictionary (handle, dict))
1517     {
1518       dict_destroy (dict);
1519       fh_close_handle (handle);
1520       return CMD_FAILURE;
1521     }
1522
1523   /* Fill in transformation structure. */
1524   t = xmalloc (sizeof *t);
1525   t->h.proc = save_trns_proc;
1526   t->h.free = save_trns_free;
1527   t->f = handle;
1528   t->nvar = dict_get_var_cnt (dict);
1529   t->var = xmalloc (sizeof *t->var * t->nvar);
1530   for (i = 0; i < t->nvar; i++)
1531     t->var[i] = dict_get_var (dict, i)->aux;
1532   t->case_buf = xmalloc (sizeof *t->case_buf * t->nvar);
1533   dict_destroy (dict);
1534
1535   procedure (export_write_case_func, t);
1536   save_trns_free (&t->h);
1537
1538   return CMD_SUCCESS;
1539 }
1540
1541 /* Writes case C to the EXPORT file. */
1542 static int
1543 export_write_case_func (struct ccase *c, void *aux)
1544 {
1545   struct save_trns *t = aux;
1546   union value *p = (union value *) t->case_buf;
1547   int i;
1548
1549   for (i = 0; i < t->nvar; i++)
1550     {
1551       struct variable *v = t->var[i];
1552
1553       if (v->type == NUMERIC)
1554         *p++ = c->data[v->fv];
1555       else
1556         (*p++).c = c->data[v->fv].s;
1557     }
1558
1559   pfm_write_case (t->f, (union value *) t->case_buf);
1560   return 1;
1561 }