lib/SGN/Context.pm

   1 =head1 NAME
   2
   3 SGN::Context - deprecated, do not use in new code
   4
   5 =cut
   6
   7 # =head1 NAME
   8
   9 # SGN::Context - configuration and context object, meant to export a
  10 # similar interface to the Catalyst context object, to help smooth our
  11 # transition to Catalyst.
  12
  13 # =head1 SYNOPSIS
  14
  15 #   my $c = SGN::Context->new;
  16 #   my $c = SGN::Context->instance; # new() and instance() do the same thing
  17
  18 #   # Catalyst-compatible
  19 #   print "my_conf_variable is ".$c->get_conf('my_conf_variable');
  20
  21 # =head1 DESCRIPTION
  22
  23 # Note that this object is a singleton, based on L<MooseX::Singleton>.
  24 # There is only ever 1 instance of it.
  25
  26 # =head1 ROLES
  27
  28 # Does: L<SGN::SiteFeatures>, L<SGN::Site>
  29
  30 # =head1 OBJECT METHODS
  31
  32 # =cut
  33
  34 package SGN::Context;
  35 use 5.10.0;
  36 use Moose;
  37 use namespace::autoclean;
  38
  39 use warnings FATAL => 'all';
  40
  41 use Carp;
  42 use File::Spec;
  43
  44 use Config::JFDI;
  45
  46 use Catalyst::Utils ();
  47 use CatalystX::GlobalContext '$c';
  48
  49 sub instance { shift->new(@_) }
  50
  51 # only use this object if $c is not available
  52 around qw( new ) => sub {
  53     return $c if $c;
  54
  55     my $orig  = shift;
  56     my $class = shift;
  57     return $class->$orig(@_);
  58 };
  59
  60 sub setup_finalize {} #< stubbed out to satisfy roles
  61
  62 sub path_to {
  63     my ( $self, @relpath ) = @_;
  64
  65     @relpath = map "$_", @relpath; #< stringify whatever was passed
  66
  67     my $basepath = $self->get_conf('basepath')
  68       or die "no base path conf variable defined";
  69     -d $basepath or die "base path '$basepath' does not exist!";
  70
  71     return File::Spec->catfile( $basepath, @relpath );
  72 }
  73
  74 sub config {
  75     my $class = shift;
  76     $class = ref $class if ref $class;
  77     state %config;
  78     return $config{$class} ||= $class->_build_config;
  79 }
  80 sub _build_config {
  81     my ($self) = @_;
  82
  83     my $home = Catalyst::Utils::home( __PACKAGE__ );
  84
  85     return
  86         Config::JFDI->open(
  87             name => 'sgn',
  88             path => $home,
  89             substitute => {
  90                 UID       => sub { $> },
  91                 USERNAME  => sub { (getpwuid($>))[0] },
  92                 GID       => sub { $) },
  93                 GROUPNAME => sub { (getgrgid($)))[0] },
  94             },
  95             default => {
  96                 name     => 'SGN',
  97                 home     => $home,
  98                 basepath => $home,
  99                },
 100            )
 101         || die "failed to load sgn config files in dir '$home'";
 102 }
 103
 104 with qw(
 105     SGN::Role::Site::Config
 106     SGN::Role::Site::DBConnector
 107     SGN::Role::Site::DBIC
 108     SGN::Role::Site::Files
 109     SGN::Role::Site::Mason
 110     SGN::Role::Site::SiteFeatures
 111 );
 112
 113 __PACKAGE__->meta->make_immutable( inline_constructor => 0 );
 114
 115 ###
 116 1;#do not remove
 117 ###