Merge branch 'master' of piny.be:/srv/git/piny-code

1 files changed, 218 insertions, 0 deletions

diff --git a/libpiny/lib/Piny/Config.pm b/libpiny/lib/Piny/Config.pm
new file mode 100644
index 0000000..76405ee
--- /dev/null
+++ b/libpiny/lib/Piny/Config.pm
@@ -0,0 +1,218 @@
+# Copyright © 2010 Julian Blake Kongslie <jblake@omgwallhack.org>
+# Licensed under the BSD 3-clause license.
+
+use strict;
+use warnings;
+
+package Piny::Config;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+use MooseX::StrictConstructor;
+
+use Carp;
+use Config::Simple qw( -lc );
+
+# Types
+
+subtype 'GitBool'
+  => as 'Str'
+  => where { $_ =~ /^(1|0|true|false)$/i }
+  => message { 'Not correct format for a git-compatible boolean.' }
+  ;
+
+subtype 'Path'
+  => as 'Str'
+  => where { $_ =~ /^\// and -e $_ }
+  => message { 'Not an absolute path, or does not exist.' }
+  ;
+
+subtype 'PathDir'
+  => as 'Path'
+  => where { -d $_ }
+  => message { 'Not an absolute path, or not a directory.' }
+  ;
+
+subtype 'HttpUrl'
+  => as 'Str'
+  => where { $_ =~ /^http:\/\//i }
+  => message { 'Not a http:// URL.' }
+  ;
+
+subtype 'HttpsUrl'
+  => as 'Str'
+  => where { $_ =~ /^https:\/\//i }
+  => message { 'Not a https:// URL.' }
+  ;
+
+# Attributes
+
+has 'confpath' =>
+  ( is          => 'ro'
+  , isa         => 'Str'
+  , predicate   => 'has_confpath'
+  );
+
+has '_conf' =>
+  ( is          => 'ro'
+  , isa         => 'HashRef[Str]'
+  , lazy_build  => 1
+  , clearer     => 'clear_conf'
+  , init_arg    => undef
+  );
+
+# Builder methods
+
+# If constructed with just one argument, then treat it as a config path.
+around BUILDARGS => sub {
+  my ( $orig, $class ) = ( shift, shift );
+
+  if ( @_ == 1 && ! ref $_[0] ) {
+    return $class->$orig( confpath => $_[0] );
+  } else {
+    return $class->$orig( @_ );
+  };
+};
+
+sub _build__conf {
+  my ( $s ) = @_;
+
+  my $conf;
+
+  if ( $s->has_confpath and -e $s->confpath ) {
+    $conf = Config::Simple->new( $s->confpath )->vars;
+  } else {
+    $conf = { };
+  };
+
+  if ( -e "/etc/piny-default.conf" ) {
+
+    my $default = Config::Simple->new( "/etc/piny-default.conf" )->vars;
+
+    foreach my $key ( keys %$default ) {
+      if ( not exists $conf->{$key} ) {
+        $conf->{$key} = $default->{$key};
+      };
+    };
+
+  };
+
+  if ( -e "/etc/piny-override.conf" ) {
+
+    my $override = Config::Simple->new( "/etc/piny-override.conf" )->vars;
+
+    foreach my $key ( keys %$override ) {
+      $conf->{$key} = $override->{$key};
+    };
+
+  };
+
+  return $conf;
+};
+
+# Save the config
+
+sub save {
+  my ( $s ) = @_;
+
+  if ( not $s->has_confpath ) {
+    croak "Can't save a Piny::Config if the confpath is not set!";
+  };
+
+  if ( -e "/etc/piny-override.conf" ) {
+
+    my $override = Config::Simple->new( "/etc/piny-override.conf" )->vars;
+
+    foreach my $key ( keys %$override ) {
+      if ( exists $s->_conf->{$key} and $s->_conf->{$key} eq $override->{$key} ) {
+        delete $s->_conf->{$key};
+      };
+    };
+
+  };
+
+  if ( -e "/etc/piny-default.conf" ) {
+
+    my $default = Config::Simple->new( "/etc/piny-default.conf" )->vars;
+
+    foreach my $key ( keys %$default ) {
+      if ( exists $s->_conf->{$key} and $s->_conf->{$key} eq $default->{$key} ) {
+        delete $s->_conf->{$key};
+      };
+    };
+
+  };
+
+  my $cs = Config::Simple->new( syntax => "ini" );
+
+  foreach my $key ( keys %{$s->_conf} ) {
+    $cs->param( $key, $s->_conf->{$key} );
+  };
+
+  $cs->write( $s->confpath );
+};
+
+# Tweakable helper
+
+sub tweakable {
+  my ( $attr, $default, $isa ) = @_;
+
+  $attr = lc $attr;
+
+  my $attrname = $attr;
+  $attrname =~ s/_/./;
+
+  if ( $attrname =~ /_/ ) { croak "Illegal attribute name $attrname! (use only one underbar)"; };
+
+  has $attr =>
+    ( is          => 'rw'
+    , isa         => $isa
+    , lazy_build  => 1
+    , trigger     => sub {
+                      my ( $s, $new, $old ) = @_;
+
+                      $s->_conf->{$attrname} = $new;
+
+                      if ( $s->has_confpath ) {
+                        $s->save;
+                      } else {
+                        carp "Attribute $attrname modification ignored!";
+                      };
+
+                      $s->clear_conf;
+                      my $clearer = "clear_$attr";
+                      $s->$clearer;
+                    }
+    );
+
+  my $builder = sub {
+    my ( $s ) = @_;
+
+    if ( exists $s->_conf->{$attrname} ) {
+      return $s->_conf->{$attrname};
+    } else {
+      return $default;
+    };
+  };
+
+  {
+    no strict "refs";
+
+    *{"_build_" . $attr} = $builder;
+  };
+};
+
+# The tweakables
+
+tweakable "piny_ikiwikidestdir"         => "/srv/www/piny.be/", 'PathDir';
+tweakable "piny_ikiwikisrcdir"          => "/srv/ikiwiki/", 'PathDir';
+tweakable "piny_ikiwikiurl"             => "http://piny.be/", 'HttpUrl';
+tweakable "piny_ikiwikisecureurl"       => "https://secure.piny.be/", 'HttpsUrl';
+tweakable "piny_ikiwikisecurepath"      => "/srv/www/secure.piny.be/", 'PathDir';
+tweakable "receive_denynonfastforwards" => "true", 'GitBool';
+
+# Moose boilerplate
+
+__PACKAGE__->meta->make_immutable;
+
+1;