1package App::SD::Config; 2use Any::Moose; 3use File::Spec; 4 5extends 'Prophet::Config'; 6 7{ 8### XXX This code is for BACKCOMPAT ONLY! Eventually, we want to kill it 9### completely. 10 11sub _old_app_config_file { 12 my $self = shift; 13 14 # The order of preference for (OLD!) config files is: 15 # $ENV{SD_CONFIG} > fs_root/config > fs_root/prophetrc (for backcompat) 16 # $HOME/.sdrc > $ENV{PROPHET_APP_CONFIG} > $HOME/.prophetrc 17 18 # if we set PROPHET_APP_CONFIG here, it will mess up legit uses of the 19 # new config file setup 20 my $old_file 21 = $self->_file_if_exists($ENV{'SD_CONFIG'}) 22 || $self->_file_if_exists( File::Spec->catfile($self->app_handle->handle->fs_root => 'config')) 23 || $self->_file_if_exists( File::Spec->catfile($self->app_handle->handle->fs_root => 'prophetrc')) 24 || $self->_file_if_exists( File::Spec->catfile($ENV{'HOME'}.'/.sdrc')) 25 || $ENV{'PROPHET_APP_CONFIG'} # don't overwrite with nothing 26 || ''; # don't write undef 27 28 return $self->_file_if_exists($old_file) 29 || $self->_file_if_exists( File::Spec->catfile( $ENV{'HOME'} => '.prophetrc' )) 30 || $self->_file_if_exists( File::Spec->catfile( $self->app_handle->handle->fs_root => 'config' )) || 31 $self->_file_if_exists( File::Spec->catfile( $self->app_handle->handle->fs_root => 'prophetrc' )) || 32 File::Spec->catfile( $self->app_handle->handle->fs_root => 'config' ); 33} 34 35 36 37override load => sub { 38 my $self = shift; 39 40 Prophet::CLI->end_pager(); 41 42 # Do backcompat stuff. 43 for my $file ( ($self->_old_app_config_file, $self->dir_file, $self->user_file, $self->global_file) ) { 44 my $content = -f $file ? Prophet::Util->slurp($file) : '['; 45 46 # config file is old 47 48 # Also "converts" empty files but that's fine. If it ever 49 # does happen, we get the positive benefit of writing the 50 # config format to it. 51 if ( $content !~ /\[/ ) { 52 53 $self->convert_ancient_config_file($file); 54 } 55 56 } 57 58 Prophet::CLI->start_pager(); 59 60 # Do a regular load. 61 $self->SUPER::load(@_); 62}; 63 64### XXX BACKCOMPAT ONLY! We eventually want to kill this hash, modifier and 65### the following methods. 66 67# None of these need to have values mucked with at all, just the keys 68# migrated from old to new. 69our %KEYS_CONVERSION_TABLE = ( 70 'email_address' => 'user.email-address', 71 'default_group_ticket_list' => 'ticket.default-group', 72 'default_sort_ticket_list' => 'ticket.default-sort', 73 'summary_format_ticket' => 'ticket.summary-format', 74 'default_summary_format' => 'record.summary-format', 75 'common_ticket_props' => 'ticket.common-props', 76 'disable_ticket_show_history_by_default' => 'ticket.no-implicit-history-display', 77); 78 79 80 81sub convert_ancient_config_file { 82 my $self = shift; 83 my $file = shift; 84 print "Detected old format config file $file. Converting to ". 85 "new format... "; 86 87 # read in and parse old config 88 my $config = { _sources => {}, _aliases => {} }; 89 $self->_load_old_config_from_file( $file, $config ); 90 my $aliases = delete $config->{_aliases}; 91 my $sources = delete $config->{_sources}; 92 93 # new configuration will include a config format version # 94 my @config_to_set = ( { 95 key => 'core.config-format-version', 96 value => $self->FORMAT_VERSION, 97 } ); 98 99 # convert its keys to new-style keys by comparing to a conversion 100 # table 101 for my $key ( keys %$config ) { 102 die "Unknown key '$key' in old format config file '$file'." 103 ." Remove it or ask\non irc.freenode.net #prophet if you" 104 ." think this is a bug.\n" 105 unless exists $KEYS_CONVERSION_TABLE{$key}; 106 push @config_to_set, { 107 key => $KEYS_CONVERSION_TABLE{$key}, 108 value => $config->{$key}, 109 }; 110 } 111 # convert its aliases 112 for my $alias ( keys %$aliases ) { 113 push @config_to_set, { 114 key => "alias.'$alias'", 115 value => $aliases->{$alias}, 116 }; 117 } 118 # convert its sources 119 for my $name ( keys %$sources ) { 120 my ($url, $uuid) = split(/ \| /, $sources->{$name}, 2); 121 push @config_to_set, { 122 key => "replica.'$name'.url", 123 value => $url, 124 }, { 125 key => "replica.'$name'.uuid", 126 value => $uuid, 127 }; 128 } 129 # move the old config file to a backup 130 my $backup_file = $file; 131 unless ( $self->_deprecated_repo_config_names->{$file} ) { 132 $backup_file = "$file.bak"; 133 rename $file, $backup_file; 134 } 135 136 # we want to write the new file to a supported filename if 137 # it's from a deprecated config name (replica/prophetrc) 138 $file = File::Spec->catfile( $self->app_handle->handle->fs_root, 'config' ) 139 if $self->_deprecated_repo_config_names->{$file}; 140 141 # write the new config file (with group_set) 142 $self->group_set( $file, \@config_to_set, 1); 143 144 # tell the user that we're done 145 print "done.\nOld config can be found at $backup_file; " 146 ,"new config is $file.\n\n"; 147 148} 149 150sub _deprecated_repo_config_names { 151 my $self = shift; 152 153 my %filenames = ( File::Spec->catfile( $self->app_handle->handle->fs_root => 'prophetrc' ) => 1 ); 154 155 return wantarray ? %filenames : \%filenames; 156}; 157sub _load_old_config_from_file { 158 my $self = shift; 159 my $file = shift; 160 my $config = shift || {}; 161 162 for my $line (Prophet::Util->slurp($file) ) { 163 $line =~ s/\#.*$//; # strip comments 164 next unless ($line =~ /^(.*?)\s*=\s*(.*)$/); 165 my $key = $1; 166 my $val = $2; 167 if ($key =~ m!alias\s+(.+)!) { 168 $config->{_aliases}->{$1} = $val; 169 } elsif ($key =~ m!source\s+(.+)!) { 170 $config->{_sources}->{$1} = $val; 171 } else { 172 $config->{$key} = $val; 173 } 174 } 175 $config->{_aliases} ||= {}; # default aliases is null. 176 $config->{_sources} ||= {}; # default to no sources. 177} 178 179} 180 181__PACKAGE__->meta->make_immutable; 182no Any::Moose; 183 1841; 185