view release on metacpan or  search on metacpan

lib/CPANPLUS/YACSmoke/IniFiles.pm  view on Meta::CPAN

	return $self->{file_mode};
}

=head2 WriteConfig ($filename [, %options])

Writes out a new copy of the configuration file.  A temporary file
(ending in '-new') is written out and then renamed to the specified
filename.  Also see B<BUGS> below.

If C<-delta> is set to a true value in %options, and this object was
imported from another (see L</new>), only the differences between this
object and the imported one will be recorded. Negative deltas will be
encoded into comments, so that a subsequent invocation of I<new()>
with the same imported object produces the same results (see the
I<-negativedeltas> option in L</new>).

C<%options> is not required.

Returns true on success, C<undef> on failure.

=cut

sub WriteConfig {
  my ($self, $file, %parms)=@_;
  %parms = () unless %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) ) {
    if (-e $file) {
          if (not (-w $file))
          {
                  #carp "File $file is not writable.  Refusing to write config";
                  return undef;
          }
          my $mode = (stat $file)[2];
          $self->{file_mode} = sprintf "%04o", ($mode & 0777);
          #carp "Using mode $self->{file_mode} for file $file";
    } elsif (defined($self->{file_mode}) and not (oct($self->{file_mode}) & 0222)) {
          #carp "Store mode $self->{file_mode} prohibits writing config";
    }
  
    my $new_file = $file . "-new";
    local(*F);
    open(F, "> $new_file") || do {
      carp "Unable to write temp config file $new_file: $!";
      return undef;
    };
    my $oldfh = select(F);
    $self->OutputConfig($parms{-delta});
    close(F);
    select($oldfh);
    rename( $new_file, $file ) || do {
      carp "Unable to rename temp config file ($new_file) to $file: $!";
      return undef;
    };
    if (exists $self->{file_mode}) {
      chmod oct($self->{file_mode}), $file;
    }
  
  } # Otherwise, reset to the start of the file and write, unless we are using STDIN
  else {
    # 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;
    }
    
    
    # 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, 0 );
      my $oldfh = select($fh);
      $self->OutputConfig($parms{-delta});
      seek( $fh, 0, 0 );
      select($oldfh);
    } # end if

  } # end if (filehandle/name)
  
  return 1;
  
}

=head2 RewriteConfig

Same as WriteConfig, but specifies that the original configuration
file should be rewritten.

=cut

sub RewriteConfig {
  my $self = shift;
  
  return undef if (
    (not exists $self->{cf}) or
    (not defined $self->{cf}) or
    ($self->{cf} eq '')
  );
  
  # Return whatever WriteConfig returns :)
  $self->WriteConfig($self->{cf});
}

=head2 GetFileName

Returns the filename associated with this INI file.

If no filename has been specified, returns undef.

=cut