view release on metacpan or  search on metacpan

lib/Config/IniFiles.pm  view on Meta::CPAN

    return $self->{file_mode};
}


sub _write_config_to_filename
{
    my ( $self, $filename, %parms ) = @_;

    if ( -e $filename )
    {
        if ( not( -w $filename ) )
        {
            #carp "File $filename is not writable.  Refusing to write config";
            return undef;
        }
        if ( not exists $self->{file_mode} )
        {
            my $mode = ( stat $filename )[2];
            $self->{file_mode} = sprintf "%04o", ( $mode & 0777 );
        }

        #carp "Using mode $self->{file_mode} for file $file";
    }

    my ( $fh, $new_file );

    # We need to trap the exception that tempfile() may throw and instead
    # carp() and return undef() because that was the previous behaviour:
    #
    # See RT #77039 ( https://rt.cpan.org/Ticket/Display.html?id=77039 )
    eval {
        ( $fh, $new_file ) =
            tempfile( "temp.ini-XXXXXXXXXX", DIR => dirname($filename) );

        # Convert the filehandle to a "text" filehandle suitable for use
        # on Windows (and other platforms).
        #
        # This may break compatibility for ultra-old perls (ones before 5.6.0)
        # so I say - Good Riddance!
        if ( $^O =~ m/\AMSWin/ )
        {
            binmode $fh, ':crlf';
        }
    };

    if ($@)
    {
        carp("Unable to write temp config file: $!");
        return undef;
    }

    $self->OutputConfigToFileHandle( $fh, $parms{-delta} );
    close($fh) or Carp::confess("close failed: $!");
    if ( !rename( $new_file, $filename ) )
    {
        carp "Unable to rename temp config file ($new_file) to ${filename}: $!";
        return undef;
    }
    if ( exists $self->{file_mode} )
    {
        if ( not chmod( oct( $self->{file_mode} ), $filename ) )
        {
            carp "Unable to chmod $filename!";
        }
    }

    return 1;
}

sub _write_config_with_a_made_fh
{
    my ( $self, $fh, %parms ) = @_;

    # Only roll back if it's not STDIN (if it is, Carp)
    if ( $fh == \*STDIN )
    {
        carp "Cannot write configuration file to STDIN.";
    }
    else
    {
        seek( $fh, 0, SEEK_SET() );

        # Make sure to keep the previous junk out.
        # See:
        # https://rt.cpan.org/Public/Bug/Display.html?id=103496
        truncate( $fh, 0 );
        $self->OutputConfigToFileHandle( $fh, $parms{-delta} );
        seek( $fh, 0, SEEK_SET() );
    }    # end if

    return 1;
}

sub _write_config_to_fh
{
    my ( $self, $file, %parms ) = @_;

    # Get a filehandle, allowing almost any type of 'file' parameter
    ## NB: If this were a filename, this would fail because _make_file
    ##     opens a read-only handle, but we have already checked that case
    ##     so re-using the logic is ok [JW/WADG]
    my $fh = $self->_make_filehandle($file);

    if ( !$fh )
    {
        carp "Could not find a filehandle for the input stream ($file): $!";
        return undef;
    }

    return $self->_write_config_with_a_made_fh( $fh, %parms );
}

sub WriteConfig
{
    my ( $self, $file, %parms ) = @_;

    return undef unless defined $file;

    # If we are using a filename, then do mode checks and write to a
    # temporary file to avoid a race condition
    if ( !ref($file) )
    {
        return $self->_write_config_to_filename( $file, %parms );