view release on metacpan or  search on metacpan

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

=cut

sub getPath($) {
  my $self = shift;
  return $self->{full_path} if defined($self->{full_path});

  # No config file already defined
  # check all given paths in the given order
  my @p = $self->paths;
  foreach my $path (@p) {
    #print "DBG:path=$path\n";
    my $appdir = File::HomeDir->my_dist_data($self->toolname) || "";
    $path =~ s/^__APPDIR__$/$appdir/;
    #print "DBG:path=$path\n";
    if (-e $path) {
      my $full_path = File::Spec->rel2abs(File::Spec->join($path, $self->filename));
      if (-e "$full_path") {
	$self->{full_path} = $full_path;
	return $self->{full_path};
      }
    }
  }
  # No config file found
  # try to create a config file in all given paths in the given order
  foreach my $path ($self->paths) {
    #print "DBG3:path=$path\n";
    if ($path =~ m/^__APPDIR__$/) {
      my $appdir = File::HomeDir->my_dist_data($self->toolname, { create => 1 });
      $path =~ s/^__APPDIR__$/$appdir/;
    }
    #print "DBG4:path=$path\n";
    if (-e $path) {
      my $full_path = File::Spec->rel2abs(File::Spec->join($path, $self->filename));
      print "Creation of a default config file for ".$self->toolname.": $full_path\n";
      my $current_default_config = $self->defaultContent;
      $current_default_config =~ s/^\s+//;
      $current_default_config =~ s/\s+$/\n/;
      my $v = $self->version;
      $current_default_config =~ s/__VERSION__/$v/;
      open (CFG_FILE, ">".$full_path) or croak "Unable to create config file [".$full_path."]: $!";
      print CFG_FILE $current_default_config;
      close(CFG_FILE);
      $self->{full_path} = $full_path;
      return $self->{full_path};
    }
  }
  return undef;
}

=item * Method C<update>

This method check if the current config file is up-to-date and proposes an update if it is not.
The update tries to preserve custom user's settings.

Usage:

  $cfg->update();

=cut

sub update($) {
  my $self = shift;

  # Check if config file is up-to-date
  open (CFG_FILE, "<".$self->getPath) or croak "Unable to open config file [".$self->getPath."]: $!";
  my @versions = $self->versions;
  my $current_user_config_version = $versions[-1];
  my $current_user_config = "";
  while (<CFG_FILE>) {
    $current_user_config .= $_;
    if (/^#.*configuration file (\d+.\d+.\d+.*)$/) {
      $current_user_config_version = $1;
    }
  }
  close(CFG_FILE);
  #print "*** Current user use config file version $current_user_config_version:\n$current_user_config*** EOF\n";
  if ($current_user_config_version ne $self->version) {
    my $diffs;
    print "Your configuration file [".$self->getPath."] is not up-to-date!\n";
    eval {
      # Computing original corresponding version file
      my $old_default_config = $self->getDefaultContent($current_user_config_version);
      $old_default_config =~ s/$current_user_config_version/__VERSION__/;
      # Diffing original corresponding version file with potentially modified file
      $current_user_config =~ s/$current_user_config_version/__VERSION__/;
      $diffs = diff(\$old_default_config, \$current_user_config, { STYLE => 'OldStyle' });
      if ($diffs) {
	#print "*** Diffs between corresponding obsolete default version:\n$diffs*** END\n";
	# Trying to apply these diffs to up-to-date version...
	$current_user_config = patch($self->defaultContent, $diffs, { STYLE => 'OldStyle' });
	#print "DBG:::\n".$self->getDefaultContent."DBG:::\n";
      } else {
	$current_user_config = $self->getDefaultContent;
      }
      my $v = $self->version;
      $current_user_config =~ s/__VERSION__/$v/;
      $_ = 1;
    } or do {
      #print "Unable to automatically propose an update for this file\n";
      $current_user_config = $self->getDefaultContent;
      my $v = $self->version;
      $current_user_config =~ s/__VERSION__/$v/;
    };
    #print "*** diff between v. $current_user_config_version and ".$self->version." ***\n";
    print diff($self->getPath, \$current_user_config, { STYLE => "Table", FILENAME_B => "Proposed Up-to-date config file"});
    my $answer;
    if ($self->interactive) {
      print "Do you want to upgrade your configuration file [".($diffs ? "y/N" : "Y/n")."] ? ";
      $answer = <STDIN>;
    } else {
      $answer = "Y\n";
    }
    if (($answer eq "Y\n") or ($answer eq "y\n") or (!$diffs and ($answer eq "\n"))) {
      print "Upgrading the config file for ".$self->toolname.": ".$self->getPath."\n";
      open (CFG_FILE, ">".$self->getPath) or croak "Unable to create config file [".$self->getPath."]: $!";
      print CFG_FILE $current_user_config;
      close(CFG_FILE);
    } else {
      if ($self->interactive) {
	print "Do you want to continue [y/N] ? ";
	$answer = <STDIN>;