Apache2-Translation

 view release on metacpan or  search on metacpan

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

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;
    }
  }
}

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

  $r->content_type('text/plain');

  my $cache=$cf->{eval_cache};
  if( tied %{$cache} ) {
    $cache=tied( %{$cache} )->max_size;
  } else {
    $cache='unlimited';
  }

  my $args=lc $r->args;
  if( $args ne 'yaml' and eval 'require JSON::XS' ) {
    $r->print( JSON::XS::encode_json
	       ( {
		  TranslationKey=>$cf->{key},
		  TranslationProvider=>$cf->{provider_param},
		  TranslationEvalCache=>$cache,
		 } ) );
  } elsif( eval 'require YAML' ) {
    $r->print( YAML::Dump
	       ( {
		  TranslationKey=>$cf->{key},
		  TranslationProvider=>$cf->{provider_param},
		  TranslationEvalCache=>$cache,
		 } ) );
  } else {
    die "Please install JSON::XS or YAML";
  }

  return Apache2::Const::OK;
}

1;
__END__

lib/Apache2/Translation/Config.pod  view on Meta::CPAN

  ---
  TranslationEvalCache: 1000
  TranslationKey: default
  TranslationProvider:
    - File
    - configfile
    - /path/to/config

Since C<Apache2::Translation> version 0.31 JSON is default.
C<Apache2::Translation::Admin> can decode both formats provided the
L<YAML> and L<JSON::XS> modules are installed.

This format can be used by the WEB interface L<Apache2::Translation::Admin>
to connect to the provider.

=head1 AUTHOR

Torsten Foertsch, E<lt>torsten.foertsch@gmx.netE<gt>

=head1 COPYRIGHT AND LICENSE

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

  }
}

{
  my $_init;
  my $init=sub {
    my ($I, $other, %o)=@_;
    unless($_init) {
      # This is expected to be seldom used. So, don't rely on the
      # existence of these modules.
      die "Please install JSON::XS" unless eval "require JSON::XS";
      die "Please install Algorithm::Diff"
	unless eval "require Algorithm::Diff";
      $_init=1;
    }

    my (@my_stuff, @other_stuff);
    if( exists $o{key} and exists $o{uri} ) {
      my ($key, $uri)=@o{qw/key uri/};
      for( my $it=$I->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @my_stuff, $el if( (ref($key)
				 ? $el->[nKEY] =~ $key
				 : $el->[nKEY] eq $key) and
				(ref($uri)
				 ? $el->[nURI] =~ $uri
				 : $el->[nURI] eq $uri) );
      }
      for( my $it=$other->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @other_stuff, $el if( (ref($key)
				    ? $el->[nKEY] =~ $key
				    : $el->[nKEY] eq $key) and
				   (ref($uri)
				    ? $el->[nURI] =~ $uri
				    : $el->[nURI] eq $uri) );
      }
    } elsif( exists $o{key} ) {
      my $key=$o{key};
      for( my $it=$I->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @my_stuff, $el if( ref($key)
				? $el->[nKEY] =~ $key
				: $el->[nKEY] eq $key );
      }
      for( my $it=$other->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @other_stuff, $el if( ref($key)
				   ? $el->[nKEY] =~ $key
				   : $el->[nKEY] eq $key );
      }
    } elsif( exists $o{uri} ) {
      my $uri=$o{uri};
      for( my $it=$I->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @my_stuff, $el if( ref($uri)
				? $el->[nURI] =~ $uri
				: $el->[nURI] eq $uri );
      }
      for( my $it=$other->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @other_stuff, $el if( ref($uri)
				   ? $el->[nURI] =~ $uri
				   : $el->[nURI] eq $uri );
      }
    } else {
      for( my $it=$I->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @my_stuff, $el;
      }
      for( my $it=$other->iterator; my $el=$it->(); ) {
	$#{$el}=nNOTE;		# drop ID
	$el->[nBLOCK]+=0;	# convert to numbers because JSON::XS
	$el->[nORDER]+=0;	# shows 0 as 0 but '0' as "0"
	push @other_stuff, $el;
      }
    }

    my $serializer=\&JSON::XS::encode_json;
    if( exists $o{notes} and !$o{notes} ) {
      my $f=$serializer;
      $serializer=sub { my @el=@{$_[0]}; $el[nNOTE]=''; $f->(\@el) };
    }
    if( exists $o{numbers} and !$o{numbers} ) {
      my $f=$serializer;
      $serializer=sub { my @el=@{$_[0]}; @el[nBLOCK,nORDER]=(0,0); $f->(\@el) };
    }

    return (\@my_stuff, \@other_stuff, $serializer);

lib/Apache2/Translation/_base.pod  view on Meta::CPAN

=item B<append( $other_provider, %options )>

Expects a provider object that implements the C<iterator> function. C<append>
then C<insert()>s all elements of C<$other_provider>.

If C<drop_notes> is passed as a true value in C<%options> then notes are not
copied.

=item B<diff( $other_provider, %options )>

If L<Algorithm::Diff> and L<JSON::XS> are installed this method computes
a difference between 2 providers. If C<key> or C<uri> are given in
C<%options> they act as filters.
The difference is calculated only for elements that pass that filter.
The value of C<key> or C<uri> can either be a string in which case the
matching operation is a simple C<eq> or a C<Regexp> object (C<qr/.../>).

If C<notes> is specified in C<%options> as a false value differences
in notes only are disregarded.

If C<numbers> is specified in C<%options> as a false value differences

script/diffprov  view on Meta::CPAN

 -json       JSON output instead of HTML
 -h          print this help
USAGE
	       exit 1;
	     };
}

config;

if( $json ) {
  eval "require JSON::XS";
  die "Need JSON::XS to produce JSON output.\n" if $@;
} else {
  eval "require Algorithm::Diff";
  die "Need Algorithm::Diff to produce HTML output.\n" if $@;
}

my ($old, $new)=map {
  my @param=@$_;
  my $type=shift @param;
  if( eval "require Apache2::Translation::$type" ) {
    $type="Apache2::Translation::$type";

script/diffprov  view on Meta::CPAN

		     $new,
		     (defined $key ? (key=>qr/$key/) : ()),
		     (defined $uri ? (uri=>qr/$uri/) : ()),
		     notes=>$notes,
		     numbers=>$numbers,
		    );
$new->stop;
$old->stop;

if( $json ) {
  print JSON::XS::encode_json([map {$_->[0] eq 'u' ? () : [do {
    my $l=$_;
    local $_;
    map {
      ref $_
	? [
	   Encode::decode('utf8', $_->[0]), # key
	   Encode::decode('utf8', $_->[1]), # uri
	   $_->[2],			    # block
	   $_->[3],			    # order
	   Encode::decode('utf8', $_->[4]), # action

t/005provider-MMapDB.t  view on Meta::CPAN

	    [1, 1, 'c', re(qr/^\d+$/), 'note2']],
           n 'fetch k1 u1 after insert';

$o->begin;
$o->update([qw/k1 u1 1 0/, $o->_db->main_index->{trans}->{db}
                             ->{actn}->{k1}->{u1}->[2]->[3]],
	   [qw/k1 u1 1 3/, "updated\naction", "updated\nnote"]);
$o->commit;

SKIP: {
  eval 'use JSON::XS; use Algorithm::Diff';
  $@ and skip 'JSON::XS or Algorithm::Diff not installed', 4;

  cmp_deeply [$ro->diff($o)],
             [
              [["-", 2,
                ["k1", "u1", 1, 0, "inserted_action", "inserted_note"]]],
              [["+", 3,
                ["k1", "u1", 1, 3, "updated\naction", "updated\nnote"]]],
             ],
             n 'diff after update';

t/011directives.t  view on Meta::CPAN

$resp=GET( '/txt1' );
ok t_cmp $resp->content, 'TXT', n '/txt1 body';
ok t_cmp $resp->header('Content-Type'), 'text/plain', n '/txt1 content_type';

SKIP: {
  skip "Need Linux::Smaps to report meminfo", 0 unless( need_module( 'Linux::Smaps' ) );
  t_debug GET_BODY( '/minfo' );
}

SKIP: {
  skip "Need JSON::XS or YAML to test Apache2::Translation::Config", 1
    unless( need_module( 'JSON::XS' ) or need_module( 'YAML' ) );
  my $text=GET_BODY( '/econf' );

  my $x;
  unless( eval 'require JSON::XS' and
          $x=eval {JSON::XS::decode_json($text)} ) {
    eval 'require YAML' and $x=eval {YAML::Load($text)};
  }

  ok( t_cmp $x,
      {
       TranslationProvider  => [
				'DB',
				database  => $db,
				user      => $user,
				password  => $pw,

t/011directives.t  view on Meta::CPAN

      },
      n 'Apache2::Translation::Config' );
}

SKIP: {
  skip "Need YAML to test Apache2::Translation::Config in YAML mode", 1
    unless( need_module( 'YAML' ) );
  my $text=GET_BODY( '/econf?Yaml' );

  my $x;
  unless( eval 'require JSON::XS' and
          $x=eval {JSON::XS::decode_json($text)} ) {
    eval 'require YAML' and $x=eval {YAML::Load($text)};
  }

  ok( t_cmp $x,
      {
       TranslationProvider  => [
				'DB',
				database  => $db,
				user      => $user,
				password  => $pw,