#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include <time.h>
#include <stdio.h>
#include <stdlib.h>

MODULE = tztime         PACKAGE = tztime

long
tz_mktime(sec, min, hour, mday, mon, year, tz_name)
  int sec
  int min
  int hour
  int mday
  int mon
  int year
  char *tz_name

    CODE:

      long epoch;
      struct tm tz_tm;
      char *old_tz;
      char *tz_p;
      bool restore = FALSE;

      tz_tm.tm_sec = sec;
      tz_tm.tm_min = min;
      tz_tm.tm_hour = hour;
      tz_tm.tm_mday = mday;
      tz_tm.tm_mon = mon;
      tz_tm.tm_year = year;
      tz_tm.tm_wday = 0;
      tz_tm.tm_yday = 0;
      tz_tm.tm_isdst = -1;
      
      tz_p = getenv("TZ");
      if(tz_p != NULL)
      {
        restore = TRUE;
        old_tz = malloc(strlen(tz_p) - 2); // 'TZ=' is -3, '\0' is +1, total is -2
        if(old_tz == NULL) {
          XSRETURN_UNDEF;
        }
        sscanf(tz_p,"TZ = %s",old_tz);
      }

      setenv("TZ",tz_name,1);
      tzset();
      epoch = (long)mktime(&tz_tm);

      if(restore) {
        setenv("TZ",old_tz,1);
        free(old_tz);
      } else {
        unsetenv("TZ");
      }
      tzset();
  
      RETVAL = epoch;
      
    OUTPUT:
      RETVAL
      
void   
tz_gettime(epoch, tz_name)
  long epoch
  char *tz_name;
  
    PPCODE:
    
      struct tm tz_tm;
      char *old_tz;
      char *tz_p;
      bool restore = FALSE;

      tz_p = getenv("TZ");
      if(tz_p != NULL)
      {
        restore = TRUE;
        old_tz = malloc(strlen(tz_p) - 2); // 'TZ=' is -3, '\0' is +1, total is -2
        if(old_tz == NULL) {
          XPUSHs(sv_2mortal(newSVnv(errno)));
        }
        sscanf(tz_p,"TZ = %s",old_tz);
      }

      setenv("TZ",tz_name,1);
      tzset();
      localtime_r(&epoch,&tz_tm);

      if(restore) {
        setenv("TZ",old_tz,1);
        free(old_tz);
      } else {
        unsetenv("TZ");
      }
      tzset();

      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_sec)));
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_min)));
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_hour)));
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_mday)));
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_mon))); 
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_year)));
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_wday)));
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_yday)));
      XPUSHs(sv_2mortal(newSVnv(tz_tm.tm_isdst)));

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;
use threads;
use tztime;
use Thread::Semaphore;

my $sem  = Thread::Semaphore->new;

my ($tr) = threads->create(\&thr_proc);
my ($tr2) = threads->create(\&thr_proc);

$tr->join;
$tr2->join;

$ENV{TZ}="Europe/Paris";
my $t=localtime();
print "main (Europe/Paris): ",$t,"\n";

$ENV{TZ}="Europe/Moscow";
$t=localtime();
print "main (Europe/Moscow): ",$t,"\n";

sub thr_proc {

    $sem->down();
    my @tms = tztime::tz_gettime(time,"Europe/Paris");
    $sem->up();
    $tms[5] += 1900;
    $tms[4] ++;
    $tms[$_] =~ s/^(.)$/0$1/ for (0..2) ;
    print "in thread (Europe/Paris): $tms[5]-$tms[4]-$tms[3] $tms[2]:$tms[1]:$tms[0]\n";

    $sem->down();
    @tms = tztime::tz_gettime(time,"Europe/Moscow");
    $sem->up();
    $tms[5] += 1900;
    $tms[4] ++;
    $tms[$_] =~ s/^(.)$/0$1/ for (0..2) ;
    print "in thread (Europe/Moscow): $tms[5]-$tms[4]-$tms[2] $tms[2]:$tms[1]:$tms[0]\n";

    
}

##</code><code>##

$ ./mt-demo.pl
in thread (Europe/Paris): 2009-11-24 23:27:28
in thread (Europe/Moscow): 2009-11-25 01:27:28
in thread (Europe/Paris): 2009-11-24 23:27:28
in thread (Europe/Moscow): 2009-11-25 01:27:28
main (Europe/Paris): Tue Nov 24 23:27:28 2009
main (Europe/Moscow): Wed Nov 25 01:27:28 2009