package XMLTV::Config_file; use strict; use XMLTV::Ask; # First argument is an explicit config filename or undef. The second # argument is the name of the current program (probably best not to # use $0 for this). Returns the config filename to use (the file may # not necessarily exist). Third argument is a 'quiet' flag (default # false). # # May do other magic things like migrating a config file to a new # location; you can specify the old program name as an optional fourth # argument if your program has recently been renamed. # sub filename( $$;$$ ) { my ($explicit, $progname, $quiet, $old_progname) = @_; return $explicit if defined $explicit; $quiet = 0 if not defined $quiet; my $home = $ENV{HOME}; $home = '.' if not defined $home; my $conf_dir = "$home/.xmltv"; (-d $conf_dir) or mkdir($conf_dir, 0777) or die "cannot mkdir $conf_dir: $!"; my $new = "$conf_dir/$progname.conf"; my @old; for ($old_progname) { push @old, "$conf_dir/$_.conf" if defined } foreach (@old) { if (-f and not -e $new) { warn "migrating config file $_ -> $new\n"; rename($_, $new) or die "cannot rename $_ to $new: $!"; last; } } print STDERR "using config filename $new\n" unless $quiet; return $new; } # If the given file exists, ask for confirmation of overwriting it; # exit if no. # sub check_no_overwrite( $ ) { my $f = shift; if (-s $f) { if (not ask_boolean <) { s/\#.*//; s/^\s+//; s/\s+$//; undef $_ if not length; push @r, $_; } close FH or die "cannot close $f: $!\n"; die "config file $f is empty, please delete and run me with --configure\n" if not @r; return @r; } 1;