I understand it but could you help me more? :) I try this:

...
__END__
__C__


void my_print(FILE *f)
{
 fputs("TEXT",f);
}
[download]

But its not work too :( Do you have some simple code for me? :)

Don't use puts/fputs. clib doesn't know anything about Perl. Use the functions such as PerlIO_puts in the linked document instead.

The problem with FCGI is that it uses tied handles. As a quick check of the source reveals, it attaches "magic" to the filehandles in order to bind read/write calls, etc. to its own stream implementation (underneath PerlIO) — see NewStream() in fcgiapp.c, and FCGI_Bind() in FCGI.XL, if interested.

In other words, the simple approach specifying PerlIO * fh in combination with PerlIO_puts() doesn't work here, as it fails to resolve the associated magic.  For example, the following piece of code doesn't work for essentially the same reasons:

#!/usr/bin/perl

use IO::Handle;
use Inline (Config =>
                   DIRECTORY => '/tmp/Inline',
           );
use Inline 'C';

my $out = new IO::Handle();

tie *$out, "MyFH";

print $out "Content-type: text/html\r\n\r\n";
my_print($out);


package MyFH;

sub TIEHANDLE {
    my $class = shift;
    open my $fh, ">", "test.out" or die $!;
    bless $fh, $class;
}

sub PRINT {
    my $self = shift;
    print $self @_;
}

__END__
__C__

void my_print(PerlIO *fh)
{
     PerlIO_puts(fh, "TEXT");
}
[download]

While the "Content-type..." line ends up in "test.out" as expected, the string "TEXT" does not.  OTOH, with a normal filehandle as $out, everything works fine (as already shown by oshalla).

Unfortunately, I don't have the time at the moment to work out the details of how to properly handle that magic on the XS side (tied filehandles are kinda special beasts, with hardly any documentation available besides the sources...) — in particular as this would entail not only figuring out how to do it in XS, but also how to then have Inline::C auto-generate the required code...

If someone else feels like tackling this, please go ahead, and let us know what you come up with :)

doh! I suspected they were tied handles, but I figured PerlIO_* would handle that. Otherwise, you end up with the following:

/* Returns TRUE on success. Sets errno on error. */
int my_print(SV* sv) {
    GV* const   gv = PL_defoutgv;
    IO*         io;
    MAGIC*      mg;
    PerlIO*     fp;
    int         success;
    const char* buf;
    STRLEN      to_write;

    io = GvIO(gv);
    if (!io && GvEGV(gv)) {
        io = GvIO(GvEGV(gv));
    }
    if (!io) {
        return FALSE;
    }

    mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
    if (mg) {
        dSP;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(SvTIED_obj((SV*)io, mg));
        XPUSHs(sv);
        PUTBACK;

        call_method("PRINT", G_SCALAR);

        SPAGAIN;
        success = 0 != POPi;
        PUTBACK;

        FREETMPS;
        LEAVE;

        return success;
    }

    fp = IoOFP(io);
    if (!fp) {
        return FALSE;
    }

    buf = SvPV(sv, to_write);
    while (to_write > 0) {
        int written = PerlIO_write(fp, buf, to_write);
        if (written < 0) {
            return FALSE;
        }

        buf      += written;
        to_write -= written;
    }

    return TRUE;
}
[download]

(Untested. Based in part on code from pp_print, the function that implements the print operator.)

That writes the the currently selected handle. It shouldn't need much work to work with any handle. Why isn't this already supplied by Perl? Or did I overlook it?

Update: Arg! It's not complete. There are encoding issues.

If s is assumed to be bytes,

• If PerlIO_isutf8(fp) is true, s needs to be converted to UTF-8 (i.e. perform an utf8::upgrade).

If s is assumed to be UTF-8,

• If PerlIO_isutf8(fp) is false and the bytes pragma isn't in effect, s needs to be converted to iso-8859-1 (i.e perform an utf8::downgrade).

Does calling CORE::print work from XS? That would be simpler! If it doesn't work, it would still be simpler to write a Perl wrapper for print and call that.

Update: Fixed compilation errors. Didn't address the problem mentioned above.

If someone else feels like tackling this, please go ahead, and let us know what you come up with :)

Your demo script works for me as is, if you change the XSub (my_print) to:

void my_print(SV * fh) {
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    XPUSHs(sv_2mortal(fh));
    XPUSHs(sv_2mortal(newSVpv("TEXT", 0)));
    PUTBACK;

    call_pv("MyFH::PRINT", G_DISCARD);

    FREETMPS;
    LEAVE;
}
[download]

Update: Changed PUSHs(fh) to XPUSHs(sv_2mortal(fh)). (Still sems to do the required task.)

This can quite possibly be improved (there are a few things that I ought to check regarding sins that are perhaps being committed) ... but, given the convoluted nature of what it does, I'm not even sure that it's helpful.

Cheers,
Rob

ikegami: I can't compile your C code with my perl code :(

I fixed the compilation errors. But like I said, it would make more sense to actually call print:

package MyModule;

use Inline Config => (
    DIRECTORY => './Inline',
);

use Inline 'C';

sub _fprint { print { shift } @_ }

# ...

1;

__END__
__C__


int my_print(SV* fh, SV* sv) {
    int result;

    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    XPUSHs(fh);
    XPUSHs(sv);
    PUTBACK;

    call_pv("MyModule::_fprint", G_SCALAR);

    SPAGAIN;
    result = POPi;
    PUTBACK;

    FREETMPS;
    LEAVE;

    return result;
}
[download]