File: | obj/gnu/usr.bin/perl/cpan/Time-Piece/Piece.c |
Warning: | line 1401, column 9 Value stored to 'tmp' is never read |
Press '?' to see keyboard shortcuts
Keyboard shortcuts:
1 | /* |
2 | * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the |
3 | * contents of Piece.xs. Do not edit this file, edit Piece.xs instead. |
4 | * |
5 | * ANY CHANGES MADE HERE WILL BE LOST! |
6 | * |
7 | */ |
8 | |
9 | #line 1 "Piece.xs" |
10 | #ifdef __cplusplus |
11 | extern "C" { |
12 | #endif |
13 | #define PERL_NO_GET_CONTEXT |
14 | #include "EXTERN.h" |
15 | #include "perl.h" |
16 | #include "XSUB.h" |
17 | #include <time.h> |
18 | #ifdef __cplusplus |
19 | } |
20 | #endif |
21 | |
22 | |
23 | #define DAYS_PER_YEAR365 365 |
24 | #define DAYS_PER_QYEAR(4*365 +1) (4*DAYS_PER_YEAR365+1) |
25 | #define DAYS_PER_CENT(25*(4*365 +1)-1) (25*DAYS_PER_QYEAR(4*365 +1)-1) |
26 | #define DAYS_PER_QCENT(4*(25*(4*365 +1)-1)+1) (4*DAYS_PER_CENT(25*(4*365 +1)-1)+1) |
27 | #define SECS_PER_HOUR(60*60) (60*60) |
28 | #define SECS_PER_DAY(24*(60*60)) (24*SECS_PER_HOUR(60*60)) |
29 | /* parentheses deliberately absent on these two, otherwise they don't work */ |
30 | #define MONTH_TO_DAYS153/5 153/5 |
31 | #define DAYS_TO_MONTH5/153 5/153 |
32 | /* offset to bias by March (month 4) 1st between month/mday & year finding */ |
33 | #define YEAR_ADJUST(4*153/5 +1) (4*MONTH_TO_DAYS153/5+1) |
34 | /* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */ |
35 | #define WEEKDAY_BIAS6 6 /* (1+6)%7 makes Sunday 0 again */ |
36 | #define TP_BUF_SIZE160 160 |
37 | |
38 | #ifdef WIN32 |
39 | |
40 | /* |
41 | * (1) The CRT maintains its own copy of the environment, separate from |
42 | * the Win32API copy. |
43 | * |
44 | * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this |
45 | * copy, and then calls SetEnvironmentVariableA() to update the Win32API |
46 | * copy. |
47 | * |
48 | * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and |
49 | * SetEnvironmentVariableA() directly, bypassing the CRT copy of the |
50 | * environment. |
51 | * |
52 | * (4) The CRT strftime() "%Z" implementation calls __tzset(). That |
53 | * calls CRT tzset(), but only the first time it is called, and in turn |
54 | * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT |
55 | * local copy of the environment and hence gets the original setting as |
56 | * perl never updates the CRT copy when assigning to $ENV{TZ}. |
57 | * |
58 | * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT |
59 | * putenv() to update the CRT copy of the environment (if it is different) |
60 | * whenever we're about to call tzset(). |
61 | * |
62 | * In addition to all that, when perl is built with PERL_IMPLICIT_SYS |
63 | * defined: |
64 | * |
65 | * (a) Each interpreter has its own copy of the environment inside the |
66 | * perlhost structure. That allows applications that host multiple |
67 | * independent Perl interpreters to isolate environment changes from |
68 | * each other. (This is similar to how the perlhost mechanism keeps a |
69 | * separate working directory for each Perl interpreter, so that calling |
70 | * chdir() will not affect other interpreters.) |
71 | * |
72 | * (b) Only the first Perl interpreter instantiated within a process will |
73 | * "write through" environment changes to the process environment. |
74 | * |
75 | * (c) Even the primary Perl interpreter won't update the CRT copy of the |
76 | * the environment, only the Win32API copy (it calls win32_putenv()). |
77 | * |
78 | * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes |
79 | * sense to only update the process environment when inside the main |
80 | * interpreter, but we don't have access to CPerlHost's m_bTopLevel member |
81 | * from here so we'll just have to check PL_curinterp instead. |
82 | * |
83 | * Therefore, we can simply #undef getenv() and putenv() so that those names |
84 | * always refer to the CRT functions, and explicitly call win32_getenv() to |
85 | * access perl's %ENV. |
86 | * |
87 | * We also #undef malloc() and free() to be sure we are using the CRT |
88 | * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls |
89 | * into VMem::Malloc() and VMem::Free() and all allocations will be freed |
90 | * when the Perl interpreter is being destroyed so we'd end up with a pointer |
91 | * into deallocated memory in environ[] if a program embedding a Perl |
92 | * interpreter continues to operate even after the main Perl interpreter has |
93 | * been destroyed. |
94 | * |
95 | * Note that we don't free() the malloc()ed memory unless and until we call |
96 | * malloc() again ourselves because the CRT putenv() function simply puts its |
97 | * pointer argument into the environ[] arrary (it doesn't make a copy of it) |
98 | * so this memory must otherwise be leaked. |
99 | */ |
100 | |
101 | #undef getenv |
102 | #undef putenv |
103 | # ifdef UNDER_CE |
104 | # define getenv xcegetenv |
105 | # define putenv xceputenv |
106 | # endif |
107 | #undef malloc |
108 | #undef free |
109 | |
110 | static void |
111 | fix_win32_tzenv(void) |
112 | { |
113 | static char* oldenv = NULL((void*)0); |
114 | char* newenv; |
115 | const char* perl_tz_env = win32_getenv("TZ"); |
116 | const char* crt_tz_env = getenv("TZ"); |
117 | if (perl_tz_env == NULL((void*)0)) |
118 | perl_tz_env = ""; |
119 | if (crt_tz_env == NULL((void*)0)) |
120 | crt_tz_env = ""; |
121 | if (strcmp(perl_tz_env, crt_tz_env) != 0) { |
122 | STRLEN perl_tz_env_len = strlen(perl_tz_env); |
123 | newenv = (char*)malloc(perl_tz_env_len + 4); |
124 | if (newenv != NULL((void*)0)) { |
125 | /* putenv with old MS CRTs will cause a double free internally if you delete |
126 | an env var with the CRT env that doesn't exist in Win32 env (perl %ENV only |
127 | modifies the Win32 env, not CRT env), so always create the env var in Win32 |
128 | env before deleting it with CRT env api, so the error branch never executes |
129 | in __crtsetenv after SetEnvironmentVariableA executes inside __crtsetenv. |
130 | |
131 | VC 9/2008 and up dont have this bug, older VC (msvcrt80.dll and older) and |
132 | mingw (msvcrt.dll) have it see [perl #125529] |
133 | */ |
134 | #if !(_MSC_VER >= 1500) |
135 | if(!perl_tz_env_len) |
136 | SetEnvironmentVariableA("TZ", ""); |
137 | #endif |
138 | sprintf(newenv, "TZ=%s", perl_tz_env); |
139 | putenv(newenv); |
140 | if (oldenv != NULL((void*)0)) |
141 | free(oldenv); |
142 | oldenv = newenv; |
143 | } |
144 | } |
145 | } |
146 | |
147 | #endif |
148 | |
149 | /* |
150 | * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32. |
151 | * This code is duplicated in the POSIX module, so any changes made here |
152 | * should be made there too. |
153 | */ |
154 | static void |
155 | my_tzset(pTHXvoid) |
156 | { |
157 | #ifdef WIN32 |
158 | #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) |
159 | if (PL_curinterp == aTHX) |
160 | #endif |
161 | fix_win32_tzenv(); |
162 | #endif |
163 | tzset(); |
164 | } |
165 | |
166 | /* |
167 | * my_mini_mktime - normalise struct tm values without the localtime() |
168 | * semantics (and overhead) of mktime(). Stolen shamelessly from Perl's |
169 | * Perl_mini_mktime() in util.c - for details on the algorithm, see that |
170 | * file. |
171 | */ |
172 | static void |
173 | my_mini_mktime(struct tm *ptm) |
174 | { |
175 | int yearday; |
176 | int secs; |
177 | int month, mday, year, jday; |
178 | int odd_cent, odd_year; |
179 | |
180 | year = 1900 + ptm->tm_year; |
181 | month = ptm->tm_mon; |
182 | mday = ptm->tm_mday; |
183 | /* allow given yday with no month & mday to dominate the result */ |
184 | if (ptm->tm_yday >= 0 && mday <= 0 && month <= 0) { |
185 | month = 0; |
186 | mday = 0; |
187 | jday = 1 + ptm->tm_yday; |
188 | } |
189 | else { |
190 | jday = 0; |
191 | } |
192 | if (month >= 2) |
193 | month+=2; |
194 | else |
195 | month+=14, year--; |
196 | |
197 | yearday = DAYS_PER_YEAR365 * year + year/4 - year/100 + year/400; |
198 | yearday += month*MONTH_TO_DAYS153/5 + mday + jday; |
199 | /* |
200 | * Note that we don't know when leap-seconds were or will be, |
201 | * so we have to trust the user if we get something which looks |
202 | * like a sensible leap-second. Wild values for seconds will |
203 | * be rationalised, however. |
204 | */ |
205 | if ((unsigned) ptm->tm_sec <= 60) { |
206 | secs = 0; |
207 | } |
208 | else { |
209 | secs = ptm->tm_sec; |
210 | ptm->tm_sec = 0; |
211 | } |
212 | secs += 60 * ptm->tm_min; |
213 | secs += SECS_PER_HOUR(60*60) * ptm->tm_hour; |
214 | if (secs < 0) { |
215 | if (secs-(secs/SECS_PER_DAY(24*(60*60))*SECS_PER_DAY(24*(60*60))) < 0) { |
216 | /* got negative remainder, but need positive time */ |
217 | /* back off an extra day to compensate */ |
218 | yearday += (secs/SECS_PER_DAY(24*(60*60)))-1; |
219 | secs -= SECS_PER_DAY(24*(60*60)) * (secs/SECS_PER_DAY(24*(60*60)) - 1); |
220 | } |
221 | else { |
222 | yearday += (secs/SECS_PER_DAY(24*(60*60))); |
223 | secs -= SECS_PER_DAY(24*(60*60)) * (secs/SECS_PER_DAY(24*(60*60))); |
224 | } |
225 | } |
226 | else if (secs >= SECS_PER_DAY(24*(60*60))) { |
227 | yearday += (secs/SECS_PER_DAY(24*(60*60))); |
228 | secs %= SECS_PER_DAY(24*(60*60)); |
229 | } |
230 | ptm->tm_hour = secs/SECS_PER_HOUR(60*60); |
231 | secs %= SECS_PER_HOUR(60*60); |
232 | ptm->tm_min = secs/60; |
233 | secs %= 60; |
234 | ptm->tm_sec += secs; |
235 | /* done with time of day effects */ |
236 | /* |
237 | * The algorithm for yearday has (so far) left it high by 428. |
238 | * To avoid mistaking a legitimate Feb 29 as Mar 1, we need to |
239 | * bias it by 123 while trying to figure out what year it |
240 | * really represents. Even with this tweak, the reverse |
241 | * translation fails for years before A.D. 0001. |
242 | * It would still fail for Feb 29, but we catch that one below. |
243 | */ |
244 | jday = yearday; /* save for later fixup vis-a-vis Jan 1 */ |
245 | yearday -= YEAR_ADJUST(4*153/5 +1); |
246 | year = (yearday / DAYS_PER_QCENT(4*(25*(4*365 +1)-1)+1)) * 400; |
247 | yearday %= DAYS_PER_QCENT(4*(25*(4*365 +1)-1)+1); |
248 | odd_cent = yearday / DAYS_PER_CENT(25*(4*365 +1)-1); |
249 | year += odd_cent * 100; |
250 | yearday %= DAYS_PER_CENT(25*(4*365 +1)-1); |
251 | year += (yearday / DAYS_PER_QYEAR(4*365 +1)) * 4; |
252 | yearday %= DAYS_PER_QYEAR(4*365 +1); |
253 | odd_year = yearday / DAYS_PER_YEAR365; |
254 | year += odd_year; |
255 | yearday %= DAYS_PER_YEAR365; |
256 | if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */ |
257 | month = 1; |
258 | yearday = 29; |
259 | } |
260 | else { |
261 | yearday += YEAR_ADJUST(4*153/5 +1); /* recover March 1st crock */ |
262 | month = yearday*DAYS_TO_MONTH5/153; |
263 | yearday -= month*MONTH_TO_DAYS153/5; |
264 | /* recover other leap-year adjustment */ |
265 | if (month > 13) { |
266 | month-=14; |
267 | year++; |
268 | } |
269 | else { |
270 | month-=2; |
271 | } |
272 | } |
273 | ptm->tm_year = year - 1900; |
274 | if (yearday) { |
275 | ptm->tm_mday = yearday; |
276 | ptm->tm_mon = month; |
277 | } |
278 | else { |
279 | ptm->tm_mday = 31; |
280 | ptm->tm_mon = month - 1; |
281 | } |
282 | /* re-build yearday based on Jan 1 to get tm_yday */ |
283 | year--; |
284 | yearday = year*DAYS_PER_YEAR365 + year/4 - year/100 + year/400; |
285 | yearday += 14*MONTH_TO_DAYS153/5 + 1; |
286 | ptm->tm_yday = jday - yearday; |
287 | /* fix tm_wday if not overridden by caller */ |
288 | ptm->tm_wday = (jday + WEEKDAY_BIAS6) % 7; |
289 | } |
290 | |
291 | # if defined(WIN32) || (defined(__QNX__) && defined(__WATCOMC__)) |
292 | # define strncasecmp(x,y,n) strnicmp(x,y,n) |
293 | # endif |
294 | |
295 | /* strptime.c 0.1 (Powerdog) 94/03/27 */ |
296 | /* strptime copied from freebsd with the following copyright: */ |
297 | /* |
298 | * Copyright (c) 1994 Powerdog Industries. All rights reserved. |
299 | * |
300 | * Redistribution and use in source and binary forms, with or without |
301 | * modification, are permitted provided that the following conditions |
302 | * are met: |
303 | * |
304 | * 1. Redistributions of source code must retain the above copyright |
305 | * notice, this list of conditions and the following disclaimer. |
306 | * |
307 | * 2. Redistributions in binary form must reproduce the above copyright |
308 | * notice, this list of conditions and the following disclaimer |
309 | * in the documentation and/or other materials provided with the |
310 | * distribution. |
311 | * |
312 | * THIS SOFTWARE IS PROVIDED BY POWERDOG INDUSTRIES ``AS IS'' AND ANY |
313 | * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
314 | * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR |
315 | * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE POWERDOG INDUSTRIES BE |
316 | * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR |
317 | * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF |
318 | * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR |
319 | * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, |
320 | * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE |
321 | * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, |
322 | * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
323 | * |
324 | * The views and conclusions contained in the software and documentation |
325 | * are those of the authors and should not be interpreted as representing |
326 | * official policies, either expressed or implied, of Powerdog Industries. |
327 | */ |
328 | |
329 | #include <time.h> |
330 | #include <ctype.h> |
331 | #include <string.h> |
332 | static char * _strptime(pTHX_ const char *, const char *, struct tm *, |
333 | int *got_GMT); |
334 | |
335 | #define asizeof(a)(sizeof (a) / sizeof ((a)[0])) (sizeof (a) / sizeof ((a)[0])) |
336 | |
337 | struct lc_time_T { |
338 | char * mon[12]; |
339 | char * month[12]; |
340 | char * wday[7]; |
341 | char * weekday[7]; |
342 | char * am; |
343 | char * pm; |
344 | char * AM; |
345 | char * PM; |
346 | char * alt_month[12]; |
347 | }; |
348 | |
349 | |
350 | static struct lc_time_T _C_time_locale; |
351 | |
352 | #define Locale(&_C_time_locale) (&_C_time_locale) |
353 | |
354 | static char * |
355 | _strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm, int *got_GMT) |
356 | { |
357 | char c; |
358 | const char *ptr; |
359 | int i; |
360 | size_t len; |
361 | int Ealternative, Oalternative; |
362 | |
363 | /* There seems to be a slightly improved version at |
364 | * http://www.opensource.apple.com/source/Libc/Libc-583/stdtime/strptime-fbsd.c |
365 | * which we may end up borrowing more from |
366 | */ |
367 | ptr = fmt; |
368 | while (*ptr != 0) { |
369 | if (*buf == 0) |
370 | break; |
371 | |
372 | c = *ptr++; |
373 | |
374 | if (c != '%') { |
375 | if (isspace((unsigned char)c)) |
376 | while (*buf != 0 && isspace((unsigned char)*buf)) |
377 | buf++; |
378 | else if (c != *buf++) |
379 | return 0; |
380 | continue; |
381 | } |
382 | |
383 | Ealternative = 0; |
384 | Oalternative = 0; |
385 | label: |
386 | c = *ptr++; |
387 | switch (c) { |
388 | case 0: |
389 | case '%': |
390 | if (*buf++ != '%') |
391 | return 0; |
392 | break; |
393 | |
394 | case '+': |
395 | buf = _strptime(aTHX_ buf, "%c", tm, got_GMT); |
396 | if (buf == 0) |
397 | return 0; |
398 | break; |
399 | |
400 | case 'C': |
401 | if (!isdigit((unsigned char)*buf)) |
402 | return 0; |
403 | |
404 | /* XXX This will break for 3-digit centuries. */ |
405 | len = 2; |
406 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
407 | i *= 10; |
408 | i += *buf - '0'; |
409 | len--; |
410 | } |
411 | if (i < 19) |
412 | return 0; |
413 | |
414 | tm->tm_year = i * 100 - 1900; |
415 | break; |
416 | |
417 | case 'c': |
418 | /* NOTE: c_fmt is intentionally ignored */ |
419 | |
420 | buf = _strptime(aTHX_ buf, "%a %d %b %Y %I:%M:%S %p %Z", tm, got_GMT); |
421 | if (buf == 0) |
422 | return 0; |
423 | break; |
424 | |
425 | case 'D': |
426 | buf = _strptime(aTHX_ buf, "%m/%d/%y", tm, got_GMT); |
427 | if (buf == 0) |
428 | return 0; |
429 | break; |
430 | |
431 | case 'E': |
432 | if (Ealternative || Oalternative) |
433 | break; |
434 | Ealternative++; |
435 | goto label; |
436 | |
437 | case 'O': |
438 | if (Ealternative || Oalternative) |
439 | break; |
440 | Oalternative++; |
441 | goto label; |
442 | |
443 | case 'F': |
444 | buf = _strptime(aTHX_ buf, "%Y-%m-%d", tm, got_GMT); |
445 | if (buf == 0) |
446 | return 0; |
447 | break; |
448 | |
449 | case 'R': |
450 | buf = _strptime(aTHX_ buf, "%H:%M", tm, got_GMT); |
451 | if (buf == 0) |
452 | return 0; |
453 | break; |
454 | |
455 | case 'r': |
456 | buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT); |
457 | if (buf == 0) |
458 | return 0; |
459 | break; |
460 | |
461 | case 'n': /* whitespace */ |
462 | case 't': |
463 | if (!isspace((unsigned char)*buf)) |
464 | return 0; |
465 | while (isspace((unsigned char)*buf)) |
466 | buf++; |
467 | break; |
468 | |
469 | case 'T': |
470 | buf = _strptime(aTHX_ buf, "%H:%M:%S", tm, got_GMT); |
471 | if (buf == 0) |
472 | return 0; |
473 | break; |
474 | |
475 | case 'X': |
476 | buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT); |
477 | if (buf == 0) |
478 | return 0; |
479 | break; |
480 | |
481 | case 'x': |
482 | buf = _strptime(aTHX_ buf, "%a %d %b %Y", tm, got_GMT); |
483 | if (buf == 0) |
484 | return 0; |
485 | break; |
486 | |
487 | case 'j': |
488 | if (!isdigit((unsigned char)*buf)) |
489 | return 0; |
490 | |
491 | len = 3; |
492 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
493 | i *= 10; |
494 | i += *buf - '0'; |
495 | len--; |
496 | } |
497 | if (i < 1 || i > 366) |
498 | return 0; |
499 | |
500 | tm->tm_yday = i - 1; |
501 | tm->tm_mday = 0; |
502 | break; |
503 | |
504 | case 'M': |
505 | case 'S': |
506 | if (*buf == 0 || isspace((unsigned char)*buf)) |
507 | break; |
508 | |
509 | if (!isdigit((unsigned char)*buf)) |
510 | return 0; |
511 | |
512 | len = 2; |
513 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
514 | i *= 10; |
515 | i += *buf - '0'; |
516 | len--; |
517 | } |
518 | |
519 | if (c == 'M') { |
520 | if (i > 59) |
521 | return 0; |
522 | tm->tm_min = i; |
523 | } else { |
524 | if (i > 60) |
525 | return 0; |
526 | tm->tm_sec = i; |
527 | } |
528 | |
529 | if (*buf != 0 && isspace((unsigned char)*buf)) |
530 | while (*ptr != 0 && !isspace((unsigned char)*ptr)) |
531 | ptr++; |
532 | break; |
533 | |
534 | case 'H': |
535 | case 'I': |
536 | case 'k': |
537 | case 'l': |
538 | /* |
539 | * Of these, %l is the only specifier explicitly |
540 | * documented as not being zero-padded. However, |
541 | * there is no harm in allowing zero-padding. |
542 | * |
543 | * XXX The %l specifier may gobble one too many |
544 | * digits if used incorrectly. |
545 | */ |
546 | if (!isdigit((unsigned char)*buf)) |
547 | return 0; |
548 | |
549 | len = 2; |
550 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
551 | i *= 10; |
552 | i += *buf - '0'; |
553 | len--; |
554 | } |
555 | if (c == 'H' || c == 'k') { |
556 | if (i > 23) |
557 | return 0; |
558 | } else if (i > 12) |
559 | return 0; |
560 | |
561 | tm->tm_hour = i; |
562 | |
563 | if (*buf != 0 && isspace((unsigned char)*buf)) |
564 | while (*ptr != 0 && !isspace((unsigned char)*ptr)) |
565 | ptr++; |
566 | break; |
567 | |
568 | case 'p': |
569 | case 'P': |
570 | /* |
571 | * XXX This is bogus if parsed before hour-related |
572 | * specifiers. |
573 | */ |
574 | len = strlen(Locale(&_C_time_locale)->am); |
575 | if (strncasecmp(buf, Locale(&_C_time_locale)->am, len) == 0 || |
576 | strncasecmp(buf, Locale(&_C_time_locale)->AM, len) == 0) { |
577 | if (tm->tm_hour > 12) |
578 | return 0; |
579 | if (tm->tm_hour == 12) |
580 | tm->tm_hour = 0; |
581 | buf += len; |
582 | break; |
583 | } |
584 | |
585 | len = strlen(Locale(&_C_time_locale)->pm); |
586 | if (strncasecmp(buf, Locale(&_C_time_locale)->pm, len) == 0 || |
587 | strncasecmp(buf, Locale(&_C_time_locale)->PM, len) == 0) { |
588 | if (tm->tm_hour > 12) |
589 | return 0; |
590 | if (tm->tm_hour != 12) |
591 | tm->tm_hour += 12; |
592 | buf += len; |
593 | break; |
594 | } |
595 | |
596 | return 0; |
597 | |
598 | case 'A': |
599 | case 'a': |
600 | for (i = 0; i < (int)asizeof(Locale->weekday)(sizeof ((&_C_time_locale)->weekday) / sizeof (((& _C_time_locale)->weekday)[0])); i++) { |
601 | if (c == 'A') { |
602 | len = strlen(Locale(&_C_time_locale)->weekday[i]); |
603 | if (strncasecmp(buf, |
604 | Locale(&_C_time_locale)->weekday[i], |
605 | len) == 0) |
606 | break; |
607 | } else { |
608 | len = strlen(Locale(&_C_time_locale)->wday[i]); |
609 | if (strncasecmp(buf, |
610 | Locale(&_C_time_locale)->wday[i], |
611 | len) == 0) |
612 | break; |
613 | } |
614 | } |
615 | if (i == (int)asizeof(Locale->weekday)(sizeof ((&_C_time_locale)->weekday) / sizeof (((& _C_time_locale)->weekday)[0]))) |
616 | return 0; |
617 | |
618 | tm->tm_wday = i; |
619 | buf += len; |
620 | break; |
621 | |
622 | case 'U': |
623 | case 'V': |
624 | case 'W': |
625 | /* |
626 | * XXX This is bogus, as we can not assume any valid |
627 | * information present in the tm structure at this |
628 | * point to calculate a real value, so just check the |
629 | * range for now. |
630 | */ |
631 | if (!isdigit((unsigned char)*buf)) |
632 | return 0; |
633 | |
634 | len = 2; |
635 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
636 | i *= 10; |
637 | i += *buf - '0'; |
638 | len--; |
639 | } |
640 | if (i > 53) |
641 | return 0; |
642 | |
643 | if (*buf != 0 && isspace((unsigned char)*buf)) |
644 | while (*ptr != 0 && !isspace((unsigned char)*ptr)) |
645 | ptr++; |
646 | break; |
647 | |
648 | case 'u': |
649 | case 'w': |
650 | if (!isdigit((unsigned char)*buf)) |
651 | return 0; |
652 | |
653 | i = *buf - '0'; |
654 | if (i > 6 + (c == 'u')) |
655 | return 0; |
656 | if (i == 7) |
657 | i = 0; |
658 | |
659 | tm->tm_wday = i; |
660 | |
661 | buf++; |
662 | if (*buf != 0 && isspace((unsigned char)*buf)) |
663 | while (*ptr != 0 && !isspace((unsigned char)*ptr)) |
664 | ptr++; |
665 | break; |
666 | |
667 | case 'd': |
668 | case 'e': |
669 | /* |
670 | * The %e specifier is explicitly documented as not |
671 | * being zero-padded but there is no harm in allowing |
672 | * such padding. |
673 | * |
674 | * XXX The %e specifier may gobble one too many |
675 | * digits if used incorrectly. |
676 | */ |
677 | if (!isdigit((unsigned char)*buf)) |
678 | return 0; |
679 | |
680 | len = 2; |
681 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
682 | i *= 10; |
683 | i += *buf - '0'; |
684 | len--; |
685 | } |
686 | if (i > 31) |
687 | return 0; |
688 | |
689 | tm->tm_mday = i; |
690 | |
691 | if (*buf != 0 && isspace((unsigned char)*buf)) |
692 | while (*ptr != 0 && !isspace((unsigned char)*ptr)) |
693 | ptr++; |
694 | break; |
695 | |
696 | case 'B': |
697 | case 'b': |
698 | case 'h': |
699 | for (i = 0; i < (int)asizeof(Locale->month)(sizeof ((&_C_time_locale)->month) / sizeof (((&_C_time_locale )->month)[0])); i++) { |
700 | if (Oalternative) { |
701 | if (c == 'B') { |
702 | len = strlen(Locale(&_C_time_locale)->alt_month[i]); |
703 | if (strncasecmp(buf, |
704 | Locale(&_C_time_locale)->alt_month[i], |
705 | len) == 0) |
706 | break; |
707 | } |
708 | } else { |
709 | if (c == 'B') { |
710 | len = strlen(Locale(&_C_time_locale)->month[i]); |
711 | if (strncasecmp(buf, |
712 | Locale(&_C_time_locale)->month[i], |
713 | len) == 0) |
714 | break; |
715 | } else { |
716 | len = strlen(Locale(&_C_time_locale)->mon[i]); |
717 | if (strncasecmp(buf, |
718 | Locale(&_C_time_locale)->mon[i], |
719 | len) == 0) |
720 | break; |
721 | } |
722 | } |
723 | } |
724 | if (i == (int)asizeof(Locale->month)(sizeof ((&_C_time_locale)->month) / sizeof (((&_C_time_locale )->month)[0]))) |
725 | return 0; |
726 | |
727 | tm->tm_mon = i; |
728 | buf += len; |
729 | break; |
730 | |
731 | case 'm': |
732 | if (!isdigit((unsigned char)*buf)) |
733 | return 0; |
734 | |
735 | len = 2; |
736 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
737 | i *= 10; |
738 | i += *buf - '0'; |
739 | len--; |
740 | } |
741 | if (i < 1 || i > 12) |
742 | return 0; |
743 | |
744 | tm->tm_mon = i - 1; |
745 | |
746 | if (*buf != 0 && isspace((unsigned char)*buf)) |
747 | while (*ptr != 0 && !isspace((unsigned char)*ptr)) |
748 | ptr++; |
749 | break; |
750 | |
751 | case 's': |
752 | { |
753 | char *cp; |
754 | int sverrno; |
755 | long n; |
756 | time_t t; |
757 | struct tm mytm; |
758 | |
759 | sverrno = errno(*__errno()); |
760 | errno(*__errno()) = 0; |
761 | n = strtol(buf, &cp, 10); |
762 | if (errno(*__errno()) == ERANGE34 || (long)(t = n) != n) { |
763 | errno(*__errno()) = sverrno; |
764 | return 0; |
765 | } |
766 | errno(*__errno()) = sverrno; |
767 | buf = cp; |
768 | memset(&mytm, 0, sizeof(mytm)); |
769 | |
770 | if(*got_GMT == 1) |
771 | mytm = *localtime(&t); |
772 | else |
773 | mytm = *gmtime(&t); |
774 | |
775 | tm->tm_sec = mytm.tm_sec; |
776 | tm->tm_min = mytm.tm_min; |
777 | tm->tm_hour = mytm.tm_hour; |
778 | tm->tm_mday = mytm.tm_mday; |
779 | tm->tm_mon = mytm.tm_mon; |
780 | tm->tm_year = mytm.tm_year; |
781 | tm->tm_wday = mytm.tm_wday; |
782 | tm->tm_yday = mytm.tm_yday; |
783 | tm->tm_isdst = mytm.tm_isdst; |
784 | } |
785 | break; |
786 | |
787 | case 'Y': |
788 | case 'y': |
789 | if (*buf == 0 || isspace((unsigned char)*buf)) |
790 | break; |
791 | |
792 | if (!isdigit((unsigned char)*buf)) |
793 | return 0; |
794 | |
795 | len = (c == 'Y') ? 4 : 2; |
796 | for (i = 0; len && *buf != 0 && isdigit((unsigned char)*buf); buf++) { |
797 | i *= 10; |
798 | i += *buf - '0'; |
799 | len--; |
800 | } |
801 | if (c == 'Y') |
802 | i -= 1900; |
803 | if (c == 'y' && i < 69) |
804 | i += 100; |
805 | if (i < 0) |
806 | return 0; |
807 | |
808 | tm->tm_year = i; |
809 | |
810 | if (*buf != 0 && isspace((unsigned char)*buf)) |
811 | while (*ptr != 0 && !isspace((unsigned char)*ptr)) |
812 | ptr++; |
813 | break; |
814 | |
815 | case 'Z': |
816 | { |
817 | const char *cp; |
818 | char *zonestr; |
819 | |
820 | for (cp = buf; *cp && isupper((unsigned char)*cp); ++cp) |
821 | {/*empty*/} |
822 | if (cp - buf) { |
823 | zonestr = (char *)malloc((size_t) (cp - buf + 1)); |
824 | if (!zonestr) { |
825 | errno(*__errno()) = ENOMEM12; |
826 | return 0; |
827 | } |
828 | strncpy(zonestr, buf,(size_t) (cp - buf)); |
829 | zonestr[cp - buf] = '\0'; |
830 | my_tzset(aTHX); |
831 | if (0 == strcmp(zonestr, "GMT")) { |
832 | *got_GMT = 1; |
833 | } |
834 | free(zonestr); |
835 | if (!*got_GMT) return 0; |
836 | buf += cp - buf; |
837 | } |
838 | } |
839 | break; |
840 | |
841 | case 'z': |
842 | { |
843 | int sign = 1; |
844 | |
845 | if (*buf != '+') { |
846 | if (*buf == '-') |
847 | sign = -1; |
848 | else |
849 | return 0; |
850 | } |
851 | |
852 | buf++; |
853 | i = 0; |
854 | for (len = 4; len > 0; len--) { |
855 | if (isdigit((int)*buf)) { |
856 | i *= 10; |
857 | i += *buf - '0'; |
858 | buf++; |
859 | } else |
860 | return 0; |
861 | } |
862 | |
863 | tm->tm_hour -= sign * (i / 100); |
864 | tm->tm_min -= sign * (i % 100); |
865 | *got_GMT = 1; |
866 | } |
867 | break; |
868 | } |
869 | } |
870 | return (char *)buf; |
871 | } |
872 | |
873 | /* Saves alot of machine code. |
874 | Takes a (auto) SP, which may or may not have been PUSHed before, puts |
875 | tm struct members on Perl stack, then returns new, advanced, SP to caller. |
876 | Assign the return of push_common_tm to your SP, so you can continue to PUSH |
877 | or do a PUTBACK and return eventually. |
878 | !!!! push_common_tm does not touch PL_stack_sp !!!! |
879 | !!!! do not use PUTBACK then SPAGAIN semantics around push_common_tm !!!! |
880 | !!!! You must mortalize whatever push_common_tm put on stack yourself to |
881 | avoid leaking !!!! |
882 | */ |
883 | static SV ** |
884 | push_common_tm(pTHX_ SV ** SPsp, struct tm *mytm) |
885 | { |
886 | PUSHs(newSViv(mytm->tm_sec))(*++sp = (Perl_newSViv( mytm->tm_sec))); |
887 | PUSHs(newSViv(mytm->tm_min))(*++sp = (Perl_newSViv( mytm->tm_min))); |
888 | PUSHs(newSViv(mytm->tm_hour))(*++sp = (Perl_newSViv( mytm->tm_hour))); |
889 | PUSHs(newSViv(mytm->tm_mday))(*++sp = (Perl_newSViv( mytm->tm_mday))); |
890 | PUSHs(newSViv(mytm->tm_mon))(*++sp = (Perl_newSViv( mytm->tm_mon))); |
891 | PUSHs(newSViv(mytm->tm_year))(*++sp = (Perl_newSViv( mytm->tm_year))); |
892 | PUSHs(newSViv(mytm->tm_wday))(*++sp = (Perl_newSViv( mytm->tm_wday))); |
893 | PUSHs(newSViv(mytm->tm_yday))(*++sp = (Perl_newSViv( mytm->tm_yday))); |
894 | PUSHs(newSViv(mytm->tm_isdst))(*++sp = (Perl_newSViv( mytm->tm_isdst))); |
895 | return SPsp; |
896 | } |
897 | |
898 | /* specialized common end of 2 XSUBs |
899 | SV ** SP -- pass your (auto) SP, which has not been PUSHed before, but was |
900 | reset to 0 (PPCODE only or SP -= items or XSprePUSH) |
901 | tm *mytm -- a tm *, will be proprocessed with my_mini_mktime |
902 | return -- none, after calling return_11part_tm, you must call "return;" |
903 | no exceptions |
904 | */ |
905 | static void |
906 | return_11part_tm(pTHX_ SV ** SPsp, struct tm *mytm) |
907 | { |
908 | my_mini_mktime(mytm); |
909 | |
910 | /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm->tm_year, mytm->tm_mon, mytm->tm_mday, mytm->tm_hour, mytm->tm_min, mytm->tm_sec); */ |
911 | EXTEND(SP, 11)do { (void)0; if (__builtin_expect(((((11) < 0 || PL_stack_max - (sp) < (11))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow ( sp,sp,(sizeof(11) > sizeof(ssize_t) && ((ssize_t )(11) != (11)) ? -1 : (11))); ((void)sizeof(sp)); } } while ( 0); |
912 | SPsp = push_common_tm(aTHX_ SPsp, mytm); |
913 | /* epoch */ |
914 | PUSHs(newSViv(0))(*++sp = (Perl_newSViv( 0))); |
915 | /* islocal */ |
916 | PUSHs(newSViv(0))(*++sp = (Perl_newSViv( 0))); |
917 | PUTBACKPL_stack_sp = sp; |
918 | { |
919 | SV ** endsp = SPsp; /* the SV * under SP needs to be mortaled */ |
920 | SPsp -= (11 - 1); /* subtract 0 based count of SVs to mortal */ |
921 | /* mortal target of SP, then increment before function call |
922 | so SP is already calculated before next comparison to not stall CPU */ |
923 | do { |
924 | sv_2mortal(*SP++)Perl_sv_2mortal( *sp++); |
925 | } while(SPsp <= endsp); |
926 | } |
927 | return; |
928 | } |
929 | |
930 | |
931 | static void _populate_C_time_locale(pTHX_ HV* locales ) |
932 | { |
933 | AV* alt_names = (AV *) SvRV( *hv_fetch(locales, "alt_month", 9, 0) )((*((SV**) Perl_hv_common_key_len( (locales),("alt_month"),(9 ),(0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_u.svu_rv); |
934 | AV* long_names = (AV *) SvRV( *hv_fetch(locales, "month", 5, 0) )((*((SV**) Perl_hv_common_key_len( (locales),("month"),(5),(0 ) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_u.svu_rv); |
935 | AV* short_names = (AV *) SvRV( *hv_fetch(locales, "mon", 3, 0) )((*((SV**) Perl_hv_common_key_len( (locales),("mon"),(3),(0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_u.svu_rv); |
936 | int i; |
937 | |
938 | for (i = 0; i < 1 + (int) av_len( long_names )Perl_av_len( long_names); i++) { |
939 | Locale(&_C_time_locale)->alt_month[i] = SvPV_nolen( (SV *) *av_fetch(alt_names, i, 0) )(((((SV *) *Perl_av_fetch( alt_names,i,0))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *Perl_av_fetch ( alt_names,i,0))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV * ) *Perl_av_fetch( alt_names,i,0),0,2)); |
940 | Locale(&_C_time_locale)->month[i] = SvPV_nolen( (SV *) *av_fetch(long_names, i, 0) )(((((SV *) *Perl_av_fetch( long_names,i,0))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *Perl_av_fetch ( long_names,i,0))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV * ) *Perl_av_fetch( long_names,i,0),0,2)); |
941 | Locale(&_C_time_locale)->mon[i] = SvPV_nolen( (SV *) *av_fetch(short_names, i, 0) )(((((SV *) *Perl_av_fetch( short_names,i,0))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *Perl_av_fetch ( short_names,i,0))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV *) *Perl_av_fetch( short_names,i,0),0,2)); |
942 | } |
943 | |
944 | long_names = (AV *) SvRV( *hv_fetch(locales, "weekday", 7, 0) )((*((SV**) Perl_hv_common_key_len( (locales),("weekday"),(7), (0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_u.svu_rv); |
945 | short_names = (AV *) SvRV( *hv_fetch(locales, "wday", 4, 0) )((*((SV**) Perl_hv_common_key_len( (locales),("wday"),(4),(0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_u.svu_rv); |
946 | |
947 | for (i = 0; i < 1 + (int) av_len( long_names )Perl_av_len( long_names); i++) { |
948 | Locale(&_C_time_locale)->wday[i] = SvPV_nolen( (SV *) *av_fetch(short_names, i, 0) )(((((SV *) *Perl_av_fetch( short_names,i,0))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *Perl_av_fetch ( short_names,i,0))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV *) *Perl_av_fetch( short_names,i,0),0,2)); |
949 | Locale(&_C_time_locale)->weekday[i] = SvPV_nolen( (SV *) *av_fetch(long_names, i, 0) )(((((SV *) *Perl_av_fetch( long_names,i,0))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *Perl_av_fetch ( long_names,i,0))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV * ) *Perl_av_fetch( long_names,i,0),0,2)); |
950 | } |
951 | |
952 | Locale(&_C_time_locale)->am = SvPV_nolen( (SV *) *hv_fetch(locales, "am", 2, 0) )(((((SV *) *((SV**) Perl_hv_common_key_len( (locales),("am"), (2),(0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *((SV**) Perl_hv_common_key_len ( (locales),("am"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV *) *((SV**) Perl_hv_common_key_len ( (locales),("am"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)),0,2)); |
953 | Locale(&_C_time_locale)->pm = SvPV_nolen( (SV *) *hv_fetch(locales, "pm", 2, 0) )(((((SV *) *((SV**) Perl_hv_common_key_len( (locales),("pm"), (2),(0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *((SV**) Perl_hv_common_key_len ( (locales),("pm"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV *) *((SV**) Perl_hv_common_key_len ( (locales),("pm"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)),0,2)); |
954 | Locale(&_C_time_locale)->AM = SvPV_nolen( (SV *) *hv_fetch(locales, "AM", 2, 0) )(((((SV *) *((SV**) Perl_hv_common_key_len( (locales),("AM"), (2),(0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *((SV**) Perl_hv_common_key_len ( (locales),("AM"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV *) *((SV**) Perl_hv_common_key_len ( (locales),("AM"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)),0,2)); |
955 | Locale(&_C_time_locale)->PM = SvPV_nolen( (SV *) *hv_fetch(locales, "PM", 2, 0) )(((((SV *) *((SV**) Perl_hv_common_key_len( (locales),("PM"), (2),(0) ? (0x20 | 0x10) : 0x20,((void*)0),0)))->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? (((SV *) *((SV**) Perl_hv_common_key_len ( (locales),("PM"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)))->sv_u.svu_pv) : Perl_sv_2pv_flags( (SV *) *((SV**) Perl_hv_common_key_len ( (locales),("PM"),(2),(0) ? (0x20 | 0x10) : 0x20,((void*)0), 0)),0,2)); |
956 | |
957 | return; |
958 | } |
959 | |
960 | #line 961 "Piece.c" |
961 | #ifndef PERL_UNUSED_VAR |
962 | # define PERL_UNUSED_VAR(var)((void)sizeof(var)) if (0) var = var |
963 | #endif |
964 | |
965 | #ifndef dVARstruct Perl___notused_struct |
966 | # define dVARstruct Perl___notused_struct dNOOPstruct Perl___notused_struct |
967 | #endif |
968 | |
969 | |
970 | /* This stuff is not part of the API! You have been warned. */ |
971 | #ifndef PERL_VERSION_DECIMAL |
972 | # define PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s) (r*1000000 + v*1000 + s) |
973 | #endif |
974 | #ifndef PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) |
975 | # define PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) \ |
976 | PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)(5*1000000 + 32*1000 + 1) |
977 | #endif |
978 | #ifndef PERL_VERSION_GE |
979 | # define PERL_VERSION_GE(r,v,s)((5*1000000 + 32*1000 + 1) >= (r*1000000 + v*1000 + s)) \ |
980 | (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) >= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s)) |
981 | #endif |
982 | #ifndef PERL_VERSION_LE |
983 | # define PERL_VERSION_LE(r,v,s)((5*1000000 + 32*1000 + 1) <= (r*1000000 + v*1000 + s)) \ |
984 | (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) <= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s)) |
985 | #endif |
986 | |
987 | /* XS_INTERNAL is the explicit static-linkage variant of the default |
988 | * XS macro. |
989 | * |
990 | * XS_EXTERNAL is the same as XS_INTERNAL except it does not include |
991 | * "STATIC", ie. it exports XSUB symbols. You probably don't want that |
992 | * for anything but the BOOT XSUB. |
993 | * |
994 | * See XSUB.h in core! |
995 | */ |
996 | |
997 | |
998 | /* TODO: This might be compatible further back than 5.10.0. */ |
999 | #if PERL_VERSION_GE(5, 10, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 10*1000 + 0)) && PERL_VERSION_LE(5, 15, 1)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 15*1000 + 1)) |
1000 | # undef XS_EXTERNAL |
1001 | # undef XS_INTERNAL |
1002 | # if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING) |
1003 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) __declspec(dllexport) XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1004 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1005 | # endif |
1006 | # if defined(__SYMBIAN32__) |
1007 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) EXPORT_C XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1008 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) EXPORT_C STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1009 | # endif |
1010 | # ifndef XS_EXTERNAL |
1011 | # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) |
1012 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) void name(pTHX_ CV* cv __attribute__unused____attribute__((unused))) |
1013 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic void name(pTHX_ CV* cv __attribute__unused____attribute__((unused))) |
1014 | # else |
1015 | # ifdef __cplusplus |
1016 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) extern "C" XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1017 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) static XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1018 | # else |
1019 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1020 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
1021 | # endif |
1022 | # endif |
1023 | # endif |
1024 | #endif |
1025 | |
1026 | /* perl >= 5.10.0 && perl <= 5.15.1 */ |
1027 | |
1028 | |
1029 | /* The XS_EXTERNAL macro is used for functions that must not be static |
1030 | * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL |
1031 | * macro defined, the best we can do is assume XS is the same. |
1032 | * Dito for XS_INTERNAL. |
1033 | */ |
1034 | #ifndef XS_EXTERNAL |
1035 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused))) |
1036 | #endif |
1037 | #ifndef XS_INTERNAL |
1038 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused))) |
1039 | #endif |
1040 | |
1041 | /* Now, finally, after all this mess, we want an ExtUtils::ParseXS |
1042 | * internal macro that we're free to redefine for varying linkage due |
1043 | * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use |
1044 | * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to! |
1045 | */ |
1046 | |
1047 | #undef XS_EUPXS |
1048 | #if defined(PERL_EUPXS_ALWAYS_EXPORT) |
1049 | # define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) |
1050 | #else |
1051 | /* default to internal */ |
1052 | # define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) |
1053 | #endif |
1054 | |
1055 | #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) |
1056 | #define PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) assert(cv)((void)0); assert(params)((void)0) |
1057 | |
1058 | /* prototype to pass -Wmissing-prototypes */ |
1059 | STATICstatic void |
1060 | S_croak_xs_usage(const CV *const cv, const char *const params); |
1061 | |
1062 | STATICstatic void |
1063 | S_croak_xs_usage(const CV *const cv, const char *const params) |
1064 | { |
1065 | const GV *const gv = CvGV(cv)Perl_CvGV( (CV *)(cv)); |
1066 | |
1067 | PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0); |
1068 | |
1069 | if (gv) { |
1070 | const char *const gvname = GvNAME(gv)((((XPVGV*)(gv)->sv_any)->xiv_u.xivu_namehek))->hek_key; |
1071 | const HV *const stash = GvSTASH(gv)(((XPVGV*)(gv)->sv_any)->xnv_u.xgv_stash); |
1072 | const char *const hvname = stash ? HvNAME(stash)((((stash)->sv_flags & 0x02000000) && ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV*) (stash )->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name && ( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_count ? * ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names : ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name )) ? (( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash )[((XPVHV*) (stash)->sv_any)->xhv_max+1]))->xhv_name_count ? *((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names : ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV *) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name ))->hek_key : ((void*)0)) : NULL((void*)0); |
1073 | |
1074 | if (hvname) |
1075 | Perl_croak_nocontextPerl_croak("Usage: %s::%s(%s)", hvname, gvname, params); |
1076 | else |
1077 | Perl_croak_nocontextPerl_croak("Usage: %s(%s)", gvname, params); |
1078 | } else { |
1079 | /* Pants. I don't think that it should be possible to get here. */ |
1080 | Perl_croak_nocontextPerl_croak("Usage: CODE(0x%" UVxf"lx" ")(%s)", PTR2UV(cv)(UV)(cv), params); |
1081 | } |
1082 | } |
1083 | #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) |
1084 | |
1085 | #define croak_xs_usagePerl_croak_xs_usage S_croak_xs_usage |
1086 | |
1087 | #endif |
1088 | |
1089 | /* NOTE: the prototype of newXSproto() is different in versions of perls, |
1090 | * so we define a portable version of newXSproto() |
1091 | */ |
1092 | #ifdef newXS_flags |
1093 | #define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) newXS_flags(name, c_impl, file, proto, 0)Perl_newXS_flags( name,c_impl,file,proto,0) |
1094 | #else |
1095 | #define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) (PL_Sv=(SV*)newXS(name, c_impl, file)Perl_newXS( name,c_impl,file), sv_setpv(PL_Sv, proto)Perl_sv_setpv( PL_Sv,proto), (CV*)PL_Sv) |
1096 | #endif /* !defined(newXS_flags) */ |
1097 | |
1098 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
1099 | # define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS(aTHX_ a,b,file) |
1100 | #else |
1101 | # define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS_deffile(aTHX_ a,b) |
1102 | #endif |
1103 | |
1104 | #line 1105 "Piece.c" |
1105 | |
1106 | XS_EUPXS(XS_Time__Piece__strftime)static void XS_Time__Piece__strftime( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
1107 | XS_EUPXS(XS_Time__Piece__strftime)static void XS_Time__Piece__strftime( CV* cv __attribute__((unused ))) |
1108 | { |
1109 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
1110 | if (items < 2 || items > 3) |
1111 | croak_xs_usagePerl_croak_xs_usage(cv, "fmt, epoch, islocal = 1"); |
1112 | { |
1113 | char * fmt = (char *)SvPV_nolen(ST(0))((((PL_stack_base[ax + (0)])->sv_flags & (0x00000400|0x00200000 )) == 0x00000400) ? ((PL_stack_base[ax + (0)])->sv_u.svu_pv ) : Perl_sv_2pv_flags( PL_stack_base[ax + (0)],0,2)) |
1114 | ; |
1115 | time_t epoch = (time_t)SvNV(ST(1))((((PL_stack_base[ax + (1)])->sv_flags & (0x00000200|0x00200000 )) == 0x00000200) ? ((XPVNV*) (PL_stack_base[ax + (1)])->sv_any )->xnv_u.xnv_nv : Perl_sv_2nv_flags( PL_stack_base[ax + (1 )],2)) |
1116 | ; |
1117 | int islocal; |
1118 | |
1119 | if (items < 3) |
1120 | islocal = 1; |
1121 | else { |
1122 | islocal = (int)SvIV(ST(2))((((PL_stack_base[ax + (2)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (2)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 2)],2)) |
1123 | ; |
1124 | } |
1125 | #line 961 "Piece.xs" |
1126 | { |
1127 | char tmpbuf[TP_BUF_SIZE160]; |
1128 | struct tm mytm; |
1129 | size_t len; |
1130 | |
1131 | if(islocal == 1) |
1132 | mytm = *localtime(&epoch); |
1133 | else |
1134 | mytm = *gmtime(&epoch); |
1135 | |
1136 | len = strftime(tmpbuf, TP_BUF_SIZE160, fmt, &mytm); |
1137 | /* |
1138 | ** The following is needed to handle to the situation where |
1139 | ** tmpbuf overflows. Basically we want to allocate a buffer |
1140 | ** and try repeatedly. The reason why it is so complicated |
1141 | ** is that getting a return value of 0 from strftime can indicate |
1142 | ** one of the following: |
1143 | ** 1. buffer overflowed, |
1144 | ** 2. illegal conversion specifier, or |
1145 | ** 3. the format string specifies nothing to be returned(not |
1146 | ** an error). This could be because format is an empty string |
1147 | ** or it specifies %p that yields an empty string in some locale. |
1148 | ** If there is a better way to make it portable, go ahead by |
1149 | ** all means. |
1150 | */ |
1151 | if ((len > 0 && len < TP_BUF_SIZE160) || (len == 0 && *fmt == '\0')) |
1152 | ST(0)PL_stack_base[ax + (0)] = sv_2mortal(newSVpv(tmpbuf, len))Perl_sv_2mortal( Perl_newSVpv( tmpbuf,len)); |
1153 | else { |
1154 | /* Possibly buf overflowed - try again with a bigger buf */ |
1155 | size_t fmtlen = strlen(fmt); |
1156 | size_t bufsize = fmtlen + TP_BUF_SIZE160; |
1157 | char* buf; |
1158 | size_t buflen; |
1159 | |
1160 | New(0, buf, bufsize, char)(buf = ((void)(__builtin_expect(((((( sizeof(size_t) < sizeof (bufsize) || sizeof(char) > ((size_t)1 << 8*(sizeof( size_t) - sizeof(bufsize)))) ? (size_t)(bufsize) : ((size_t)- 1)/sizeof(char)) > ((size_t)-1)/sizeof(char))) ? (_Bool)1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap(),0)), (char *)(Perl_safesysmalloc((size_t)((bufsize)*sizeof(char)))))); |
1161 | while (buf) { |
1162 | buflen = strftime(buf, bufsize, fmt, &mytm); |
1163 | if (buflen > 0 && buflen < bufsize) |
1164 | break; |
1165 | /* heuristic to prevent out-of-memory errors */ |
1166 | if (bufsize > 100*fmtlen) { |
1167 | Safefree(buf)Perl_safesysfree(((void *)(buf))); |
1168 | buf = NULL((void*)0); |
1169 | break; |
1170 | } |
1171 | bufsize *= 2; |
1172 | Renew(buf, bufsize, char)(buf = ((void)(__builtin_expect(((((( sizeof(size_t) < sizeof (bufsize) || sizeof(char) > ((size_t)1 << 8*(sizeof( size_t) - sizeof(bufsize)))) ? (size_t)(bufsize) : ((size_t)- 1)/sizeof(char)) > ((size_t)-1)/sizeof(char))) ? (_Bool)1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap(),0)), (char *)(Perl_safesysrealloc((void *)(buf),(size_t)((bufsize)*sizeof (char)))))); |
1173 | } |
1174 | if (buf) { |
1175 | ST(0)PL_stack_base[ax + (0)] = sv_2mortal(newSVpv(buf, buflen))Perl_sv_2mortal( Perl_newSVpv( buf,buflen)); |
1176 | Safefree(buf)Perl_safesysfree(((void *)(buf))); |
1177 | } |
1178 | else |
1179 | ST(0)PL_stack_base[ax + (0)] = sv_2mortal(newSVpv(tmpbuf, len))Perl_sv_2mortal( Perl_newSVpv( tmpbuf,len)); |
1180 | } |
1181 | } |
1182 | #line 1183 "Piece.c" |
1183 | } |
1184 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
1185 | } |
1186 | |
1187 | |
1188 | XS_EUPXS(XS_Time__Piece__tzset)static void XS_Time__Piece__tzset( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
1189 | XS_EUPXS(XS_Time__Piece__tzset)static void XS_Time__Piece__tzset( CV* cv __attribute__((unused ))) |
1190 | { |
1191 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
1192 | if (items != 0) |
1193 | croak_xs_usagePerl_croak_xs_usage(cv, ""); |
1194 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
1195 | SPsp -= items; |
1196 | { |
1197 | #line 1021 "Piece.xs" |
1198 | PUTBACKPL_stack_sp = sp; /* makes rest of this function tailcall friendly */ |
1199 | my_tzset(aTHX); |
1200 | return; /* skip XSUBPP's PUTBACK */ |
1201 | #line 1202 "Piece.c" |
1202 | PUTBACKPL_stack_sp = sp; |
1203 | return; |
1204 | } |
1205 | } |
1206 | |
1207 | |
1208 | XS_EUPXS(XS_Time__Piece__strptime)static void XS_Time__Piece__strptime( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
1209 | XS_EUPXS(XS_Time__Piece__strptime)static void XS_Time__Piece__strptime( CV* cv __attribute__((unused ))) |
1210 | { |
1211 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
1212 | if (items != 4) |
1213 | croak_xs_usagePerl_croak_xs_usage(cv, "string, format, got_GMT, localization"); |
1214 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
1215 | SPsp -= items; |
1216 | { |
1217 | char * string = (char *)SvPV_nolen(ST(0))((((PL_stack_base[ax + (0)])->sv_flags & (0x00000400|0x00200000 )) == 0x00000400) ? ((PL_stack_base[ax + (0)])->sv_u.svu_pv ) : Perl_sv_2pv_flags( PL_stack_base[ax + (0)],0,2)) |
1218 | ; |
1219 | char * format = (char *)SvPV_nolen(ST(1))((((PL_stack_base[ax + (1)])->sv_flags & (0x00000400|0x00200000 )) == 0x00000400) ? ((PL_stack_base[ax + (1)])->sv_u.svu_pv ) : Perl_sv_2pv_flags( PL_stack_base[ax + (1)],0,2)) |
1220 | ; |
1221 | int got_GMT = (int)SvIV(ST(2))((((PL_stack_base[ax + (2)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (2)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 2)],2)) |
1222 | ; |
1223 | #line 1031 "Piece.xs" |
1224 | struct tm mytm; |
1225 | char * remainder; |
1226 | HV * locales; |
1227 | #line 1228 "Piece.c" |
1228 | SV* localization = ST(3)PL_stack_base[ax + (3)] |
1229 | ; |
1230 | #line 1035 "Piece.xs" |
1231 | memset(&mytm, 0, sizeof(mytm)); |
1232 | |
1233 | /* sensible defaults. */ |
1234 | mytm.tm_mday = 1; |
1235 | mytm.tm_year = 70; |
1236 | mytm.tm_wday = 4; |
1237 | mytm.tm_isdst = -1; /* -1 means we don't know */ |
1238 | |
1239 | if( SvTYPE(SvRV( localization ))((svtype)((((localization)->sv_u.svu_rv))->sv_flags & 0xff)) == SVt_PVHV ){ |
1240 | locales = (HV *)SvRV(localization)((localization)->sv_u.svu_rv); |
1241 | } |
1242 | else{ |
1243 | croakPerl_croak("_strptime requires a Hash Reference of locales"); |
1244 | } |
1245 | |
1246 | /* populate our locale data struct (used for %[AaBbPp] flags) */ |
1247 | _populate_C_time_locale(aTHX_ locales ); |
1248 | |
1249 | remainder = (char *)_strptime(aTHX_ string, format, &mytm, &got_GMT); |
1250 | if (remainder == NULL((void*)0)) { |
1251 | croakPerl_croak("Error parsing time"); |
1252 | } |
1253 | if (*remainder != '\0') { |
1254 | warnPerl_warn("Garbage at end of string in strptime: %s", remainder); |
1255 | warnPerl_warn("Perhaps a format flag did not match the actual input?"); |
1256 | } |
1257 | |
1258 | return_11part_tm(aTHX_ SPsp, &mytm); |
1259 | return; |
1260 | #line 1261 "Piece.c" |
1261 | PUTBACKPL_stack_sp = sp; |
1262 | return; |
1263 | } |
1264 | } |
1265 | |
1266 | |
1267 | XS_EUPXS(XS_Time__Piece__mini_mktime)static void XS_Time__Piece__mini_mktime( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
1268 | XS_EUPXS(XS_Time__Piece__mini_mktime)static void XS_Time__Piece__mini_mktime( CV* cv __attribute__ ((unused))) |
1269 | { |
1270 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
1271 | if (items != 6) |
1272 | croak_xs_usagePerl_croak_xs_usage(cv, "sec, min, hour, mday, mon, year"); |
1273 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
1274 | SPsp -= items; |
1275 | { |
1276 | #line 1068 "Piece.xs" |
1277 | struct tm mytm; |
1278 | time_t t; |
1279 | #line 1280 "Piece.c" |
1280 | int sec = (int)SvIV(ST(0))((((PL_stack_base[ax + (0)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (0)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 0)],2)) |
1281 | ; |
1282 | int min = (int)SvIV(ST(1))((((PL_stack_base[ax + (1)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (1)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 1)],2)) |
1283 | ; |
1284 | int hour = (int)SvIV(ST(2))((((PL_stack_base[ax + (2)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (2)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 2)],2)) |
1285 | ; |
1286 | int mday = (int)SvIV(ST(3))((((PL_stack_base[ax + (3)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (3)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 3)],2)) |
1287 | ; |
1288 | int mon = (int)SvIV(ST(4))((((PL_stack_base[ax + (4)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (4)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 4)],2)) |
1289 | ; |
1290 | int year = (int)SvIV(ST(5))((((PL_stack_base[ax + (5)])->sv_flags & (0x00000100|0x00200000 )) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (5)])->sv_any )->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + ( 5)],2)) |
1291 | ; |
1292 | #line 1071 "Piece.xs" |
1293 | t = 0; |
1294 | mytm = *gmtime(&t); |
1295 | |
1296 | mytm.tm_sec = sec; |
1297 | mytm.tm_min = min; |
1298 | mytm.tm_hour = hour; |
1299 | mytm.tm_mday = mday; |
1300 | mytm.tm_mon = mon; |
1301 | mytm.tm_year = year; |
1302 | |
1303 | return_11part_tm(aTHX_ SPsp, &mytm); |
1304 | return; |
1305 | #line 1306 "Piece.c" |
1306 | PUTBACKPL_stack_sp = sp; |
1307 | return; |
1308 | } |
1309 | } |
1310 | |
1311 | |
1312 | XS_EUPXS(XS_Time__Piece__crt_localtime)static void XS_Time__Piece__crt_localtime( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
1313 | XS_EUPXS(XS_Time__Piece__crt_localtime)static void XS_Time__Piece__crt_localtime( CV* cv __attribute__ ((unused))) |
1314 | { |
1315 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
1316 | dXSI32I32 ix = ((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))-> xcv_start_u.xcv_xsubany.any_i32; |
1317 | if (items != 1) |
1318 | croak_xs_usagePerl_croak_xs_usage(cv, "sec"); |
1319 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
1320 | SPsp -= items; |
1321 | { |
1322 | #line 1089 "Piece.xs" |
1323 | struct tm mytm; |
1324 | #line 1325 "Piece.c" |
1325 | time_t sec = (time_t)SvNV(ST(0))((((PL_stack_base[ax + (0)])->sv_flags & (0x00000200|0x00200000 )) == 0x00000200) ? ((XPVNV*) (PL_stack_base[ax + (0)])->sv_any )->xnv_u.xnv_nv : Perl_sv_2nv_flags( PL_stack_base[ax + (0 )],2)) |
1326 | ; |
1327 | #line 1091 "Piece.xs" |
1328 | if(ix) mytm = *gmtime(&sec); |
1329 | else mytm = *localtime(&sec); |
1330 | /* Need to get: $s,$n,$h,$d,$m,$y */ |
1331 | |
1332 | EXTEND(SP, 10)do { (void)0; if (__builtin_expect(((((10) < 0 || PL_stack_max - (sp) < (10))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow ( sp,sp,(sizeof(10) > sizeof(ssize_t) && ((ssize_t )(10) != (10)) ? -1 : (10))); ((void)sizeof(sp)); } } while ( 0); |
1333 | SPsp = push_common_tm(aTHX_ SPsp, &mytm); |
1334 | PUSHs(newSViv(mytm.tm_isdst))(*++sp = (Perl_newSViv( mytm.tm_isdst))); |
1335 | PUTBACKPL_stack_sp = sp; |
1336 | { |
1337 | SV ** endsp = SPsp; /* the SV * under SP needs to be mortaled */ |
1338 | SPsp -= (10 - 1); /* subtract 0 based count of SVs to mortal */ |
1339 | /* mortal target of SP, then increment before function call |
1340 | so SP is already calculated before next comparison to not stall CPU */ |
1341 | do { |
1342 | sv_2mortal(*SP++)Perl_sv_2mortal( *sp++); |
1343 | } while(SPsp <= endsp); |
1344 | } |
1345 | return; |
1346 | #line 1347 "Piece.c" |
1347 | PUTBACKPL_stack_sp = sp; |
1348 | return; |
1349 | } |
1350 | } |
1351 | |
1352 | |
1353 | XS_EUPXS(XS_Time__Piece__get_localization)static void XS_Time__Piece__get_localization( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
1354 | XS_EUPXS(XS_Time__Piece__get_localization)static void XS_Time__Piece__get_localization( CV* cv __attribute__ ((unused))) |
1355 | { |
1356 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
1357 | if (items != 0) |
1358 | croak_xs_usagePerl_croak_xs_usage(cv, ""); |
1359 | { |
1360 | SV * RETVAL; |
1361 | #line 1113 "Piece.xs" |
1362 | HV* locales = newHV()((HV *)({ void *_p = (Perl_newSV_type( SVt_PVHV)); _p; })); |
1363 | AV* wdays = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; })); |
1364 | AV* weekdays = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; })); |
1365 | AV* mons = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; })); |
1366 | AV* months = newAV()((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; })); |
1367 | SV** tmp; |
1368 | size_t len; |
1369 | char buf[TP_BUF_SIZE160]; |
1370 | size_t i; |
1371 | time_t t = 1325386800; /*1325386800 = Sun, 01 Jan 2012 03:00:00 GMT*/ |
1372 | struct tm mytm = *gmtime(&t); |
1373 | #line 1374 "Piece.c" |
1374 | #line 1126 "Piece.xs" |
1375 | for(i = 0; i < 7; ++i){ |
1376 | |
1377 | len = strftime(buf, TP_BUF_SIZE160, "%a", &mytm); |
1378 | av_push(wdays, (SV *) newSVpvn(buf, len))Perl_av_push( wdays,(SV *) Perl_newSVpvn( buf,len)); |
1379 | |
1380 | len = strftime(buf, TP_BUF_SIZE160, "%A", &mytm); |
1381 | av_push(weekdays, (SV *) newSVpvn(buf, len))Perl_av_push( weekdays,(SV *) Perl_newSVpvn( buf,len)); |
1382 | |
1383 | ++mytm.tm_wday; |
1384 | } |
1385 | |
1386 | for(i = 0; i < 12; ++i){ |
1387 | |
1388 | len = strftime(buf, TP_BUF_SIZE160, "%b", &mytm); |
1389 | av_push(mons, (SV *) newSVpvn(buf, len))Perl_av_push( mons,(SV *) Perl_newSVpvn( buf,len)); |
1390 | |
1391 | len = strftime(buf, TP_BUF_SIZE160, "%B", &mytm); |
1392 | av_push(months, (SV *) newSVpvn(buf, len))Perl_av_push( months,(SV *) Perl_newSVpvn( buf,len)); |
1393 | |
1394 | ++mytm.tm_mon; |
1395 | } |
1396 | |
1397 | tmp = hv_store(locales, "wday", 4, newRV_noinc((SV *) wdays), 0)((SV**) Perl_hv_common_key_len( (locales),("wday"),(4),(0x04| 0x20),(Perl_newRV_noinc( (SV *) wdays)),(0))); |
1398 | tmp = hv_store(locales, "weekday", 7, newRV_noinc((SV *) weekdays), 0)((SV**) Perl_hv_common_key_len( (locales),("weekday"),(7),(0x04 |0x20),(Perl_newRV_noinc( (SV *) weekdays)),(0))); |
1399 | tmp = hv_store(locales, "mon", 3, newRV_noinc((SV *) mons), 0)((SV**) Perl_hv_common_key_len( (locales),("mon"),(3),(0x04|0x20 ),(Perl_newRV_noinc( (SV *) mons)),(0))); |
1400 | tmp = hv_store(locales, "month", 5, newRV_noinc((SV *) months), 0)((SV**) Perl_hv_common_key_len( (locales),("month"),(5),(0x04 |0x20),(Perl_newRV_noinc( (SV *) months)),(0))); |
1401 | tmp = hv_store(locales, "alt_month", 9, newRV((SV *) months), 0)((SV**) Perl_hv_common_key_len( (locales),("alt_month"),(9),( 0x04|0x20),(Perl_newRV( (SV *) months)),(0))); |
Value stored to 'tmp' is never read | |
1402 | |
1403 | len = strftime(buf, TP_BUF_SIZE160, "%p", &mytm); |
1404 | tmp = hv_store(locales, "AM", 2, newSVpvn(buf,len), 0)((SV**) Perl_hv_common_key_len( (locales),("AM"),(2),(0x04|0x20 ),(Perl_newSVpvn( buf,len)),(0))); |
1405 | mytm.tm_hour = 18; |
1406 | len = strftime(buf, TP_BUF_SIZE160, "%p", &mytm); |
1407 | tmp = hv_store(locales, "PM", 2, newSVpvn(buf,len), 0)((SV**) Perl_hv_common_key_len( (locales),("PM"),(2),(0x04|0x20 ),(Perl_newSVpvn( buf,len)),(0))); |
1408 | |
1409 | if(tmp == NULL((void*)0) || !SvOK( (SV *) *tmp)(((SV *) *tmp)->sv_flags & (0x00000100|0x00000200|0x00000400 |0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000))){ |
1410 | croakPerl_croak("Failed to get localization."); |
1411 | } |
1412 | |
1413 | RETVAL = newRV_noinc((SV *)locales)Perl_newRV_noinc( (SV *)locales); |
1414 | #line 1415 "Piece.c" |
1415 | RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL); |
1416 | ST(0)PL_stack_base[ax + (0)] = RETVAL; |
1417 | } |
1418 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
1419 | } |
1420 | |
1421 | #ifdef __cplusplus |
1422 | extern "C" |
1423 | #endif |
1424 | XS_EXTERNAL(boot_Time__Piece)void boot_Time__Piece( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */ |
1425 | XS_EXTERNAL(boot_Time__Piece)void boot_Time__Piece( CV* cv __attribute__((unused))) |
1426 | { |
1427 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
1428 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
1429 | #else |
1430 | dVARstruct Perl___notused_struct; dXSBOOTARGSXSAPIVERCHKI32 ax = Perl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter )) << 16) | ((sizeof("" "1.3401" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "1.3401" "" )-1) << 8) | ((((1)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | (( ((1)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1))) , cv, "Piece.c", "v" "5" "." "32" "." "0", "1.3401"); SV **mark = PL_stack_base + ax; SV **sp = PL_stack_sp; I32 items = (I32 )(sp - mark); |
1431 | #endif |
1432 | #if (PERL_REVISION5 == 5 && PERL_VERSION32 < 9) |
1433 | char* file = __FILE__"Piece.c"; |
1434 | #else |
1435 | const char* file = __FILE__"Piece.c"; |
1436 | #endif |
1437 | |
1438 | PERL_UNUSED_VAR(file)((void)sizeof(file)); |
1439 | |
1440 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
1441 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
1442 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
1443 | XS_VERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter)) << 16) | ((sizeof("" "1.3401" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "1.3401" "" )-1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | (( ((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "" "")-1))), cv, "Piece.c", items , ax, "1.3401"); |
1444 | # ifdef XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter)) << 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | (((( 0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool )1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1))) , cv, "Piece.c", items, ax, "v" "5" "." "32" "." "0") |
1445 | XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter)) << 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | (((( 0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool )1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow" ), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1))) , cv, "Piece.c", items, ax, "v" "5" "." "32" "." "0"); |
1446 | # endif |
1447 | #endif |
1448 | |
1449 | (void)newXSproto_portable("Time::Piece::_strftime", XS_Time__Piece__strftime, file, "$$;$")Perl_newXS_flags( "Time::Piece::_strftime",XS_Time__Piece__strftime ,file,"$$;$",0); |
1450 | (void)newXSproto_portable("Time::Piece::_tzset", XS_Time__Piece__tzset, file, "")Perl_newXS_flags( "Time::Piece::_tzset",XS_Time__Piece__tzset ,file,"",0); |
1451 | (void)newXSproto_portable("Time::Piece::_strptime", XS_Time__Piece__strptime, file, "$$$$")Perl_newXS_flags( "Time::Piece::_strptime",XS_Time__Piece__strptime ,file,"$$$$",0); |
1452 | (void)newXSproto_portable("Time::Piece::_mini_mktime", XS_Time__Piece__mini_mktime, file, "$$$$$$")Perl_newXS_flags( "Time::Piece::_mini_mktime",XS_Time__Piece__mini_mktime ,file,"$$$$$$",0); |
1453 | cv = newXSproto_portable("Time::Piece::_crt_gmtime", XS_Time__Piece__crt_localtime, file, "$")Perl_newXS_flags( "Time::Piece::_crt_gmtime",XS_Time__Piece__crt_localtime ,file,"$",0); |
1454 | XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u .xcv_xsubany.any_i32 = 1; |
1455 | cv = newXSproto_portable("Time::Piece::_crt_localtime", XS_Time__Piece__crt_localtime, file, "$")Perl_newXS_flags( "Time::Piece::_crt_localtime",XS_Time__Piece__crt_localtime ,file,"$",0); |
1456 | XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u .xcv_xsubany.any_i32 = 0; |
1457 | (void)newXSproto_portable("Time::Piece::_get_localization", XS_Time__Piece__get_localization, file, "")Perl_newXS_flags( "Time::Piece::_get_localization",XS_Time__Piece__get_localization ,file,"",0); |
1458 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
1459 | # if PERL_VERSION_GE(5, 9, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 9*1000 + 0)) |
1460 | if (PL_unitcheckav) |
1461 | call_list(PL_scopestack_ix, PL_unitcheckav)Perl_call_list( PL_scopestack_ix,PL_unitcheckav); |
1462 | # endif |
1463 | XSRETURN_YESdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[0]) ); do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); } while (0); |
1464 | #else |
1465 | Perl_xs_boot_epilog(aTHX_ ax); |
1466 | #endif |
1467 | } |
1468 |