view release on metacpan or  search on metacpan

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

package Apache2::Translation::Admin;

use 5.008008;
use strict;
use warnings;
no warnings qw(uninitialized);

use Apache2::RequestRec;
use Apache2::RequestUtil;
use Apache2::RequestIO;
use Apache2::ServerRec;
use Apache2::ServerUtil;
use Apache2::Connection;
use Apache2::Log;
use Apache2::SubRequest;
use Apache2::Filter;
use APR::Brigade;
use APR::Bucket;
use APR::Table;
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