1#!/usr/bin/perl
2
3use warnings;
4use strict;
5use Test::Inter;
6$::ti = new Test::Inter $0;
7require "tests.pl";
8
9$ENV{'TZ'} = 'America/Chicago';
10
11our %obj = ();
12our %dmb = ();
13our %dmt = ();
14
15sub test {
16   my($label,$op,@args)=@_;
17   my $new;
18
19   if ($op eq 'new') {
20      my($type,@a) = @args;
21      if (@a  &&  exists $obj{$a[0]}) {
22         my $o = $obj{$a[0]};
23         shift(@a);
24         unshift(@a,$o);
25      }
26      if ($type eq 'Base') {
27         $new = new Date::Manip::Base @a;
28      } elsif ($type eq 'TZ') {
29         $new = new Date::Manip::TZ @a;
30      } elsif ($type eq 'Date') {
31         $new = new Date::Manip::Date @a;
32      } elsif ($type eq 'Delta') {
33         $new = new Date::Manip::Delta @a;
34      } elsif ($type eq 'Recur') {
35         $new = new Date::Manip::Recur @a;
36      }
37
38   } elsif ($op eq 'new_config') {
39      my $o = $obj{$args[0]};
40      shift(@args);
41      $new  = $o->new_config(@args);
42
43   } elsif ($op eq 'base') {
44      my $o = $obj{$args[0]};
45      shift(@args);
46      $new  = $o->base(@args);
47
48   } elsif ($op eq 'tz') {
49      my $o = $obj{$args[0]};
50      shift(@args);
51      $new  = $o->tz(@args);
52
53   } elsif ($op eq 'config') {
54      my $o = $obj{$args[0]};
55      shift(@args);
56      $o->config(@args);
57      return (0);
58
59   } elsif ($op eq 'get_config') {
60      my $o = $obj{$args[0]};
61      shift(@args);
62      my @ret = $o->get_config(@args);
63      if (@ret > 3) {
64         @ret = @ret[0..2];
65      }
66      return @ret;
67
68   } elsif (exists $obj{$op}) {
69      my $o = $obj{$op};
70      $new = $o->new(@args);
71   }
72
73   if (! defined $new) {
74      return (undef);
75   }
76
77   my($dmb,$dmt);
78   if (ref($new) eq 'Date::Manip::Base') {
79      $dmb = $new;
80      $dmt = '---';
81   } elsif (ref($new) eq 'Date::Manip::TZ') {
82      $dmb = $new->base();
83      $dmt = $new;
84   } else {
85      $dmb = $new->base();
86      $dmt = $new->tz();
87   }
88
89   $obj{$label} = $new;
90   my @ret;
91   @ret = (ref($new));
92
93   if (! exists $dmb{$dmb}) {
94      $dmb{$dmb} = $label;
95   }
96   push(@ret,$dmb{$dmb});
97
98   if ($dmt eq '---') {
99      push(@ret,$dmt);
100   } else {
101      if (! exists $dmt{$dmt}) {
102         $dmt{$dmt} = $label;
103      }
104      push(@ret,$dmt{$dmt});
105   }
106
107   return @ret;
108}
109
110my $tests="
111
112### new CLASS
113
114o0001  new  Base
115   =>
116   Date::Manip::Base
117   o0001
118   ---
119
120o0002  new  TZ
121   =>
122   Date::Manip::TZ
123   o0002
124   o0002
125
126o0003  new  Date
127   =>
128   Date::Manip::Date
129   o0003
130   o0003
131
132o0004  new  Delta
133   =>
134   Date::Manip::Delta
135   o0004
136   o0004
137
138o0005  new  Recur
139   =>
140   Date::Manip::Recur
141   o0005
142   o0005
143
144### OBJ->new
145
146o0006  o0001
147   =>
148   Date::Manip::Base
149   o0006
150   ---
151
152o0007  o0002
153   =>
154   Date::Manip::TZ
155   o0002
156   o0007
157
158o0008  o0003
159   =>
160   Date::Manip::Date
161   o0003
162   o0003
163
164o0009  o0004
165   =>
166   Date::Manip::Delta
167   o0004
168   o0004
169
170o0010  o0005
171   =>
172   Date::Manip::Recur
173   o0005
174   o0005
175
176### new CLASS OBJ
177
178o0011  new  Base  o0001
179   =>
180   Date::Manip::Base
181   o0011
182   ---
183
184o0012  new  Date o0001
185   =>
186   Date::Manip::Date
187   o0001
188   o0012
189
190o0013  new  Date o0002
191   =>
192   Date::Manip::Date
193   o0002
194   o0002
195
196### new_config
197
198o0014  new_config  o0001
199   =>
200   Date::Manip::Base
201   o0014
202   ---
203
204o0015  new_config  o0002
205   =>
206   Date::Manip::TZ
207   o0015
208   o0015
209
210o0016  new_config  o0003
211   =>
212   Date::Manip::Date
213   o0016
214   o0016
215
216o0017  new_config  o0004
217   =>
218   Date::Manip::Delta
219   o0017
220   o0017
221
222o0018  new_config  o0005
223   =>
224   Date::Manip::Recur
225   o0018
226   o0018
227
228o0019  new_config  o0003 now
229   =>
230   Date::Manip::Date
231   o0019
232   o0019
233
234o0020  new_config  o0003 [ forcedate now,America/New_York ]
235   =>
236   Date::Manip::Date
237   o0020
238   o0020
239
240o0021  new_config  o0003 now [ forcedate now,America/New_York ]
241   =>
242   Date::Manip::Date
243   o0021
244   o0021
245
246### base/tz
247
248o0022  base o0001
249   =>
250   __undef__
251
252o0023  base o0002
253   =>
254   Date::Manip::Base
255   o0002
256   ---
257
258o0024  base o0003
259   =>
260   Date::Manip::Base
261   o0003
262   ---
263
264o0022  tz o0001
265   =>
266   __undef__
267
268o0023  tz o0002
269   =>
270   __undef__
271
272o0024  tz o0003
273   =>
274   Date::Manip::TZ
275   o0003
276   o0003
277
278### misc
279
280o0100  new  Date  now noiso8601
281   =>
282   Date::Manip::Date
283   o0100
284   o0100
285
286o0101  new  Date  now [ forcedate now,America/New_York ]
287   =>
288   Date::Manip::Date
289   o0101
290   o0101
291
292o0102  new  Date  now noiso8601 [ forcedate now,America/New_York ]
293   =>
294   Date::Manip::Date
295   o0102
296   o0102
297
298o0103  new  Date  o0102 now noiso8601
299   =>
300   Date::Manip::Date
301   o0102
302   o0102
303
304o0104  new  Date o0102  now [ forcedate now,America/New_York ]
305   =>
306   Date::Manip::Date
307   o0104
308   o0104
309
310o0105  new  Date o0102  now noiso8601 [ forcedate now,America/New_York ]
311   =>
312   Date::Manip::Date
313   o0105
314   o0105
315
316o0106  new  TZ  [ forcedate now,America/New_York ]
317   =>
318   Date::Manip::TZ
319   o0106
320   o0106
321
322o0107  new  TZ o0102  [ forcedate now,America/New_York ]
323   =>
324   Date::Manip::TZ
325   o0107
326   o0107
327
328o0108  new  Date o0101  now noiso8601 [ forcedate now,America/New_York ]
329   =>
330   Date::Manip::Date
331   o0108
332   o0108
333
334o0109  new  Base o0101  [ defaults 1 ]
335   =>
336   Date::Manip::Base
337   o0109
338   ---
339
340### config/get_config
341
342- get_config o0001 yytoyyyy   => 89
343
344- config o0001 yytoyyyy c18   => 0
345
346- get_config o0001 yytoyyyy   => c18
347
348- get_config o0002 yytoyyyy   => 89
349
350- config o0002 yytoyyyy c18   => 0
351
352- get_config o0002 yytoyyyy   => c18
353
354- get_config o0003 yytoyyyy   => 89
355
356- config o0003 yytoyyyy c18   => 0
357
358- get_config o0003 yytoyyyy   => c18
359
360- get_config o0004 yytoyyyy defaulttime => 89 midnight
361
362- get_config o0004            => dateformat defaults defaulttime
363
364";
365
366$::ti->tests(func  => \&test,
367             tests => $tests);
368$::ti->done_testing();
369
370#Local Variables:
371#mode: cperl
372#indent-tabs-mode: nil
373#cperl-indent-level: 3
374#cperl-continued-statement-offset: 2
375#cperl-continued-brace-offset: 0
376#cperl-brace-offset: 0
377#cperl-brace-imaginary-offset: 0
378#cperl-label-offset: 0
379#End:
380