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