ru.perl

 
 - RU.PERL ----------------------------------------------------------------------
 From : Alexey Froloff                       2:5020/1437.4  24 Sep 2000  19:23:42
 To : All
 Subject : sv_2mortal
 -------------------------------------------------------------------------------- 
 

 
     Я тyт подyyмал, и pешил набpосать паpy стpок на темy "sv_2mortal"...
 
     Опять вылезает 'Attempt to free unreferenced scalar', но уже когда я делаю
 perl_call_sv()... Варнинг пишет по два раза на каждый вызов, от содержимого sub 
 BeforeSend не зависит.
 
 P.S. Может не XPUSHs надо делать, а XPUSHp?
 
 int BeforeSend(flist_t *l)
 {
   char *errsv_pv, *pv_tosend = NULL, *pv_sendas = NULL;
   STRLEN n_a;
   int save_err, pid, rc, iv_rc = 0;
   static char *ftypes[]={"PKT", "ARC", "FILE", "REQ", "ERR"};
 
   if(!qperl)
     return 0;
 
 // Хватаем в паралельном процессе STDERR и выводим его в лог.
   pid = handle_perl_err(&save_err);
   { dSP;
 // Здесь заполняется некий хэш.
     export_rnode();
     ENTER;
     SAVETMPS;
     PUSHMARK(SP);
 // Параметры
     XPUSHs(sv_2mortal(newSVpv(ftypes[l->type], 0)));
     XPUSHs(sv_2mortal(newSVpv(l->tosend, 0)));
     XPUSHs(sv_2mortal(newSVpv(l->sendas, 0)));
     PUTBACK;
     rc=perl_call_pv("BeforeSend", G_EVAL|G_ARRAY);
     SPAGAIN;
 // Hу и возвращается List...
     switch(rc){
       case 3:
         pv_sendas = POPpx;
         if(!n_a)
           pv_sendas = NULL;
         if(pv_sendas){
           sfree(l->sendas);
           l->sendas = strdup(pv_sendas);
         }
       case 2:
         pv_tosend = POPpx;
         if(!n_a)
           pv_tosend = NULL;
         if(pv_tosend){
           sfree(l->tosend);
           l->tosend = strdup(pv_tosend);
         }
       case 1:
         iv_rc = POPi;
       case 0:
         break;
       default:
         write_log("PERL: wrong retval count from BeforeSend (%d)", rc);
     }
     PUTBACK;
     FREETMPS;
     LEAVE;
 // Вернули STDERR взад.
     unhandle_perl_err(save_err, pid);
     if(SvTRUE(ERRSV)){
       errsv_pv = SvPV(ERRSV, n_a);
       if(errsv_pv[strlen(errsv_pv)-1] == '\n')
         errsv_pv[strlen(errsv_pv)-1] = 0;
       write_log("PERL: BeforeSend eval error: %s", errsv_pv);
       return 0;
     }
     return iv_rc;
   }
   return 0;
 }
 
                               Regards, Sir Raorn.
 
 ... The reason computer chips are so small is computers don't eat much.
 --- GoldED+/LNX 1.1.4.6-sr Registered Linux User #177282
  * Origin: ASHes to ASHes, DOS to DOS. (2:5020/1437.4)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор