Config.pm 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118
  1. package Trog::Config;
  2. use 5.040;
  3. use re '/aasx';
  4. use warnings FATAL => 'all';
  5. use FindBin::libs;
  6. use Config::Simple;
  7. use File::Slurper();
  8. =head1 Trog::Config
  9. A thin wrapper around Config::Simple which reads the configuration from the appropriate place.
  10. =head2 Trog::Config::get() = Config::Simple
  11. Returns a configuration object that will be used by server.psgi, the data model and Routing modules.
  12. Memoized, so you will need to HUP the children on config changes.
  13. Reads $home_cfg, falling back to $default when the instance has never saved a
  14. configuration of its own. Both are full paths relative to the tCMS root, so
  15. that writers can use them too -- an earlier version had the 'config/' prefix
  16. hardcoded here and nowhere else, which meant everything that *wrote* the
  17. configuration put it somewhere get() would never look.
  18. =cut
  19. # Where an instance's own configuration lives, once it has saved one.
  20. our $home_cfg = "config/main.cfg";
  21. # Shipped defaults. Tracked in git -- never write to this.
  22. our $default = "config/default.cfg";
  23. sub get {
  24. state $cf;
  25. return $cf if $cf;
  26. foreach my $cfg2try ( $home_cfg, $default ) {
  27. next unless -f $cfg2try; ## no critic (ProhibitFiletest_f) -- the instance config, else the shipped default
  28. $cf = Config::Simple->new($cfg2try);
  29. last;
  30. }
  31. die "Could not find config file!" unless $cf;
  32. return $cf;
  33. }
  34. =head2 Trog::Config::schema( STRING file = $default ) = ARRAYREF
  35. The shape of the configuration, as described by the file we ship.
  36. config/default.cfg is the only place which says what settings exist at all, so
  37. it is also what the /config editor is built out of -- add a key there and it
  38. becomes editable, leave one out and it isn't. Sections and keys come back in
  39. file order:
  40. [
  41. {
  42. section => 'general',
  43. fields => [
  44. {
  45. key => 'data_model',
  46. name => 'general.data_model',
  47. default => 'SQLite',
  48. comment => 'FlatFile or SQLite. ...',
  49. },
  50. ],
  51. },
  52. ]
  53. Comment lines accumulate until a key claims them, so a comment block is the
  54. help text for whatever setting follows it. Config::Simple throws both comments
  55. and ordering away when it reads a file, which is why this reads it again rather
  56. than asking the object we already have.
  57. Keys appearing before any section header are skipped -- Config::Simple has no
  58. name for them, so neither do we.
  59. =cut
  60. sub schema ( $file = $default ) {
  61. my ( @sections, $section, @comments );
  62. foreach my $line ( File::Slurper::read_lines($file) ) {
  63. $line =~ s/^\s+//;
  64. $line =~ s/\s+$//;
  65. next unless $line;
  66. if ( $line =~ m/^\[(\N+)\]$/ ) {
  67. $section = { section => $1, fields => [] };
  68. push( @sections, $section );
  69. @comments = ();
  70. next;
  71. }
  72. if ( $line =~ m/^[#;]\s?(\N*)$/ ) {
  73. push( @comments, $1 );
  74. next;
  75. }
  76. my ( $key, $value ) = $line =~ m/^([^=]+?)\s*=\s*(\N*)$/;
  77. next unless defined $key;
  78. next unless $section;
  79. push(
  80. @{ $section->{fields} },
  81. {
  82. key => $key,
  83. name => "$section->{section}.$key",
  84. default => $value,
  85. comment => join( ' ', @comments ),
  86. }
  87. );
  88. @comments = ();
  89. }
  90. return \@sections;
  91. }
  92. 1;