view release on metacpan or  search on metacpan

KontoCheck.xs  view on Meta::CPAN

iban2bic_i(iban...)
   char *iban;
PREINIT:
   char blz[16],kto[16];
   const char *bic;
   int ret;
CODE:
   if(items!=4){
      Perl_croak(aTHX_ "Business::KontoCheck::iban2bic_i() requires 4 arguments, %d are given",(int)items);
      RETVAL=0;
   }
   else{
      bic=iban2bic(iban,&ret,blz,kto);
      sv_setiv(ST(1),ret);
      SvSETMAGIC(ST(1));
      if(ret>0){
         sv_setpv((SV*)ST(2),blz);
         SvSETMAGIC(ST(2));
         sv_setpv((SV*)ST(3),kto);
         SvSETMAGIC(ST(3));
      }
      RETVAL=bic;
   }
OUTPUT:
   RETVAL

int
ipi_check(zweck)
   char *zweck;

int 
ipi_gen_i(zweck...)
   char *zweck;
PREINIT:
   char ipi_buffer[24],ipi_papier[32];
CODE:
   if(items<1 || items>3)Perl_croak(aTHX_ "Usage: Business::KontoCheck::ipi_gen(zweck[,zweck_edv[,zweck_papier]])");
   RETVAL=ipi_gen(zweck,ipi_buffer,ipi_papier);
   if(items>=2){
      sv_setpv((SV*)ST(1),ipi_buffer);
      SvSETMAGIC(ST(1));
   }
   if(items==3){
      sv_setpv((SV*)ST(2),ipi_papier);
      SvSETMAGIC(ST(2));
   }
OUTPUT:
   RETVAL

void
lut_suche_volltext_i(want_array,search...)
   int want_array;
   char *search;
PREINIT:
#line 1046 "KontoCheck.lx"
   char **base_name;
   int i,ret,anzahl,anzahl_name,start_name_idx,*start_idx,*zw,*bb;
   int sort,uniq,anzahl2,*idx_o,*cnt_o;
   AV *zweigstelle,*blz_array,*vals,*cnt_array;
   SV *zweigstelle_p,*blz_array_p,*vals_p,*cnt_array_p;
PPCODE:
   if(items<2 || items>5)Perl_croak(aTHX_ "Usage: Business::KontoCheck::lut_suche_volltext(suchworte[,retval[,uniq[,sort]]])");
   ret=lut_suche_volltext(search,&anzahl_name,&start_name_idx,&base_name,&anzahl,&start_idx,&zw,&bb);
   if(items>=3){
      sv_setiv(ST(2),(IV)ret);
      SvSETMAGIC(ST(2));
   }

   sort=uniq=-1;
   if(items>=4)uniq=(int)SvIV(ST(3));
   if(items>=5)sort=(int)SvIV(ST(4));
   if(uniq>0)
      uniq=2;
   else if(uniq<=0 && sort>0)
      uniq=1;
   else if(uniq<0 && sort<0)
      uniq=UNIQ_DEFAULT_PERL;
   if(uniq) /* bei uniq>0 sortieren, uniq>1 sortieren + uniq */
      lut_suche_sort1(anzahl,bb,zw,start_idx,&anzahl2,&idx_o,&cnt_o,uniq>1);
   else{
      anzahl2=anzahl;
      idx_o=start_idx;
      cnt_o=NULL;
   }

   blz_array=newAV();
   if(anzahl2){
      /* das BLZ-Array und cnt-Array auch in ein neues Array kopieren und als Referenz zurückgeben */
      av_unshift(blz_array,anzahl2); /* Platz machen */
      for(i=0;i<anzahl2;i++)av_store(blz_array,i,newSViv(bb[idx_o[i]]));
   }
   blz_array_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)blz_array)));

   if(want_array){   /* die drei nächsten Arrays werden nur bei Bedarf gefüllt */
      zweigstelle=newAV();
      vals=newAV();
      cnt_array=newAV();
      if(anzahl2){
            /* die Zweigstellen und Werte in ein neues Array kopieren, dann als Referenz zurückgeben */
         av_unshift(vals,anzahl_name);    /* Platz machen */
         av_unshift(zweigstelle,anzahl2);
         if(cnt_o)av_unshift(cnt_array,anzahl2);
         for(i=0;i<anzahl_name;i++)av_store(vals,i,newSVpvf("%s",base_name[start_name_idx+i]));
         for(i=0;i<anzahl2;i++){
            av_store(zweigstelle,i,newSViv(zw[idx_o[i]]));
            if(cnt_o)av_store(cnt_array,i,newSViv(cnt_o[i]));
         }
      }
      if(uniq){
         kc_free((char*)idx_o);
         kc_free((char*)cnt_o);
      }
      zweigstelle_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)zweigstelle)));
      vals_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)vals)));
      cnt_array_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)cnt_array)));
      XPUSHs(blz_array_p);
      XPUSHs(zweigstelle_p);
      XPUSHs(vals_p);
      XPUSHs(sv_2mortal(newSViv(ret)));
      XPUSHs(cnt_array_p);
      XSRETURN(5);
   }
   else{
      if(uniq){
         kc_free((char*)idx_o);
         kc_free((char*)cnt_o);
      }
      XPUSHs(blz_array_p);
      XSRETURN(1);
   }

void
lut_suche_multiple_i(want_array,search...)
   int want_array;
   char *search;
PREINIT:
#line 1127 "KontoCheck.lx"
   char *such_cmd;
   int i,uniq,ret;
   UINT4 anzahl,*blz,*zweigstellen;
   AV *zweigstellen_array,*blz_array;
   SV *zweigstelle_p,*blz_array_p;
PPCODE:

            /* Anzahl, BLZ, Zweigstellen: nur Rückgabeparameter */
   switch(items){
      case 2:  /* keine zusätzlichen Parameter */
         uniq=UNIQ_DEFAULT_PERL;
         such_cmd=NULL;
         break;
      case 3:  /* nur uniq */
         uniq=SvIV(ST(2));
         such_cmd=NULL;
         break;
      case 4:
      case 5:
         uniq=SvIV(ST(2));
         such_cmd=SvPV_nolen(ST(3));
         break;
      default:
         Perl_croak(aTHX_ "Usage: Business::KontoCheck::lut_suche_multiple(search_words[,uniq[,search_cmd[,ret]]])");
         break;
   }

   ret=lut_suche_multiple(search,uniq,such_cmd,&anzahl,&zweigstellen,&blz);
   if(items>4){   /* retval zurückgeben */
      sv_setiv(ST(4),(IV)ret);
      SvSETMAGIC(ST(4));
   }

   blz_array=newAV();
   if(anzahl){
      /* das BLZ-Array auch in ein neues Array kopieren und als Referenz zurückgeben */
      av_unshift(blz_array,anzahl); /* Platz machen */
      for(i=0;i<anzahl;i++)av_store(blz_array,i,newSViv(blz[i]));
   }
   blz_array_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)blz_array)));

   if(want_array){   /* das nächste Array wird nur bei Bedarf gefüllt */
      zweigstellen_array=newAV();
      if(anzahl){
            /* die Zweigstellen in ein neues Array kopieren, dann als Referenz zurückgeben */
         av_unshift(zweigstellen_array,anzahl);
         for(i=0;i<anzahl;i++)av_store(zweigstellen_array,i,newSViv(zweigstellen[i]));
      }
      kc_free((char*)zweigstellen);
      kc_free((char*)blz);
      zweigstelle_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)zweigstellen_array)));
      XPUSHs(blz_array_p);
      XPUSHs(zweigstelle_p);
      XPUSHs(sv_2mortal(newSViv(ret)));
      XSRETURN(3);
   }
   else{
      kc_free((char*)zweigstellen);
      kc_free((char*)blz);
      XPUSHs(blz_array_p);
      XSRETURN(1);
   }

void
lut_suche_c(want_array,art...)
   int want_array;
   int art;
PREINIT:
#line 1195 "KontoCheck.lx"
   char *search,**base_name,warn_buffer[128],*fkt;
   int i,ret,anzahl,*start_idx,*zw,*bb;
   int sort,uniq,anzahl2,*idx_o,*cnt_o;
   STRLEN len;
   AV *zweigstellen_array,*blz_array,*vals,*cnt_array;
   SV *zweigstelle_p,*blz_array_p,*vals_p,*cnt_array_p;
PPCODE:
   switch(art){
      case 1:
         fkt="bic";
         break;
      case 2:
         fkt="namen";
         break;
      case 3:
         fkt="namen_kurz";
         break;
      case 4:
         fkt="ort";
         break;
      default:
         fkt=NULL;
         break;
   }
   if(items>2 && items<7)
      search=SvPV(ST(2),len);
   else{
      if(fkt)
         snprintf(warn_buffer,128,"Usage: Business::KontoCheck::lut_suche_%s(%s[,retval[,uniq[,sort]]])",fkt,fkt);
      else
         snprintf(warn_buffer,128,"unknown internal subfunction for lut_suche_c");
      Perl_croak(aTHX_ "%s",warn_buffer);
   }
   switch(art){   /* die entsprechenden Funktionen aufrufen */
      case 1:
         ret=lut_suche_bic(search,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      case 2:
         ret=lut_suche_namen(search,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      case 3:
         ret=lut_suche_namen_kurz(search,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      case 4:
         ret=lut_suche_ort(search,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      default:
         Perl_croak(aTHX_ "unknown internal subfunction for lut_suche_c");
         break;
   }
   if(items>3){
      sv_setiv(ST(3),(IV)ret);
      SvSETMAGIC(ST(3));
   }
   uniq=sort=-1;
   if(items>4)uniq=(int)SvIV(ST(4));
   if(items>5)sort=(int)SvIV(ST(5));
   if(uniq>0)
      uniq=2;
   else if(uniq<=0 && sort>0)
      uniq=1;
   else if(uniq<0 && sort<0)
      uniq=UNIQ_DEFAULT_PERL;
   if(uniq) /* bei uniq>0 sortieren, uniq>1 sortieren + uniq */
      lut_suche_sort1(anzahl,bb,zw,start_idx,&anzahl2,&idx_o,&cnt_o,uniq>1);
   else{
      anzahl2=anzahl;

KontoCheck.xs  view on Meta::CPAN

      cnt_o=NULL;
   }
   blz_array=newAV();
   if(anzahl2){
         /* das BLZ-Array auch in ein neues Array kopieren und als Referenz zurückgeben */
      av_unshift(blz_array,anzahl2); /* Platz machen */
      for(i=0;i<anzahl2;i++)av_store(blz_array,i,newSViv(bb[idx_o[i]]));
   }
   blz_array_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)blz_array)));

   if(want_array){   /* die drei nächsten Arrays werden nur bei Bedarf gefüllt */
      zweigstellen_array=newAV();
      vals=newAV();
      cnt_array=newAV();
      if(anzahl2){
            /* die Zweigstellen und Werte in ein neues Array kopieren, dann als Referenz zurückgeben */
         av_unshift(zweigstellen_array,anzahl2);
         av_unshift(vals,anzahl2);
         if(cnt_o)av_unshift(cnt_array,anzahl2);
         for(i=0;i<anzahl2;i++){
            av_store(zweigstellen_array,i,newSViv(zw[idx_o[i]]));
            av_store(vals,i,newSVpvf("%s",base_name[idx_o[i]]));
            if(cnt_o)av_store(cnt_array,i,newSViv(cnt_o[i]));
         }
      }
      if(uniq){
         kc_free((char*)idx_o);
         kc_free((char*)cnt_o);
      }
      zweigstelle_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)zweigstellen_array)));
      vals_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)vals)));
      cnt_array_p=sv_2mortal((SV*)newRV(sv_2mortal((SV*)cnt_array)));
      XPUSHs(blz_array_p);
      XPUSHs(zweigstelle_p);
      XPUSHs(vals_p);
      XPUSHs(sv_2mortal(newSViv(ret)));
      XPUSHs(cnt_array_p);
      XSRETURN(5);
   }
   else{
      if(uniq){
         kc_free((char*)idx_o);
         kc_free((char*)cnt_o);
      }
      XPUSHs(blz_array_p);
      XSRETURN(1);
   }

void
lut_suche_i(want_array,art...)
   int want_array;
   int art;
PREINIT:
#line 1316 "KontoCheck.lx"
   int search1;
   int search2;
   int i,ret,anzahl,*start_idx,*base_name,*zw,*bb;
   int sort,uniq,anzahl2,*idx_o,*cnt_o;
   AV *zweigstellen_array,*blz_array,*vals,*cnt_array;
   SV *zweigstelle_p,*blz_array_p,*vals_p,*cnt_array_p;
PPCODE:
   sort=uniq=-1;
   switch(items){
      case 3:
         search1=search2=(int)SvIV(ST(2));
         break;
      case 7:  /* alle Parameter mit uniq und sort angegeben */
         sort=(int)SvIV(ST(6));
      case 6:  /* nur uniq angegeben, kein sort */
         uniq=(int)SvIV(ST(5));
      case 4:  /* Angabe von search1 und search2; ret, uniq und sort weggelassen */
      case 5:  /* search1, search2 und ret angegeben */
         search1=(int)SvIV(ST(2));
         search2=(int)SvIV(ST(3));
         break;
      default:
         switch(art){
            case 1:
               Perl_croak(aTHX_ "Usage: Business::KontoCheck::lut_suche_blz(blz1[,blz2[,retval[,uniq[,sort]]]])");
               break;
            case 2:
               Perl_croak(aTHX_ "Usage: Business::KontoCheck::lut_suche_pz(pz1[,pz2[,retval[,uniq[,sort]]]])");
               break;
            case 3:
               Perl_croak(aTHX_ "Usage: Business::KontoCheck::lut_suche_plz(plz1[,plz2[,retval[,uniq[,sort]]]])");
               break;
            case 4:
               Perl_croak(aTHX_ "Usage: Business::KontoCheck::lut_suche_regel(regel1[,regel2[,retval[,uniq[,sort]]]])");
               break;
            default:
               Perl_croak(aTHX_ "unknown internal subfunction for lut_suche_i");
               break;
         }
         break;
   }
   switch(art){   /* die entsprechenden Funktionen aufrufen */
      case 1:
         ret=lut_suche_blz(search1,search2,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      case 2:
         ret=lut_suche_pz(search1,search2,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      case 3:
         ret=lut_suche_plz(search1,search2,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      case 4:
         ret=lut_suche_regel(search1,search2,&anzahl,&start_idx,&zw,&base_name,&bb);
         break;
      default:
         Perl_croak(aTHX_ "unknown internal subfunction for lut_suche_i");
         break;
   }

   if(uniq>0)
      uniq=2;
   else if(uniq<=0 && sort>0)
      uniq=1;
   else if(uniq<0 && sort<0)
      uniq=UNIQ_DEFAULT_PERL;
   if(uniq) /* bei uniq>0 sortieren, uniq>1 sortieren + uniq */
      lut_suche_sort1(anzahl,bb,zw,start_idx,&anzahl2,&idx_o,&cnt_o,uniq>1);