"Fossies" - the Fresh Open Source Software Archive

Member "eprints3.4-3.4.4/tests/55_phrases.pl" (7 Aug 2022, 2708 Bytes) of package /linux/www/eprints3.4-3.4.4.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "55_phrases.pl": 3.4-3.4.3_vs_3.4-3.4.4.

    1 #!/usr/bin/perl
    2 
    3 use Test::More tests => 7;
    4 use Digest::MD5;
    5 
    6 use strict;
    7 use warnings;
    8 
    9 BEGIN { use_ok( "EPrints" ); }
   10 BEGIN { use_ok( "EPrints::Test" ); }
   11 BEGIN { use_ok( "EPrints::Test::RepositoryLog" ); }
   12 
   13 my $repoid = EPrints::Test::get_test_id();
   14 
   15 my $ep = EPrints->new();
   16 isa_ok( $ep, "EPrints", "EPrints->new()" );
   17 if( !defined $ep ) { BAIL_OUT( "Could not obtain the EPrints System object" ); }
   18 
   19 my $repo = $ep->repository( $repoid );
   20 isa_ok( $repo, "EPrints::Repository", "Get a repository object ($repoid)" );
   21 if( !defined $repo ) { BAIL_OUT( "Could not obtain the Repository object" ); }
   22 
   23 EPrints::Test::RepositoryLog->logs; # clear logs
   24 my $phrase = $repo->phrase( "xxx_invalid" );
   25 my( $err ) = EPrints::Test::RepositoryLog->logs;
   26 diag($err);
   27 ok($err =~ /^Undefined phrase/, "invalid phrase triggers warning");
   28 
   29 SKIP: {
   30     skip "Set EPRINTS_LANG_DUPES=n, n >= 1", 1
   31         unless $ENV{EPRINTS_LANG_DUPES};
   32 
   33     my $lang = $repo->get_language;
   34 
   35     my %phrases;
   36     foreach my $data ($lang->_get_data, $lang->_get_repositorydata)
   37     {
   38         %phrases = (%phrases, %{$data->{xml}});
   39     }
   40 
   41     my %seen;
   42     while(my( $id, $xml ) = each %phrases)
   43     {
   44         push @{$seen{Digest::MD5::md5(_phrase_toString($xml))}}, $id;
   45     }
   46 
   47     diag("");
   48     diag(sprintf("%d of %d phrases are unique", scalar keys %seen, scalar keys %phrases));
   49 
   50     my $show = $ENV{EPRINTS_LANG_DUPES};
   51     foreach my $md5 (sort { @{$seen{$b}} <=> @{$seen{$a}} } keys %seen)
   52     {
   53         my $c = scalar @{$seen{$md5}};
   54         last if $c == 1;
   55         my $id = $seen{$md5}->[0];
   56         my $phrase = _phrase_toString($phrases{$id});
   57         next if $phrase eq "";
   58         $phrase =~ s/\n/\\n/s;
   59         $phrase =~ s/^(.{20}).+$/$1 .../s;
   60         diag(sprintf("%d x '%s': %s", $c, $phrase, $id));
   61         last if !$show--;
   62     }
   63 
   64     ok(1, "lang dupes detection");
   65 };
   66 
   67 sub _phrase_toString
   68 {
   69     my( $node ) = @_;
   70     my $str = "";
   71     for($node->childNodes)
   72     {
   73         $str .= $_->toString;
   74     }
   75     return $str;
   76 }
   77 
   78 =head1 COPYRIGHT
   79 
   80 =for COPYRIGHT BEGIN
   81 
   82 Copyright 2022 University of Southampton.
   83 EPrints 3.4 is supplied by EPrints Services.
   84 
   85 http://www.eprints.org/eprints-3.4/
   86 
   87 =for COPYRIGHT END
   88 
   89 =for LICENSE BEGIN
   90 
   91 This file is part of EPrints 3.4 L<http://www.eprints.org/>.
   92 
   93 EPrints 3.4 and this file are released under the terms of the
   94 GNU Lesser General Public License version 3 as published by
   95 the Free Software Foundation unless otherwise stated.
   96 
   97 EPrints 3.4 is distributed in the hope that it will be useful,
   98 but WITHOUT ANY WARRANTY; without even the implied warranty of
   99 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  100 See the GNU Lesser General Public License for more details.
  101 
  102 You should have received a copy of the GNU Lesser General Public
  103 License along with EPrints 3.4.
  104 If not, see L<http://www.gnu.org/licenses/>.
  105 
  106 =for LICENSE END
  107