c082516d664efe45f39f6eaf31a1b439c0cdfb3b
[pspp-builds.git] / src / data-in.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 "data-in.h"
22 #include "error.h"
23 #include <math.h>
24 #include <ctype.h>
25 #include <stdarg.h>
26 #include <stddef.h>
27 #include <stdio.h>
28 #include <stdlib.h>
29 #include "error.h"
30 #include "getline.h"
31 #include "julcal/julcal.h"
32 #include "lexer.h"
33 #include "magic.h"
34 #include "misc.h"
35 #include "settings.h"
36 #include "str.h"
37 #include "var.h"
38 \f
39 #include "debug-print.h"
40
41 \f
42 /* Specialized error routine. */
43
44 static void dls_error (const struct data_in *, const char *format, ...)
45      PRINTF_FORMAT (2, 3);
46
47 static void
48 dls_error (const struct data_in *i, const char *format, ...)
49 {
50   char buf[1024];
51
52   if (i->flags & DI_IGNORE_ERROR)
53     return;
54
55   {
56     va_list args;
57
58     va_start (args, format);
59     snprintf (buf, 1024, format, args);
60     va_end (args);
61   }
62   
63   {
64     struct error e;
65     struct string title;
66
67     ds_init (&title, 64);
68     if (!getl_reading_script)
69       ds_puts (&title, _("data-file error: "));
70     if (i->f1 == i->f2)
71       ds_printf (&title, _("(column %d"), i->f1);
72     else
73       ds_printf (&title, _("(columns %d-%d"), i->f1, i->f2);
74     ds_printf (&title, _(", field type %s) "), fmt_to_string (&i->format));
75     
76     e.class = DE;
77     err_location (&e.where);
78     e.title = ds_c_str (&title);
79     e.text = buf;
80
81     err_vmsg (&e);
82
83     ds_destroy (&title);
84   }
85 }
86
87 /* Excludes leading and trailing whitespace from I by adjusting
88    pointers. */
89 static void
90 trim_whitespace (struct data_in *i)
91 {
92   while (i->s < i->e && isspace (i->s[0])) 
93     i->s++;
94
95   while (i->s < i->e && isspace (i->e[-1]))
96     i->e--;
97 }
98
99 /* Returns nonzero if we're not at the end of the string being
100    parsed. */
101 static inline int
102 have_char (struct data_in *i)
103 {
104   return i->s < i->e;
105 }
106 \f
107 /* Format parsers. */ 
108
109 static int parse_int (struct data_in *i, long *result);
110
111 /* This function is based on strtod() from the GNU C library. */
112 static int
113 parse_numeric (struct data_in *i)
114 {
115   short int sign;               /* +1 or -1. */
116   double num;                   /* The number so far.  */
117
118   int got_dot;                  /* Found a decimal point.  */
119   int got_digit;                /* Count of digits.  */
120
121   int decimal;                  /* Decimal point character. */
122   int grouping;                 /* Grouping character. */
123
124   long int exponent;            /* Number's exponent. */
125   int type;                     /* Usually same as i->format.type. */
126
127   trim_whitespace (i);
128
129   type = i->format.type;
130   if (type == FMT_DOLLAR && have_char (i) && *i->s == '$')
131     {
132       i->s++;
133       type = FMT_COMMA;
134     }
135
136   /* Get the sign.  */
137   if (have_char (i))
138     {
139       sign = *i->s == '-' ? -1 : 1;
140       if (*i->s == '-' || *i->s == '+')
141         i->s++;
142     }
143   else
144     sign = 1;
145   
146   if (type != FMT_DOT)
147     {
148       decimal = get_decimal();
149       grouping = get_grouping();
150     }
151   else
152     {
153       decimal = get_grouping();
154       grouping = get_decimal();
155     }
156
157   i->v->f = SYSMIS;
158   num = 0.0;
159   got_dot = 0;
160   got_digit = 0;
161   exponent = 0;
162   for (; have_char (i); i->s++)
163     {
164       if (isdigit (*i->s))
165         {
166           got_digit++;
167
168           /* Make sure that multiplication by 10 will not overflow.  */
169           if (num > DBL_MAX * 0.1)
170             /* The value of the digit doesn't matter, since we have already
171                gotten as many digits as can be represented in a `double'.
172                This doesn't necessarily mean the result will overflow.
173                The exponent may reduce it to within range.
174
175                We just need to record that there was another
176                digit so that we can multiply by 10 later.  */
177             ++exponent;
178           else
179             num = (num * 10.0) + (*i->s - '0');
180
181           /* Keep track of the number of digits after the decimal point.
182              If we just divided by 10 here, we would lose precision.  */
183           if (got_dot)
184             --exponent;
185         }
186       else if (!got_dot && *i->s == decimal)
187         /* Record that we have found the decimal point.  */
188         got_dot = 1;
189       else if ((type != FMT_COMMA && type != FMT_DOT) || *i->s != grouping)
190         /* Any other character terminates the number.  */
191         break;
192     }
193
194   if (!got_digit)
195     {
196       if (got_dot)
197         {
198           i->v->f = SYSMIS;
199           return 1;
200         }
201       goto noconv;
202     }
203   
204   if (have_char (i)
205       && (tolower (*i->s) == 'e' || tolower (*i->s) == 'd'
206           || (type == FMT_E && (*i->s == '+' || *i->s == '-'))))
207     {
208       /* Get the exponent specified after the `e' or `E'.  */
209       long exp;
210
211       if (isalpha (*i->s))
212         i->s++;
213       if (!parse_int (i, &exp))
214         goto noconv;
215
216       exponent += exp;
217     }
218   else if (!got_dot)
219     exponent -= i->format.d;
220
221   if (type == FMT_PCT && have_char (i) && *i->s == '%')
222     i->s++;
223   if (i->s < i->e)
224     {
225       dls_error (i, _("Field contents followed by garbage."));
226       i->v->f = SYSMIS;
227       return 0;
228     }
229
230   if (num == 0.0)
231     {
232       i->v->f = 0.0;
233       return 1;
234     }
235
236   /* Multiply NUM by 10 to the EXPONENT power, checking for overflow
237      and underflow.  */
238
239   if (exponent < 0)
240     {
241       if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
242           || num < DBL_MIN * pow (10.0, (double) -exponent))
243         goto underflow;
244       num *= pow (10.0, (double) exponent);
245     }
246   else if (exponent > 0)
247     {
248       if (num > DBL_MAX * pow (10.0, (double) -exponent))
249         goto overflow;
250       num *= pow (10.0, (double) exponent);
251     }
252
253   i->v->f = sign * num;
254   return 1;
255
256 overflow:
257   /* Return an overflow error.  */
258   dls_error (i, _("Overflow in floating-point constant."));
259   i->v->f = SYSMIS;
260   return 0;
261
262 underflow:
263   /* Return an underflow error.  */
264   dls_error (i, _("Underflow in floating-point constant."));
265   i->v->f = 0.0;
266   return 0;
267
268 noconv:
269   /* There was no number.  */
270   dls_error (i, _("Field does not form a valid floating-point constant."));
271   i->v->f = SYSMIS;
272   return 0;
273 }
274
275 /* Returns the integer value of hex digit C. */
276 static inline int
277 hexit_value (int c)
278 {
279   const char s[] = "0123456789abcdef";
280   const char *cp = strchr (s, tolower ((unsigned char) c));
281
282   assert (cp != NULL);
283   return cp - s;
284 }
285
286 static inline int
287 parse_N (struct data_in *i)
288 {
289   const unsigned char *cp;
290
291   i->v->f = 0;
292   for (cp = i->s; cp < i->e; cp++)
293     {
294       if (!isdigit (*cp))
295         {
296           dls_error (i, _("All characters in field must be digits."));
297           return 0;
298         }
299
300       i->v->f = i->v->f * 10.0 + *cp - '0';
301     }
302
303   if (i->format.d)
304     i->v->f /= pow (10.0, i->format.d);
305   return 1;
306 }
307
308 static inline int
309 parse_PIBHEX (struct data_in *i)
310 {
311   double n;
312   const unsigned char *cp;
313
314   trim_whitespace (i);
315
316   n = 0.0;
317   for (cp = i->s; cp < i->e; cp++)
318     {
319       if (!isxdigit (*cp))
320         {
321           dls_error (i, _("Unrecognized character in field."));
322           return 0;
323         }
324
325       n = n * 16.0 + hexit_value (*cp);
326     }
327   
328   i->v->f = n;
329   return 1;
330 }
331
332 static inline int
333 parse_RBHEX (struct data_in *i)
334 {
335   /* Validate input. */
336   trim_whitespace (i);
337   if ((i->e - i->s) % 2)
338     {
339       dls_error (i, _("Field must have even length."));
340       return 0;
341     }
342   
343   {
344     const unsigned char *cp;
345     
346     for (cp = i->s; cp < i->e; cp++)
347       if (!isxdigit (*cp))
348         {
349           dls_error (i, _("Field must contain only hex digits."));
350           return 0;
351         }
352   }
353   
354   /* Parse input. */
355   {
356     union
357       {
358         double d;
359         unsigned char c[sizeof (double)];
360       }
361     u;
362
363     int j;
364
365     memset (u.c, 0, sizeof u.c);
366     for (j = 0; j < min ((i->e - i->s) / 2, sizeof u.d); j++)
367       u.c[j] = 16 * hexit_value (i->s[j * 2]) + hexit_value (i->s[j * 2 + 1]);
368
369     i->v->f = u.d;
370   }
371   
372   return 1;
373 }
374
375 static inline int
376 parse_Z (struct data_in *i)
377 {
378   char buf[64];
379
380   /* Warn user that we suck. */
381   {
382     static int warned;
383
384     if (!warned)
385       {
386         msg (MW, 
387              _("Quality of zoned decimal (Z) input format code is "
388                "suspect.  Check your results three times. Report bugs "
389                 "to %s."),PACKAGE_BUGREPORT);
390         warned = 1;
391       }
392   }
393
394   /* Validate input. */
395   trim_whitespace (i);
396
397   if (i->e - i->s < 2)
398     {
399       dls_error (i, _("Zoned decimal field contains fewer than 2 "
400                       "characters."));
401       return 0;
402     }
403
404   /* Copy sign into buf[0]. */
405   if ((i->e[-1] & 0xc0) != 0xc0)
406     {
407       dls_error (i, _("Bad sign byte in zoned decimal number."));
408       return 0;
409     }
410   buf[0] = (i->e[-1] ^ (i->e[-1] >> 1)) & 0x10 ? '-' : '+';
411
412   /* Copy digits into buf[1 ... len - 1] and terminate string. */
413   {
414     const unsigned char *sp;
415     char *dp;
416
417     for (sp = i->s, dp = buf + 1; sp < i->e - 1; sp++, dp++)
418       if (*sp == '.')
419         *dp = '.';
420       else if ((*sp & 0xf0) == 0xf0 && (*sp & 0xf) < 10)
421         *dp = (*sp & 0xf) + '0';
422       else
423         {
424           dls_error (i, _("Format error in zoned decimal number."));
425           return 0;
426         }
427
428     *dp = '\0';
429   }
430
431   /* Parse as number. */
432   {
433     char *tail;
434     
435     i->v->f = strtod ((char *) buf, (char **) &tail);
436     if ((unsigned char *) tail != i->e)
437       {
438         dls_error (i, _("Error in syntax of zoned decimal number."));
439         return 0;
440       }
441   }
442   
443   return 1;
444 }
445
446 static inline int
447 parse_IB (struct data_in *i)
448 {
449   char buf[64];
450   const char *p;
451
452   unsigned char xor;
453
454   /* We want the data to be in big-endian format.  If this is a
455      little-endian machine, reverse the byte order. */
456 #ifdef WORDS_BIGENDIAN
457   p = i->s;
458 #else
459   memcpy (buf, i->s, i->e - i->s);
460   mm_reverse (buf, i->e - i->s);
461   p = buf;
462 #endif
463
464   /* If the value is negative, we need to logical-NOT each value
465      before adding it. */
466   if (p[0] & 0x80)
467     xor = 0xff;
468   else
469     xor = 0x00;
470   
471   {
472     int j;
473
474     i->v->f = 0.0;
475     for (j = 0; j < i->e - i->s; j++)
476       i->v->f = i->v->f * 256.0 + (p[j] ^ xor);
477   }
478
479   /* If the value is negative, add 1 and set the sign, to complete a
480      two's-complement negation. */
481   if (p[0] & 0x80)
482     i->v->f = -(i->v->f + 1.0);
483
484   if (i->format.d)
485     i->v->f /= pow (10.0, i->format.d);
486
487   return 1;
488 }
489
490 static inline int
491 parse_PIB (struct data_in *i)
492 {
493   int j;
494
495   i->v->f = 0.0;
496 #if WORDS_BIGENDIAN
497   for (j = 0; j < i->e - i->s; j++)
498     i->v->f = i->v->f * 256.0 + i->s[j];
499 #else
500   for (j = i->e - i->s - 1; j >= 0; j--)
501     i->v->f = i->v->f * 256.0 + i->s[j];
502 #endif
503
504   if (i->format.d)
505     i->v->f /= pow (10.0, i->format.d);
506
507   return 1;
508 }
509
510 static inline int
511 parse_P (struct data_in *i)
512 {
513   const unsigned char *cp;
514
515   i->v->f = 0.0;
516   for (cp = i->s; cp < i->e - 1; cp++)
517     {
518       i->v->f = i->v->f * 10 + (*cp >> 4);
519       i->v->f = i->v->f * 10 + (*cp & 15);
520     }
521   i->v->f = i->v->f * 10 + (*cp >> 4);
522   if ((*cp ^ (*cp >> 1)) & 0x10)
523       i->v->f = -i->v->f;
524
525   if (i->format.d)
526     i->v->f /= pow (10.0, i->format.d);
527
528   return 1;
529 }
530
531 static inline int
532 parse_PK (struct data_in *i)
533 {
534   const unsigned char *cp;
535
536   i->v->f = 0.0;
537   for (cp = i->s; cp < i->e; cp++)
538     {
539       i->v->f = i->v->f * 10 + (*cp >> 4);
540       i->v->f = i->v->f * 10 + (*cp & 15);
541     }
542
543   if (i->format.d)
544     i->v->f /= pow (10.0, i->format.d);
545
546   return 1;
547 }
548
549 static inline int
550 parse_RB (struct data_in *i)
551 {
552   union
553     {
554       double d;
555       unsigned char c[sizeof (double)];
556     }
557   u;
558
559   memset (u.c, 0, sizeof u.c);
560   memcpy (u.c, i->s, min ((int) sizeof (u.c), i->e - i->s));
561   i->v->f = u.d;
562
563   return 1;
564 }
565
566 static inline int
567 parse_A (struct data_in *i)
568 {
569   ptrdiff_t len = i->e - i->s;
570   
571   if (len >= i->format.w)
572     memcpy (i->v->s, i->s, i->format.w);
573   else
574     {
575       memcpy (i->v->s, i->s, len);
576       memset (i->v->s + len, ' ', i->format.w - len);
577     }
578
579   return 1;
580 }
581
582 static inline int
583 parse_AHEX (struct data_in *i)
584 {
585   /* Validate input. */
586   trim_whitespace (i);
587   if ((i->e - i->s) % 2)
588     {
589       dls_error (i, _("Field must have even length."));
590       return 0;
591     }
592
593   {
594     const unsigned char *cp;
595     
596     for (cp = i->s; cp < i->e; cp++)
597       if (!isxdigit (*cp))
598         {
599           dls_error (i, _("Field must contain only hex digits."));
600           return 0;
601         }
602   }
603   
604   {
605     int j;
606     
607     /* Parse input. */
608     for (j = 0; j < min (i->e - i->s, i->format.w); j += 2)
609       i->v->s[j / 2] = hexit_value (i->s[j]) * 16 + hexit_value (i->s[j + 1]);
610     memset (i->v->s + (i->e - i->s) / 2, ' ', (i->format.w - (i->e - i->s)) / 2);
611   }
612   
613   return 1;
614 }
615 \f
616 /* Date & time format components. */
617
618 /* Advances *CP past any whitespace characters. */
619 static inline void
620 skip_whitespace (struct data_in *i)
621 {
622   while (isspace ((unsigned char) *i->s))
623     i->s++;
624 }
625
626 static inline int
627 parse_leader (struct data_in *i)
628 {
629   skip_whitespace (i);
630   return 1;
631 }
632
633 static inline int
634 force_have_char (struct data_in *i)
635 {
636   if (have_char (i))
637     return 1;
638
639   dls_error (i, _("Unexpected end of field."));
640   return 0;
641 }
642
643 static int
644 parse_int (struct data_in *i, long *result)
645 {
646   int negative = 0;
647   
648   if (!force_have_char (i))
649     return 0;
650
651   if (*i->s == '+')
652     {
653       i->s++;
654       force_have_char (i);
655     }
656   else if (*i->s == '-')
657     {
658       negative = 1;
659       i->s++;
660       force_have_char (i);
661     }
662   
663   if (!isdigit (*i->s))
664     {
665       dls_error (i, _("Digit expected in field."));
666       return 0;
667     }
668
669   *result = 0;
670   for (;;)
671     {
672       *result = *result * 10 + *i->s++ - '0';
673       if (!have_char (i) || !isdigit (*i->s))
674         break;
675     }
676
677   if (negative)
678     *result = -*result;
679   return 1;
680 }
681
682 static int
683 parse_day (struct data_in *i, long *day)
684 {
685   if (!parse_int (i, day))
686     return 0;
687   if (*day >= 1 && *day <= 31)
688     return 1;
689
690   dls_error (i, _("Day (%ld) must be between 1 and 31."), *day);
691   return 0;
692 }
693
694 static int
695 parse_day_count (struct data_in *i, long *day_count)
696 {
697   return parse_int (i, day_count);
698 }
699
700 static int
701 parse_date_delimiter (struct data_in *i)
702 {
703   int delim = 0;
704
705   while (have_char (i)
706          && (*i->s == '-' || *i->s == '/' || isspace (*i->s)
707              || *i->s == '.' || *i->s == ','))
708     {
709       delim = 1;
710       i->s++;
711     }
712   if (delim)
713     return 1;
714
715   dls_error (i, _("Delimiter expected between fields in date."));
716   return 0;
717 }
718
719 /* Formats NUMBER as Roman numerals in ROMAN, or as Arabic numerals if
720    the Roman expansion would be too long. */
721 static void
722 to_roman (int number, char roman[32])
723 {
724   int save_number = number;
725
726   struct roman_digit
727     {
728       int value;                /* Value corresponding to this digit. */
729       char name;                /* Digit name. */
730     };
731
732   static const struct roman_digit roman_tab[7] =
733   {
734     {1000, 'M'},
735     {500, 'D'},
736     {100, 'C'},
737     {50, 'L'},
738     {10, 'X'},
739     {5, 'V'},
740     {1, 'I'},
741   };
742
743   char *cp = roman;
744
745   int i, j;
746
747   assert (32 >= INT_DIGITS + 1);
748   if (number == 0)
749     goto arabic;
750
751   if (number < 0)
752     {
753       *cp++ = '-';
754       number = -number;
755     }
756
757   for (i = 0; i < 7; i++)
758     {
759       int digit = roman_tab[i].value;
760       while (number >= digit)
761         {
762           number -= digit;
763           if (cp > &roman[30])
764             goto arabic;
765           *cp++ = roman_tab[i].name;
766         }
767
768       for (j = i + 1; j < 7; j++)
769         {
770           if (i == 4 && j == 5) /* VX is not a shortened form of V. */
771             break;
772
773           digit = roman_tab[i].value - roman_tab[j].value;
774           while (number >= digit)
775             {
776               number -= digit;
777               if (cp > &roman[29])
778                 goto arabic;
779               *cp++ = roman_tab[j].name;
780               *cp++ = roman_tab[i].name;
781             }
782         }
783     }
784   *cp = 0;
785   return;
786
787 arabic:
788   sprintf (roman, "%d", save_number);
789 }
790
791 /* Returns true if C is a (lowercase) roman numeral. */
792 #define CHAR_IS_ROMAN(C)                                \
793         ((C) == 'x' || (C) == 'v' || (C) == 'i')
794
795 /* Returns the value of a single (lowercase) roman numeral. */
796 #define ROMAN_VALUE(C)                          \
797         ((C) == 'x' ? 10 : ((C) == 'v' ? 5 : 1))
798
799 static int
800 parse_month (struct data_in *i, long *month)
801 {
802   if (!force_have_char (i))
803     return 0;
804   
805   if (isdigit (*i->s))
806     {
807       if (!parse_int (i, month))
808         return 0;
809       if (*month >= 1 && *month <= 12)
810         return 1;
811       
812       dls_error (i, _("Month (%ld) must be between 1 and 12."), *month);
813       return 0;
814     }
815
816   if (CHAR_IS_ROMAN (tolower (*i->s)))
817     {
818       int last = ROMAN_VALUE (tolower (*i->s));
819
820       *month = 0;
821       for (;;)
822         {
823           int value;
824
825           i->s++;
826           if (!have_char || !CHAR_IS_ROMAN (tolower (*i->s)))
827             {
828               if (last != INT_MAX)
829                 *month += last;
830               break;
831             }
832
833           value = ROMAN_VALUE (tolower (*i->s));
834           if (last == INT_MAX)
835             *month += value;
836           else if (value > last)
837             {
838               *month += value - last;
839               last = INT_MAX;
840             }
841           else
842             {
843               *month += last;
844               last = value;
845             }
846         }
847
848       if (*month < 1 || *month > 12)
849         {
850           char buf[32];
851
852           to_roman (*month, buf);
853           dls_error (i, _("Month (%s) must be between I and XII."), buf);
854           return 0;
855         }
856       
857       return 1;
858     }
859   
860   {
861     static const char *months[12] =
862       {
863         "january", "february", "march", "april", "may", "june",
864         "july", "august", "september", "october", "november", "december",
865       };
866
867     char month_buf[32];
868     char *mp;
869
870     int j;
871
872     for (mp = month_buf;
873          have_char (i) && isalpha (*i->s) && mp < &month_buf[31];
874          i->s++)
875       *mp++ = tolower (*i->s);
876     *mp = '\0';
877
878     if (have_char (i) && isalpha (*i->s))
879       {
880         dls_error (i, _("Month name (%s...) is too long."), month_buf);
881         return 0;
882       }
883
884     for (j = 0; j < 12; j++)
885       if (lex_id_match (months[j], month_buf))
886         {
887           *month = j + 1;
888           return 1;
889         }
890
891     dls_error (i, _("Bad month name (%s)."), month_buf);
892     return 0;
893   }
894 }
895
896 static int
897 parse_year (struct data_in *i, long *year)
898 {
899   if (!parse_int (i, year))
900     return 0;
901   
902   if (*year >= 0 && *year <= 199)
903     *year += 1900;
904   if (*year >= 1582 || *year <= 19999)
905     return 1;
906
907   dls_error (i, _("Year (%ld) must be between 1582 and 19999."), *year);
908   return 0;
909 }
910
911 static int
912 parse_trailer (struct data_in *i)
913 {
914   skip_whitespace (i);
915   if (!have_char (i))
916     return 1;
917   
918   dls_error (i, _("Trailing garbage \"%s\" following date."), i->s);
919   return 0;
920 }
921
922 static int
923 parse_julian (struct data_in *i, long *julian)
924 {
925   if (!parse_int (i, julian))
926     return 0;
927    
928   {
929     int day = *julian % 1000;
930
931     if (day < 1 || day > 366)
932       {
933         dls_error (i, _("Julian day (%d) must be between 1 and 366."), day);
934         return 0;
935       }
936   }
937   
938   {
939     int year = *julian / 1000;
940
941     if (year >= 0 && year <= 199)
942       *julian += 1900000L;
943     else if (year < 1582 || year > 19999)
944       {
945         dls_error (i, _("Year (%d) must be between 1582 and 19999."), year);
946         return 0;
947       }
948   }
949
950   return 1;
951 }
952
953 static int
954 parse_quarter (struct data_in *i, long *quarter)
955 {
956   if (!parse_int (i, quarter))
957     return 0;
958   if (*quarter >= 1 && *quarter <= 4)
959     return 1;
960
961   dls_error (i, _("Quarter (%ld) must be between 1 and 4."), *quarter);
962   return 0;
963 }
964
965 static int
966 parse_q_delimiter (struct data_in *i)
967 {
968   skip_whitespace (i);
969   if (!have_char (i) || tolower (*i->s) != 'q')
970     {
971       dls_error (i, _("`Q' expected between quarter and year."));
972       return 0;
973     }
974   i->s++;
975   skip_whitespace (i);
976   return 1;
977 }
978
979 static int
980 parse_week (struct data_in *i, long *week)
981 {
982   if (!parse_int (i, week))
983     return 0;
984   if (*week >= 1 && *week <= 53)
985     return 1;
986
987   dls_error (i, _("Week (%ld) must be between 1 and 53."), *week);
988   return 0;
989 }
990
991 static int
992 parse_wk_delimiter (struct data_in *i)
993 {
994   skip_whitespace (i);
995   if (i->s + 1 >= i->e
996       || tolower (i->s[0]) != 'w' || tolower (i->s[1]) != 'k')
997     {
998       dls_error (i, _("`WK' expected between week and year."));
999       return 0;
1000     }
1001   i->s += 2;
1002   skip_whitespace (i);
1003   return 1;
1004 }
1005
1006 static int
1007 parse_time_delimiter (struct data_in *i)
1008 {
1009   int delim = 0;
1010
1011   while (have_char (i)
1012          && (*i->s == ':' || *i->s == '.' || isspace (*i->s)))
1013     {
1014       delim = 1;
1015       i->s++;
1016     }
1017
1018   if (delim)
1019     return 1;
1020   
1021   dls_error (i, _("Delimiter expected between fields in time."));
1022   return 0;
1023 }
1024
1025 static int
1026 parse_hour (struct data_in *i, long *hour)
1027 {
1028   if (!parse_int (i, hour))
1029     return 0;
1030   if (*hour >= 0)
1031     return 1;
1032   
1033   dls_error (i, _("Hour (%ld) must be positive."), *hour);
1034   return 0;
1035 }
1036
1037 static int
1038 parse_minute (struct data_in *i, long *minute)
1039 {
1040   if (!parse_int (i, minute))
1041     return 0;
1042   if (*minute >= 0 && *minute <= 59)
1043     return 1;
1044   
1045   dls_error (i, _("Minute (%ld) must be between 0 and 59."), *minute);
1046   return 0;
1047 }
1048
1049 static int
1050 parse_opt_second (struct data_in *i, double *second)
1051 {
1052   int delim = 0;
1053
1054   char buf[64];
1055   char *cp;
1056
1057   while (have_char (i)
1058          && (*i->s == ':' || *i->s == '.' || isspace (*i->s)))
1059     {
1060       delim = 1;
1061       i->s++;
1062     }
1063   
1064   if (!delim || !isdigit (*i->s))
1065     {
1066       *second = 0.0;
1067       return 1;
1068     }
1069
1070   cp = buf;
1071   while (have_char (i) && isdigit (*i->s))
1072     *cp++ = *i->s++;
1073   if (have_char (i) && *i->s == '.')
1074     *cp++ = *i->s++;
1075   while (have_char (i) && isdigit (*i->s))
1076     *cp++ = *i->s++;
1077   *cp = '\0';
1078   
1079   *second = strtod (buf, NULL);
1080
1081   return 1;
1082 }
1083
1084 static int
1085 parse_hour24 (struct data_in *i, long *hour24)
1086 {
1087   if (!parse_int (i, hour24))
1088     return 0;
1089   if (*hour24 >= 0 && *hour24 <= 23)
1090     return 1;
1091   
1092   dls_error (i, _("Hour (%ld) must be between 0 and 23."), *hour24);
1093   return 0;
1094 }
1095
1096      
1097 static int
1098 parse_weekday (struct data_in *i, int *weekday)
1099 {
1100   /* PORTME */
1101   #define TUPLE(A,B)                            \
1102           (((A) << 8) + (B))
1103
1104   if (i->s + 1 >= i->e)
1105     {
1106       dls_error (i, _("Day of the week expected in date value."));
1107       return 0;
1108     }
1109
1110   switch (TUPLE (tolower (i->s[0]), tolower (i->s[1])))
1111     {
1112     case TUPLE ('s', 'u'):
1113       *weekday = 1;
1114       break;
1115
1116     case TUPLE ('m', 'o'):
1117       *weekday = 2;
1118       break;
1119
1120     case TUPLE ('t', 'u'):
1121       *weekday = 3;
1122       break;
1123
1124     case TUPLE ('w', 'e'):
1125       *weekday = 4;
1126       break;
1127
1128     case TUPLE ('t', 'h'):
1129       *weekday = 5;
1130       break;
1131
1132     case TUPLE ('f', 'r'):
1133       *weekday = 6;
1134       break;
1135
1136     case TUPLE ('s', 'a'):
1137       *weekday = 7;
1138       break;
1139
1140     default:
1141       dls_error (i, _("Day of the week expected in date value."));
1142       return 0;
1143     }
1144
1145   while (have_char (i) && isalpha (*i->s))
1146     i->s++;
1147
1148   return 1;
1149
1150   #undef TUPLE
1151 }
1152
1153 static int
1154 parse_spaces (struct data_in *i)
1155 {
1156   skip_whitespace (i);
1157   return 1;
1158 }
1159
1160 static int
1161 parse_sign (struct data_in *i, int *sign)
1162 {
1163   if (!force_have_char (i))
1164     return 0;
1165
1166   switch (*i->s)
1167     {
1168     case '-':
1169       i->s++;
1170       *sign = 1;
1171       break;
1172
1173     case '+':
1174       i->s++;
1175       /* fall through */
1176
1177     default:
1178       *sign = 0;
1179       break;
1180     }
1181
1182   return 1;
1183 }
1184 \f
1185 /* Date & time formats. */
1186
1187 static int
1188 valid_date (struct data_in *i)
1189 {
1190   if (i->v->f == SYSMIS)
1191     {
1192       dls_error (i, _("Date is not in valid range between "
1193                    "15 Oct 1582 and 31 Dec 19999."));
1194       return 0;
1195     }
1196   else
1197     return 1;
1198 }
1199
1200 static int
1201 parse_DATE (struct data_in *i)
1202 {
1203   long day, month, year;
1204
1205   if (!parse_leader (i)
1206       || !parse_day (i, &day)
1207       || !parse_date_delimiter (i)
1208       || !parse_month (i, &month)
1209       || !parse_date_delimiter (i)
1210       || !parse_year (i, &year)
1211       || !parse_trailer (i))
1212     return 0;
1213
1214   i->v->f = calendar_to_julian (year, month, day);
1215   if (!valid_date (i))
1216     return 0;
1217   i->v->f *= 60. * 60. * 24.;
1218
1219   return 1;
1220 }
1221
1222 static int
1223 parse_ADATE (struct data_in *i)
1224 {
1225   long month, day, year;
1226
1227   if (!parse_leader (i)
1228       || !parse_month (i, &month)
1229       || !parse_date_delimiter (i)
1230       || !parse_day (i, &day)
1231       || !parse_date_delimiter (i)
1232       || !parse_year (i, &year)
1233       || !parse_trailer (i))
1234     return 0;
1235
1236   i->v->f = calendar_to_julian (year, month, day);
1237   if (!valid_date (i))
1238     return 0;
1239   i->v->f *= 60. * 60. * 24.;
1240
1241   return 1;
1242 }
1243
1244 static int
1245 parse_EDATE (struct data_in *i)
1246 {
1247   long month, day, year;
1248
1249   if (!parse_leader (i)
1250       || !parse_day (i, &day)
1251       || !parse_date_delimiter (i)
1252       || !parse_month (i, &month)
1253       || !parse_date_delimiter (i)
1254       || !parse_year (i, &year)
1255       || !parse_trailer (i))
1256     return 0;
1257
1258   i->v->f = calendar_to_julian (year, month, day);
1259   if (!valid_date (i))
1260     return 0;
1261   i->v->f *= 60. * 60. * 24.;
1262
1263   return 1;
1264 }
1265
1266 static int
1267 parse_SDATE (struct data_in *i)
1268 {
1269   long month, day, year;
1270
1271   if (!parse_leader (i)
1272       || !parse_year (i, &year)
1273       || !parse_date_delimiter (i)
1274       || !parse_month (i, &month)
1275       || !parse_date_delimiter (i)
1276       || !parse_day (i, &day)
1277       || !parse_trailer (i))
1278     return 0;
1279
1280   i->v->f = calendar_to_julian (year, month, day);
1281   if (!valid_date (i))
1282     return 0;
1283   i->v->f *= 60. * 60. * 24.;
1284
1285   return 1;
1286 }
1287
1288 static int
1289 parse_JDATE (struct data_in *i)
1290 {
1291   long julian;
1292   
1293   if (!parse_leader (i)
1294       || !parse_julian (i, &julian)
1295       || !parse_trailer (i))
1296     return 0;
1297
1298   if (julian / 1000 == 1582)
1299     i->v->f = calendar_to_julian (1583, 1, 1) - 365;
1300   else
1301     i->v->f = calendar_to_julian (julian / 1000, 1, 1);
1302
1303   if (valid_date (i))
1304     {
1305       i->v->f = (i->v->f + julian % 1000 - 1) * 60. * 60. * 24.;
1306       if (i->v->f < 0.)
1307         i->v->f = SYSMIS;
1308     }
1309
1310   return valid_date (i);
1311 }
1312
1313 static int
1314 parse_QYR (struct data_in *i)
1315 {
1316   long quarter, year;
1317
1318   if (!parse_leader (i)
1319       || !parse_quarter (i, &quarter)
1320       || !parse_q_delimiter (i)
1321       || !parse_year (i, &year)
1322       || !parse_trailer (i))
1323     return 0;
1324
1325   i->v->f = calendar_to_julian (year, (quarter - 1) * 3 + 1, 1);
1326   if (!valid_date (i))
1327     return 0;
1328   i->v->f *= 60. * 60. * 24.;
1329
1330   return 1;
1331 }
1332
1333 static int
1334 parse_MOYR (struct data_in *i)
1335 {
1336   long month, year;
1337
1338   if (!parse_leader (i)
1339       || !parse_month (i, &month)
1340       || !parse_date_delimiter (i)
1341       || !parse_year (i, &year)
1342       || !parse_trailer (i))
1343     return 0;
1344
1345   i->v->f = calendar_to_julian (year, month, 1);
1346   if (!valid_date (i))
1347     return 0;
1348   i->v->f *= 60. * 60. * 24.;
1349
1350   return 1;
1351 }
1352
1353 static int
1354 parse_WKYR (struct data_in *i)
1355 {
1356   long week, year;
1357
1358   if (!parse_leader (i)
1359       || !parse_week (i, &week)
1360       || !parse_wk_delimiter (i)
1361       || !parse_year (i, &year)
1362       || !parse_trailer (i))
1363     return 0;
1364
1365   i->v->f = calendar_to_julian (year, 1, 1);
1366   if (!valid_date (i))
1367     return 0;
1368   i->v->f = (i->v->f + (week - 1) * 7) * 60. * 60. * 24.;
1369
1370   return 1;
1371 }
1372
1373 static int
1374 parse_TIME (struct data_in *i)
1375 {
1376   int sign;
1377   double second;
1378   long hour, minute;
1379
1380   if (!parse_leader (i)
1381       || !parse_sign (i, &sign)
1382       || !parse_spaces (i)
1383       || !parse_hour (i, &hour)
1384       || !parse_time_delimiter (i)
1385       || !parse_minute (i, &minute)
1386       || !parse_opt_second (i, &second))
1387     return 0;
1388
1389   i->v->f = hour * 60. * 60. + minute * 60. + second;
1390   if (sign)
1391     i->v->f = -i->v->f;
1392   return 1;
1393 }
1394
1395 static int
1396 parse_DTIME (struct data_in *i)
1397 {
1398   int sign;
1399   long day_count, hour;
1400   double second;
1401   long minute;
1402
1403   if (!parse_leader (i)
1404       || !parse_sign (i, &sign)
1405       || !parse_spaces (i)
1406       || !parse_day_count (i, &day_count)
1407       || !parse_time_delimiter (i)
1408       || !parse_hour (i, &hour)
1409       || !parse_time_delimiter (i)
1410       || !parse_minute (i, &minute)
1411       || !parse_opt_second (i, &second))
1412     return 0;
1413
1414   i->v->f = (day_count * 60. * 60. * 24.
1415              + hour * 60. * 60.
1416              + minute * 60.
1417              + second);
1418   if (sign)
1419     i->v->f = -i->v->f;
1420   return 1;
1421 }
1422
1423 static int
1424 parse_DATETIME (struct data_in *i)
1425 {
1426   long day, month, year;
1427   long hour24;
1428   double second;
1429   long minute;
1430
1431   if (!parse_leader (i)
1432       || !parse_day (i, &day)
1433       || !parse_date_delimiter (i)
1434       || !parse_month (i, &month)
1435       || !parse_date_delimiter (i)
1436       || !parse_year (i, &year)
1437       || !parse_time_delimiter (i)
1438       || !parse_hour24 (i, &hour24)
1439       || !parse_time_delimiter (i)
1440       || !parse_minute (i, &minute)
1441       || !parse_opt_second (i, &second))
1442     return 0;
1443
1444   i->v->f = calendar_to_julian (year, month, day);
1445   if (!valid_date (i))
1446     return 0;
1447   i->v->f = (i->v->f * 60. * 60. * 24.
1448              + hour24 * 60. * 60.
1449              + minute * 60.
1450              + second);
1451
1452   return 1;
1453 }
1454
1455 static int
1456 parse_WKDAY (struct data_in *i)
1457 {
1458   int weekday;
1459
1460   if (!parse_leader (i)
1461       || !parse_weekday (i, &weekday)
1462       || !parse_trailer (i))
1463     return 0;
1464
1465   i->v->f = weekday;
1466   return 1;
1467 }
1468
1469 static int
1470 parse_MONTH (struct data_in *i)
1471 {
1472   long month;
1473
1474   if (!parse_leader (i)
1475       || !parse_month (i, &month)
1476       || !parse_trailer (i))
1477     return 0;
1478
1479   i->v->f = month;
1480   return 1;
1481 }
1482 \f
1483 /* Main dispatcher. */
1484
1485 static void
1486 default_result (struct data_in *i)
1487 {
1488   const struct fmt_desc *const fmt = &formats[i->format.type];
1489
1490   /* Default to SYSMIS or blanks. */
1491   if (fmt->cat & FCAT_STRING)
1492     memset (i->v->s, ' ', i->format.w);
1493   else
1494     i->v->f = get_blanks();
1495 }
1496
1497 int
1498 data_in (struct data_in *i)
1499 {
1500   const struct fmt_desc *const fmt = &formats[i->format.type];
1501
1502   /* Check that we've got a string to work with. */
1503   if (i->e == i->s || i->format.w <= 0)
1504     {
1505       default_result (i);
1506       return 1;
1507     }
1508
1509   i->f2 = i->f1 + (i->e - i->s) - 1;
1510
1511   /* Make sure that the string isn't too long. */
1512   if (i->format.w > fmt->Imax_w)
1513     {
1514       dls_error (i, _("Field too long (%d characters).  Truncated after "
1515                    "character %d."),
1516                  i->format.w, fmt->Imax_w);
1517       i->format.w = fmt->Imax_w;
1518     }
1519
1520   if (fmt->cat & FCAT_BLANKS_SYSMIS)
1521     {
1522       const unsigned char *cp;
1523
1524       cp = i->s;
1525       for (;;)
1526         {
1527           if (!isspace (*cp))
1528             break;
1529
1530           if (++cp == i->e)
1531             {
1532               i->v->f = get_blanks();
1533               return 1;
1534             }
1535         }
1536     }
1537   
1538   {
1539     static int (*const handlers[FMT_NUMBER_OF_FORMATS])(struct data_in *) = 
1540       {
1541         parse_numeric, parse_N, parse_numeric, parse_numeric,
1542         parse_numeric, parse_numeric, parse_numeric,
1543         parse_Z, parse_A, parse_AHEX, parse_IB, parse_P, parse_PIB,
1544         parse_PIBHEX, parse_PK, parse_RB, parse_RBHEX,
1545         NULL, NULL, NULL, NULL, NULL,
1546         parse_DATE, parse_EDATE, parse_SDATE, parse_ADATE, parse_JDATE,
1547         parse_QYR, parse_MOYR, parse_WKYR,
1548         parse_DATETIME, parse_TIME, parse_DTIME,
1549         parse_WKDAY, parse_MONTH,
1550       };
1551
1552     int (*handler)(struct data_in *);
1553     int success;
1554
1555     handler = handlers[i->format.type];
1556     assert (handler != NULL);
1557
1558     success = handler (i);
1559     if (!success)
1560       default_result (i);
1561
1562     return success;
1563   }
1564 }
1565 \f
1566 /* Utility function. */
1567
1568 /* Sets DI->{s,e} appropriately given that LINE has length LEN and the
1569    field starts at one-based column FC and ends at one-based column
1570    LC, inclusive. */
1571 void
1572 data_in_finite_line (struct data_in *di, const char *line, size_t len,
1573                      int fc, int lc)
1574 {
1575   di->s = line + ((size_t) fc <= len ? fc - 1 : len);
1576   di->e = line + ((size_t) lc <= len ? lc : len);
1577 }