package App::FQStat::Config;
# App::FQStat is (c) 2007-2009 Steffen Mueller
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
use strict;
use warnings;
use App::FQStat::Debug;
use YAML::Tiny ();
use File::HomeDir ();
use File::Spec;
use Term::ANSIScreen qw();
use base 'Exporter';
our %EXPORT_TAGS = (
'all' => [qw(
get_config
set_config
)],
);
our @EXPORT_OK = @{$EXPORT_TAGS{'all'}};
my $YAMLObject;
my $Config;
sub get {
warnenter if ::DEBUG;
if (not defined $Config) {
read_configuration();
}
my $key = shift;
return $Config->{$key};
}
{
no strict;
*get_config = *get;
}
sub set {
warnenter if ::DEBUG;
if (not defined $Config) {
read_configuration();
}
my $key = shift;
my $value = shift;
$Config->{$key} = $value;
save_configuration() if $Config->{persistent};
return $value;
}
{
no strict;
*set_config = *set;
}
sub read_configuration {
warnenter if ::DEBUG;
my $cfg_file = _config_file();
warnline("Config file: '$cfg_file'.\n") if ::DEBUG;
if (not -f $cfg_file) {
$YAMLObject = YAML::Tiny->new();
}
else {
$YAMLObject = YAML::Tiny->read($cfg_file);
}
push @$YAMLObject, {} if @$YAMLObject == 0;
$Config = $YAMLObject->[0];
_default_config();
warnline $YAMLObject->write_string()."\n" if ::DEBUG > 1;
return $Config;
}
sub save_configuration {
warnenter if ::DEBUG;
$YAMLObject->write(_config_file());
}
{
my $config_file;
sub _config_file {
warnenter if ::DEBUG > 1;
if (not defined $config_file) {
my $home = File::HomeDir->my_home;
$config_file = File::Spec->catfile($home, '.fqstat.yml');
}
return $config_file;
}
}
sub reset_configuration {
warnenter if ::DEBUG;
my $yaml = YAML::Tiny->new;
$YAMLObject = $yaml;
push @$YAMLObject, {} if @$YAMLObject == 0;
$Config = $YAMLObject->[0];
_default_config();
return $Config;
}
sub _default_config {
warnenter if ::DEBUG;
my %default = (
persistent => 1,
qstatcmd => 'qstat',
qdelcmd => 'qdel',
qaltercmd => 'qalter',
qmodcmd => 'qmod',
sshcommand => '',
version => $App::FQStat::VERSION,
colors => $App::FQStat::Colors::DefaultColors,
color_schemes => $App::FQStat::Colors::DefaultColorSchemes,
summary_mode => 0,
summary_clustering => 0,
summary_clustering_similarity => 0.25,
);
my %upgrades;
%upgrades = (
old => sub {
my $cfg = shift;
%$cfg = %default;
},
'6.0' => sub {
my $cfg = shift;
$cfg->{colors} = $App::FQStat::Colors::DefaultColors;
$upgrades{6.1}->($cfg);
save_configuration();
},
'6.1' => sub {
my $cfg = shift;
$cfg->{color_schemes} = $App::FQStat::Colors::DefaultColorSchemes;
$upgrades{6.2}->($cfg);
save_configuration();
},
'6.2' => sub {
my $cfg = shift;
foreach my $scheme (values %{$cfg->{color_schemes}}) {
$scheme->{summary} = $scheme->{user_highlight};
}
$cfg->{colors}->{summary} = $cfg->{colors}->{user_highlight};
$cfg->{summary_clustering_similarity} = 0.25;
save_configuration();
},
);
# upgrade old configs
my $cfgversion = $Config->{version};
$upgrades{old}->($Config), $cfgversion = $Config->{version} if not $cfgversion or $cfgversion < 5;
$upgrades{$cfgversion}->($Config) if exists $upgrades{$cfgversion};
$Config->{version} = $App::FQStat::VERSION, save_configuration() if $Config->{version} ne $App::FQStat::VERSION;
my $add = 0;
foreach my $key (keys %default) {
$add++, $Config->{$key} = $default{$key} if not defined $Config->{$key};
}
save_configuration() if $Config->{persistent} and $add;
}
sub edit_configuration {
warnenter if ::DEBUG;
require Term::CallEditor;
my $string = $YAMLObject->write_string()."\n";
$string =~ s/^\s*---\s*//s;
my $fh = Term::CallEditor::solicit($string);
die "Error while editing the fqstat configuration: $Term::CallEditor::errstr\n" unless $fh;
local $/ = undef;
my $result = "---\n" . <$fh>;
my $yml;
eval { $yml = YAML::Tiny->read_string($result); };
my $errstr = "The edited configuration file has a syntax error! I'm reverting to the old configuration.\n";
if ($@) {
print $errstr . "The error message from the parser was: $@\n";
print "(continue with any key)";
App::FQStat::Input::get_input_key(1000);
}
elsif (not defined $yml) {
print $errstr;
print "(continue with any key)";
App::FQStat::Input::get_input_key(1000);
}
else {
$YAMLObject = $yml;
push @$YAMLObject, {} if @$YAMLObject == 0;
$Config = $YAMLObject->[0];
_default_config();
save_configuration() if $Config->{persistent};
return 1;
}
return();
}
1;