view release on metacpan or  search on metacpan

lib/App/Alice/Config.pm  view on Meta::CPAN

package App::Alice::Config;

use FindBin;
use Data::Dumper;
use File::ShareDir qw/dist_dir/;
use Getopt::Long;
use Any::Moose;

has assetdir => (
  is      => 'ro',
  isa     => 'Str',
  default => sub {
    if (-e "$FindBin::Bin/../share/templates") {
      return "$FindBin::Bin/../share";
    }
    return dist_dir('App-Alice');
  }
);

has images => (
  is      => 'rw',
  isa     => 'Str',
  default => "show",
);

has avatars => (
  is      => 'rw',
  isa     => 'Str',
  default => "show",
);

has style => (
  is      => 'rw',
  isa     => 'Str',
  default => 'default',
);

has timeformat => (
  is      => 'rw',
  isa     => 'Str',
  default => '24',
);

has alerts => (
  is      => 'rw',
  isa     => 'Str',
  default => 'show',
);

has quitmsg => (
  is      => 'rw',
  isa     => 'Str',
  default => 'alice.',
);

has debug => (
  is      => 'rw',
  isa     => 'Bool',
  default => 0,
);

has port => (
  is      => 'rw',
  isa     => 'Str',

lib/App/Alice/Config.pm  view on Meta::CPAN

  if (-e $self->fullpath) {
    $config = require $self->fullpath;
  }
  else {
    say STDERR "No config found, writing a few config to ".$self->fullpath;
    $self->write;
  }
  my ($port, $debug, $address) = @_;
  GetOptions("port=i" => \$port, "debug" => \$debug, "address=s" => \$address);
  $self->commandline->{port} = $port if $port and $port =~ /\d+/;
  $self->commandline->{debug} = 1 if $debug;
  $self->commandline->{address} = $address if $address;
  $self->merge($config);
}

sub http_port {
  my $self = shift;
  if ($self->commandline->{port}) {
    return $self->commandline->{port};
  }
  return $self->port;
}

sub http_address {
  my $self = shift;
  if ($self->commandline->{address}) {
    return $self->commandline->{address};
  }
  if ($self->address eq "localhost") {
    $self->address("127.0.0.1");
  }
  return $self->address;
}

sub show_debug {
  my $self = shift;
  if ($self->commandline->{debug}) {
    return 1;
  }
  return $self->debug;
}

sub merge {
  my ($self, $config) = @_;
  for my $key (keys %$config) {
    if (exists $config->{$key} and my $attr = $self->meta->get_attribute($key)) {
      $self->$key($config->{$key}) if $attr->has_write_method;
    }
    else {
      say STDERR "$key is not a valid config option";
    }
  }
}

sub write {
  my ($self, $data) = @_;
  my $config = $data || $self->serialized;
  mkdir $self->path if !-d $self->path;
  open my $fh, ">", $self->fullpath;
  {
    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 1;
    print $fh Dumper($config)
      or warn "Can not write config file: $!\n";
  }
}

sub serialized {
  my $self = shift;
  return {
    map {
      my $name = $_->name;
      $name => $self->$name;
    } grep {$_->has_write_method}
    $self->meta->get_all_attributes
  };
}

__PACKAGE__->meta->make_immutable;
1;