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