view release on metacpan or  search on metacpan

lib/Apache2/Translation/Admin.pm  view on Meta::CPAN

use APR::Socket;
use Apache2::Const -compile=>qw{:common :http};
use Apache2::Request;

use Template;
use Class::Member::HASH -CLASS_MEMBERS=>qw/static types types_re templates
					   tt provider provider_url
					   provider_spec r title/;
our @CLASS_MEMBERS;

our $VERSION = '0.06';
our $STATIC;
our $DEFAULTPROVIDERHOST='http://localhost';

$STATIC=__PACKAGE__;
$STATIC=~s!::!/!g;
$STATIC=$INC{$STATIC.'.pm'};
$STATIC=~s/\.pm$//;

our %TYPES=
  (
   gif=>'image/gif',
   png=>'image/png',
   jpg=>'image/jpeg',
   jpeg=>'image/jpeg',
   ico=>'image/x-icon',
   html=>'text/html',
   shtml=>'text/html',
   css=>'text/css',
   js=>'application/x-javascript',
  );

sub _config_provider_SPEC {
  my ($I)=@_;

  my $param=$I->provider_spec;
  my $class=$param->[0];
  eval "use Apache2::Translation::$class;";
  if( $@ ) {
    warn "ERROR: Cannot use Apache2::Translation::$class: $@" if $@;
    eval "use $class;";
    die "ERROR: Cannot use $class: $@" if $@;
  } else {
    $class='Apache2::Translation::'.$class;
  }
  $I->provider=$class->new( @{$param}[1..$#{$param}] );
  local $"='; ';
  my %x=@{$param}[1..$#{$param}];
  $I->title="($param->[0]: @{[map qq{$_=$x{$_}}, keys %x]})";
}

sub _fetch_provider_LWP {
  my ($I)=@_;

  require LWP::UserAgent;

  my $ua=LWP::UserAgent->new;
  my $resp=$ua->get($I->provider_url);
  if( $resp->is_success ) {
    my $x;
    unless( eval 'require JSON::XS' and
	    $x=eval {JSON::XS::decode_json($resp->content)} ) {
      eval 'require YAML' and $x=eval {YAML::Load($resp->content)};
    }
    if( ref($x) eq 'HASH' and exists $x->{TranslationProvider} ) {
      $I->provider_spec=$x->{TranslationProvider};
      $I->_config_provider_SPEC;
      $I->title="@ ".$I->provider_url;
    }
  }
}

sub new {
  my $parent=shift;
  my $I=bless {}, ref($parent)?ref($parent):$parent;
  my %o=@_;

  # set defaults
  $I->static=$STATIC;
  $I->templates=$STATIC.'/templates';
  $I->types={};

  # then override with named parameters
  foreach my $m (@CLASS_MEMBERS) {
    $I->$m=$o{$m} if( exists $o{$m} );
  }
  @{$I->types}{keys %TYPES}=values %TYPES;
  my $re=join '|', keys %{$I->types};
  $I->types_re=qr/$re/;

  unless( defined $I->tt and ref $I->tt and $I->tt->isa('Template') ) {
    $I->tt=Template->new({
			  INCLUDE_PATH=>$I->templates,
			  EVAL_PERL=>1,
			 })
      or die "ERROR: While creating template object: $Template::ERROR\n";
  }

  unless( ref $I->provider ) {
    if( length $I->provider_url ) {
      $I->provider_url=$DEFAULTPROVIDERHOST.$I->provider_url
	unless( $I->provider_url=~m!^\w+:! );
    } elsif( ref($I->provider_spec) eq 'ARRAY' ) {
      $I->_config_provider_SPEC;
    } elsif( length $INC{'Apache2/Translation.pm'} and defined $I->r ) {
      $I->provider=(Apache2::Module::get_config('Apache2::Translation',
						$I->r->server) || {})
	->{provider};
      $I->title="@ ".$I->r->server->server_hostname;
    }

    unless( length $I->provider_url ) {
      die "ERROR: Cannot resolve translation provider\n"
	unless(ref $I->provider);
    }
  }

  return $I;
}

sub xindex {
  my ($I, $r)=@_;