#! perl -slw
use strict;
use cback_test;
use Inline C => Config => BUILD_NOISY => 1;
use Inline C => <<'END_C',  NAME => '_867652', CLEAN_AFTER_BUILD => 0;

PerlInterpreter *saved1;
SV *cback1;

PerlInterpreter *saved2;
SV *cback2;

void cbProc1( unsigned int time ) {
//this always returns "0"
    PerlInterpreter *temp = Perl_get_context();

    printf( "Time in C-Callback1: %u. Prior ctx %lud\n", time , temp);

    PERL_SET_CONTEXT( saved1 );
    {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK( SP );
        XPUSHs( sv_2mortal( newSVuv( (UV)time ) ) );
        PUTBACK;

        call_sv( cback1, G_DISCARD );

        FREETMPS;
        LEAVE;
    }
    PERL_SET_CONTEXT( temp );
    return;
}

void cbProc2( unsigned int time ) {
//this always returns "0"
    PerlInterpreter *temp = Perl_get_context();

    printf( "Time in C-Callback2: %u.  Prior ctx %lud\n", time , temp);

    PERL_SET_CONTEXT( saved2 );
    {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK( SP );
        XPUSHs( sv_2mortal( newSVuv( (UV)time ) ) );
        PUTBACK;

//the error msg shows up after calling this
        call_sv( cback2, G_DISCARD );

        FREETMPS;
        LEAVE;
    }
    PERL_SET_CONTEXT( temp );
    return;
}

void* thread1( void *arg ) {
    int i=0;
    while( i++<5 ) {
         sleep( 5 );
         printf( "Here in thread1..calling CCB1\n" );
         cbProc1( time(NULL) );
     }
    i=0;
    while( i++<5 ) {
         sleep( 5 );
         printf( "Here in thread1..calling CCB2\n" );
         cbProc2( time(NULL) );
     }
}

void* thread2( void *arg ) {
    while( sleep( 7 ), 1 ) {
         printf( "Here in thread2\n" );
         cbProc2( time(NULL) );
     }
}

void setCallback1( SV* cv ) {
    pthread_t tid;
//my code did not have the dTHX here, but adding it made no difference (i.e saved1 the same).
    //dTHX;
//saved1 and saved2 are always the same too.
    saved1 = Perl_get_context();
    cback1 = cv;

    printf("saved1 = %lud\n", saved1);
    // Start callback timer thread
    pthread_create( &tid, NULL, thread1, NULL );
    return;
}

void setCallback2( SV* cv ) {
    pthread_t tid;
//my code did not have the dTHX here, but adding it made no difference (i.e saved2 is the same).
    //dTHX;
    saved2 = Perl_get_context();
    cback2 = cv;

    printf("saved2 = %lud\n", saved2);
    // Start callback timer thread
    //pthread_create( &tid, NULL, thread2, NULL );
    return;
}

END_C

$|++;

print "Setting callback1..\n";

#Registering cback rhis gives a coredump or one or several other errors
#when CCB calls PCB
#setCallback1(\&cback_test::callback1);

#this syntax works as expected in this program, but this doesnt
#work (the pcb ref is not valid or null) when my typemap using SWIG runs
setCallback1('cback_test::callback1');

while ($cback_test::cb1_cnt != 4)
{
  print "Waiting for callback1 to finish..\n";
  sleep(1);
}

print "Setting callback2..\n";
setCallback2(\&cback_test::callback2);

while ($cback_test::cb2_cnt != 4)
{
  print "Waiting for callback2 to finish..\n";
  sleep(1);
}

sleep (15);

__END__


##</code><code>##


package cback_test;

$cb1_cnt = 0;
sub callback1 {
    print "Timer value in callback1 is: $_[0]";
    $cb1_cnt++;
    return;
}

$cb2_cnt = 0;
sub callback2 {
    print "Timer value in callback2 is: $_[0]";
    $cb2_cnt++;
    return;
}

1;


##</code><code>##

Here in thread1..calling CCB2
Time in C-Callback2: 1289205658.  Prior ctx 0d
Use of inherited AUTOLOAD for non-method main::1289205658() is deprecated at cback_test3.pl line 137.
Segmentation fault

##</code><code>##

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

#include "ppport.h"

#include <pthread.h>
static PerlInterpreter *orig_perl=NULL;

SV* cb_ptr1 = NULL;
SV* cb_ptr2 = NULL;

void InvokeCB ()
{
   static int val = 0;
   SV * sv;

   val++;
   Perl_set_context(orig_perl);
   printf("curr_ctx is %lud\n", Perl_get_context());
   dSP;
   ENTER;
   SAVETMPS;
   PUSHMARK(SP);

   if (val >= 5)
      sv = cb_ptr2;
   else
      sv = cb_ptr1;

   printf("invoking %lud\n", sv);
   XPUSHs(sv_2mortal(newSViv(val)));
                                                                                   PUTBACK;
   call_sv(sv, G_DISCARD);

   FREETMPS;
   LEAVE;
}

void * BGThread(void * dontcare)
{
   while (1)
   {
      sleep(5);
      InvokeCB();
   }
}


MODULE = myModule               PACKAGE = myModule

int
RegisterCB1 (SV *SubRef)
    CODE:
       orig_perl = Perl_get_context();
       printf("orig_ctx is %lud\n", orig_perl);
       pthread_t tid;
       pthread_create(&tid, NULL, BGThread, NULL);
       orig_perl = PERL_GET_CONTEXT;
       cb_ptr1 = SubRef;
       printf("registered %lud\n", cb_ptr1);
       RETVAL = 1;
    OUTPUT:
       RETVAL

int
RegisterCB2 (SV *SubRef)
    CODE:
       cb_ptr2 = SubRef;
       printf("registered %lud\n", cb_ptr1);
       RETVAL = 1;
    OUTPUT:
       RETVAL


##</code><code>##


#! /usr/local/bin/perl

use myModule;
use warnings;

$cb_done1 = 0;
$cb_done2 = 0;
@results = ();

sub cb_one
{
  ($value) = @_;
   print "cb_onr called. val received : ", $value, "\n";
   $results[scalar(@results)] = $value;

   if ($value == 5)
   {
      print "cb_done changed to one.\n";
      $cb_done1 = 1;
   }
}

sub cb_two
{
  ($value) = @_;
   print "cb_two called. val received : ", $value, "\n";
   $results[scalar(@results)] = $value;

   if ($value == 10)
   {
      print "cb_done2 changed to one.\n";
      $cb_done2 = 1;
   }
}

print "Registering CB1...\n";

$status = myModule::RegisterCB1(\&main::cb_one);
do
{
   print "Waiting for CB1 to be done...\n";
   sleep (1);
} until ($cb_done1 == 1);

print "CB1 was invoked : $cb_done1\n";
print "results are : @results \n";

$status = myModule::RegisterCB2(\&main::cb_two);
do
{
   print "Waiting for CB2 to be done...\n";
   sleep (1);
} until ($cb_done2 == 1);

print "CB2 was invoked : $cb_done2\n";
print "results are : @results \n";


##</code><code>##

Registering CB1...
orig_ctx is 151171080d
registered 151189632d
Waiting for CB1 to be done...
Waiting for CB1 to be done...
Waiting for CB1 to be done...
Waiting for CB1 to be done...
Waiting for CB1 to be done...
curr_ctx is 151171080d
invoking 151189632d
Undefined subroutine &main::1 called at test.pl line 42.
make: *** [test_dynamic] Error 255