git.maemo.org Git - pkg-perl/blob - deb-src/libfilter-perl/libfilter-perl-1.34/tee/tee.xs

   1 /*
   2  * Filename : tee.xs
   3  *
   4  * Author   : Paul Marquess
   5  * Date     : 26th March 2000
   6  * Version  : 1.01
   7  *
   8  */
   9
  10 #include "EXTERN.h"
  11 #include "perl.h"
  12 #include "XSUB.h"
  13 #include "../Call/ppport.h"
  14
  15 static I32
  16 filter_tee(pTHX_ int idx, SV *buf_sv, int maxlen)
  17 {
  18     I32 len;
  19     PerlIO * fil = (PerlIO*) SvIV(FILTER_DATA(idx)) ;
  20     int old_len = SvCUR(buf_sv) ;
  21
  22     if ( (len = FILTER_READ(idx+1, buf_sv, maxlen)) <=0 ) {
  23         /* error or eof */
  24         PerlIO_close(fil) ;
  25         filter_del(filter_tee);      /* remove me from filter stack */
  26         return len;
  27     }
  28
  29     /* write to the tee'd file */
  30     PerlIO_write(fil, SvPVX(buf_sv) + old_len, len - old_len) ;
  31
  32     return SvCUR(buf_sv);
  33 }
  34
  35 MODULE = Filter::tee    PACKAGE = Filter::tee
  36
  37 PROTOTYPES:     DISABLE
  38
  39 void
  40 import(module, filename)
  41     SV *        module = NO_INIT
  42     char *      filename
  43     CODE:
  44         SV   * stream = newSViv(0) ;
  45         PerlIO * fil ;
  46         char * mode = "wb" ;
  47
  48         filter_add(filter_tee, stream);
  49         /* check for append */
  50         if (*filename == '>') {
  51             ++ filename ;
  52             if (*filename == '>') {
  53                 ++ filename ;
  54                 mode = "ab" ;
  55             }
  56         }
  57         if ((fil = PerlIO_open(filename, mode)) == NULL)
  58             croak("Filter::tee - cannot open file '%s': %s",
  59                         filename, Strerror(errno)) ;
  60
  61         /* save the tee'd file handle */
  62         SvIV_set(stream, (IV)fil) ;
  63