view release on metacpan or  search on metacpan

t/019_fileio.t  view on Meta::CPAN

        // Write to a file retrieved from the struct
        DLLEXPORT void log_message(Logger* logger, const char* msg) {
            if (logger->log_file) {
                fprintf(logger->log_file, "[%d] %s\n", ++logger->counter, msg);
                fflush(logger->log_file);
            }
        }

        // Return a struct containing a file pointer
        DLLEXPORT Logger create_logger(FILE* fp) {
            Logger l;
            l.log_file = fp;
            l.counter = 100;
            return l;
        }
        END_C

    # Define the struct type in Perl.
    # Use Pointer[File] because the C struct member is FILE*.
    typedef Logger => Struct [ log_file => Pointer [File], counter => Int ];

    # Bind functions
    affix $lib, 'init_logger',   [ Pointer [ Logger() ], Pointer [File] ] => Void;
    affix $lib, 'log_message',   [ Pointer [ Logger() ], String ]         => Void;
    affix $lib, 'create_logger', [ Pointer [File] ] => Logger();
    subtest 'File inside Struct (Pointer)' => sub {
        my ( $fh, $filename ) = tempfile();
        my $old_fh = select($fh);
        $| = 1;
        select($old_fh);

        # Allocate struct memory
        my $logger = malloc( sizeof( Logger() ) );

        # Pass filehandle to C to store in struct
        init_logger( $logger, $fh );

        # Verify via C function
        log_message( $logger, 'First message' );
        log_message( $logger, 'Second message' );

        # Verify Perl side struct access
        # Note: Pulling a File handle usually creates a new GLOB wrapper around the FILE*
        # Since we own $fh, let's verify checking against undef works
        my $logger_struct = cast( $logger, Logger() );    # View as struct
        my $retrieved_fh  = $logger_struct->{log_file};
        ok $retrieved_fh, 'Retrieved filehandle from struct';
        is ref($retrieved_fh), 'GLOB', 'It is a glob';

        # Write from Perl using retrieved handle
        # print {$retrieved_fh} "From Perl\n"; # Careful, might double-close if not careful
        # Check file content
        open my $check, '<', $filename;
        my @lines = <$check>;
        close $check;
        is scalar(@lines), 2, 'File has 2 lines';
        like $lines[0], qr/\[1\] First message/,  'Line 1 matches';
        like $lines[1], qr/\[2\] Second message/, 'Line 2 matches';
        free($logger);

        # Keep $fh alive until test end to avoid closing underneath C
        close $fh;
    };
    subtest 'File inside Struct (Value Return)' => sub {
        my ( $fh, $filename ) = tempfile();
        my $old_fh = select($fh);
        $| = 1;
        select($old_fh);

        # Call C function returning a struct by value
        my $logger_hash = create_logger($fh);
        is $logger_hash->{counter}, 100, 'Counter is correct';
        ok $logger_hash->{log_file}, 'Got filehandle back';
        is ref( $logger_hash->{log_file} ), 'GLOB', 'It is a glob';

        # Write using the returned handle to verify it works
        # Note: $logger_hash->{log_file} wraps the same FILE* as $fh.
        ok syswrite( $logger_hash->{log_file}, "Direct write from Perl\n" ), 'syswrite to the handle from Perl';

        # To avoid double-close warnings, we let Perl handle cleanup of the glob
        # but be careful about explicit closes.
        undef $logger_hash;

        # Check
        open my $check, '<', $filename;
        my $content = <$check>;
        close $check;
        is $content, "Direct write from Perl\n", 'Handle returned in struct is usable';
        close $fh;
    };
    subtest 'File in Array' => sub {
        my $lib2 = compile_ok(<<~'END_C2');
        #include "std.h"
        //ext: .c

        #include <stdio.h>

        DLLEXPORT void write_all(FILE* files[3], const char* msg) {
            for(int i=0; i<3; i++) {
                if(files[i]) fprintf(files[i], "%s", msg);
            }
        }
        END_C2

        # Array of Pointers to Files (FILE* files[3])
        affix $lib2, 'write_all', [ Array [ Pointer [File], 3 ], String ] => Void;
        my ( $fh1, $f1 ) = tempfile();
        my ( $fh2, $f2 ) = tempfile();
        my ( $fh3, $f3 ) = tempfile();

        # Flush buffers
        for my $h ( $fh1, $fh2, $fh3 ) { my $o = select($h); $| = 1; select($o); }

        # Pass array of handles
        write_all( [ $fh1, $fh2, $fh3 ], 'Broadcast' );
        close $_ for ( $fh1, $fh2, $fh3 );

        # Verify
        for my $f ( $f1, $f2, $f3 ) {
            open my $in, '<', $f;
            is <$in>, 'Broadcast', "File $f written to";