Config.pm 3.4 KB

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