lib/CXGN/VHost.pm

   1 =head1 NAME
   2
   3 CXGN::VHost - backwards-compatible context object to help smooth our
   4 transition to Catalyst
   5
   6 =head1 SYNOPSIS
   7
   8   my $vhost = CXGN::VHost->new;
   9
  10   # Catalyst-compatible
  11   print "my_conf_variable is ".$vhost->config->{my_conf_variable};
  12
  13   # old-SGN compatible
  14   print "my_conf_variable is ".$vhost->get_conf('my_conf_variable');
  15
  16 =head1 OBJECT METHODS
  17
  18 =cut
  19
  20 package CXGN::VHost;
  21 use Moose;
  22 use namespace::autoclean;
  23 use Carp;
  24 extends 'SGN::Context';
  25
  26 carp <<EOM;
  27 CXGN::VHost is deprecated, please remove this use.
  28
  29 For most modules, all database connections, paths, etc that are now
  30 being read from CXGN::VHost should be passed in via mandatory
  31 arguments to new(), or similar.
  32 EOM
  33
  34 after 'new' => sub { croak <<EOM unless $ENV{MOD_PERL} };
  35 CXGN::VHost is not available for use outside of code running under the SGN website.
  36 EOM
  37
  38 # backwards-compatibility methods
  39 around 'get_conf' => sub {
  40     my $orig = shift;
  41     my $self = shift;
  42     my $val = eval{ $self->$orig(@_) };
  43     $val = undef if $@;
  44     return $val->[0] if ref $val eq 'ARRAY';
  45     return $val;
  46 };
  47
  48 sub get_conf_arrayref {
  49     shift->config->{+shift}
  50 }
  51
  52
  53 ### some of this might be useful someday for build tests, so keep
  54 ### them here commented out where they are more greppable
  55
  56 # sub test_config {
  57 #     my $self = shift;
  58
  59 #     #check for presence of required settings
  60 #     foreach my $key (qw/ project_name
  61 #                        servername
  62 #                        basepath
  63 #                        perllib_path
  64 #                        production_server
  65 #                        /
  66 #                    ) {
  67
  68 #       unless ( defined $self->{vhost_config}->{$key} ) {
  69 #           $self->print_warning("No $key given; unable to create vhost object.");
  70 #           return 0;
  71 #       }
  72 #     }
  73
  74 #     #make sure we can create a configuration object
  75 #     my $conf = $self;
  76
  77 #     #now run any test we can think of which might catch a problem before it happens.
  78
  79 #     # check basepath
  80 #     my $basepath = $self->{basepath};
  81 #     unless ( -d ($basepath) ) {
  82 #         $self->print_warning("Basepath '$basepath' not found.");
  83 #         return 0;
  84 #     }
  85
  86 #     # check perllib path
  87 #     my $perllib_path = $self->{perllib_path};
  88 #     unless ( -d ($perllib_path) ) {
  89 #         $self->print_warning("Perllib path '$perllib_path' not found.");
  90 #         return 0;
  91 #     }
  92
  93 #     # check document root
  94 #     my $docroot = $conf->get_conf('document_root_subdir');
  95 #     unless ( -d ( $basepath . $docroot ) ) {
  96 #         $self->print_warning("Document root '$basepath$docroot' not found.");
  97 #         return 0;
  98 #     }
  99
 100 #     # check executables subdir
 101 #     my $executable_subdir = $conf->get_conf('executable_subdir');
 102 #     if ($executable_subdir) {
 103 #         unless ( -d ( $basepath . $executable_subdir ) ) {
 104 #             $self->print_warning(
 105 #                 "Executable directory '$basepath$executable_subdir' not found."
 106 #             );
 107 #             return 0;
 108 #         }
 109 #     }
 110
 111 #     my $data_shared_website_path = $conf->get_conf('data_shared_website_path');
 112 #     if ($data_shared_website_path) {
 113 #         unless ( -d ($data_shared_website_path) ) {
 114 #             $self->print_warning(
 115 # "Data shared website path '$data_shared_website_path' not found. Attempting configuration anyway."
 116 #             );
 117 #         }
 118 #     }
 119
 120 #     my $rewrite_log = $conf->get_conf('rewrite_log');
 121 #     if ($rewrite_log) {
 122 #         unless ( -f ( $basepath . $rewrite_log ) ) {
 123 #             $self->print_warning(
 124 # "Rewrite log file '$basepath$rewrite_log' not found. Apache will attempt to create this file. If apache cannot create this file, it WILL FAIL TO START."
 125 #             );
 126 #         }
 127 #     }
 128
 129 #     return 1;    #all tests passed
 130 # }
 131
 132
 133 ###
 134 1;#do not remove
 135 ###