t/db_dependent/Koha/XSLT/Base.t

   1 #!/usr/bin/perl
   2
   3 # Copyright 2014 Rijksmuseum
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use File::Temp qw/tempfile/;
  23 use Test::More tests => 33;
  24 use Test::Warn;
  25
  26 use Koha::XSLT::Base;
  27
  28 my $engine=Koha::XSLT::Base->new;
  29 is( ref $engine, 'Koha::XSLT::Base', 'Testing creation of handler object' );
  30
  31 $engine->transform('');
  32 is( $engine->err, Koha::XSLT::Base::XSLTH_ERR_1, 'Engine returns error on no file' );
  33
  34 $engine->transform( '', 'thisfileshouldnotexist.%$#@' );
  35 is( $engine->err, Koha::XSLT::Base::XSLTH_ERR_2, 'Engine returns error on bad file' );
  36 is( $engine->refresh( 'asdjhaskjh'), 0, 'Test on invalid refresh' );
  37
  38 #check first test xsl
  39 my $xsl_1 = <<'XSL_1';
  40 <xsl:stylesheet version="1.0"
  41     xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
  42     xmlns:marc="http://www.loc.gov/MARC21/slim"
  43 >
  44   <xsl:output method="xml" version="1.0" encoding="UTF-8" indent="yes"/>
  45
  46   <xsl:template match="record|marc:record">
  47       <record>
  48       <xsl:apply-templates/>
  49       <datafield tag="990" ind1='' ind2=''>
  50         <subfield code="a">
  51           <xsl:text>I saw you</xsl:text>
  52         </subfield>
  53       </datafield>
  54       </record>
  55   </xsl:template>
  56
  57   <xsl:template match="node()">
  58     <xsl:copy select=".">
  59       <xsl:copy-of select="@*"/>
  60       <xsl:apply-templates/>
  61     </xsl:copy>
  62   </xsl:template>
  63 </xsl:stylesheet>
  64 XSL_1
  65
  66 # Testing not-xml strings (undef, empty, some text, malformed xml
  67 # Undefined text tests
  68 my $output;
  69 $output = $engine->transform({ xml => undef, code => $xsl_1 });
  70 is( $engine->err, Koha::XSLT::Base::XSLTH_ERR_7, 'Engine returns error on undefined text' );
  71
  72 # Empty string tests
  73 warning_like {$output = $engine->transform({ xml => '', code => $xsl_1 }) }
  74     qr/XSLT::Base: Empty String/,
  75     'Empty string warning detected';
  76 is( $engine->err, Koha::XSLT::Base::XSLTH_ERR_5, 'Engine returns error on empty string' );
  77
  78 # Non-XML tests
  79 $engine->print_warns(1);
  80 warning_like { $output = $engine->transform({ xml => 'abcdef', code => $xsl_1 }) }
  81     qr{parser error : Start tag expected, '<' not found},
  82     "Non-XML warning correctly displayed";
  83 is( $engine->err, Koha::XSLT::Base::XSLTH_ERR_5, 'Engine returns error on non-xml' );
  84
  85 # Malformed XML tests
  86 warning_like { $output = $engine->transform({ xml => '<a></b>', code => $xsl_1 }) }
  87     qr{parser error : Opening and ending tag mismatch: a line (0|1) and b},
  88     "Malformed XML warning correctly displayed";
  89 is( $engine->err, Koha::XSLT::Base::XSLTH_ERR_5, 'Engine returns error on malformed xml' );
  90
  91 #Test not returning source on failure when asked for
  92 #Include passing do_not_return via constructor on second engine
  93 my $secondengine=Koha::XSLT::Base->new( {
  94     do_not_return_source => 'very_true',
  95     some_unknown_attrib  => 'just_for_fun',
  96 });
  97 $engine->do_not_return_source(1);
  98 warning_like { $output = $engine->transform({ xml => '<a></b>', code => $xsl_1 }) }
  99     qr{parser error : Opening and ending tag mismatch: a line (0|1) and b},
 100     "Malformed XML warning correctly displayed";
 101 is( defined $output? 1: 0, 0, 'Engine respects do_not_return_source==1');
 102 $secondengine->print_warns(1);
 103 warning_like { $output = $secondengine->transform({ xml => '<a></b>', code => $xsl_1 }) }
 104     qr{parser error : Opening and ending tag mismatch: a line (0|1) and b},
 105     "Malformed XML warning correctly displayed";
 106 is( defined $output? 1: 0, 0, 'Second engine respects it too');
 107 undef $secondengine; #bye
 108 $engine->do_not_return_source(0);
 109 warning_like { $output = $engine->transform({ xml => '<a></b>', code => $xsl_1 }) }
 110     qr{parser error : Opening and ending tag mismatch: a line (0|1) and b},
 111     "Malformed XML warning correctly displayed";
 112 is( defined $output? 1: 0, 1, 'Engine respects do_not_return_source==0');
 113
 114 #Testing valid refresh now
 115 my $xsltfile_1 = mytempfile($xsl_1);
 116 $output = $engine->transform( '<records/>', $xsltfile_1 );
 117 is( $engine->refresh($xsltfile_1), 1, 'Test on valid refresh' );
 118 is( $engine->refresh, 1, 'Second refresh returns 1 for code xsl_1' );
 119 is( $engine->refresh, 0, 'Third refresh: nothing left' );
 120
 121 #Testing a string that should not change too much
 122 my $xml_1=<<'EOT';
 123 <just_a_tagname>
 124 </just_a_tagname>
 125 EOT
 126 $output= $engine->transform({ xml => $xml_1, code => $xsl_1 });
 127 is( $engine->err, undef, 'Engine returned no error for xml_1' );
 128 is( index($output,'<just_a_tagname>')>0, 1, 'No real change expected for xml_1' ); #Just very simple check if the tag was still there
 129
 130 #Test of adding a new datafield to rudimentary 'marc record'
 131 my $xml_2=<<'EOT';
 132 <?xml version="1.0" encoding="UTF-8"?>
 133 <collection>
 134 <record>
 135 <controlfield tag="001">1234</controlfield>
 136 <datafield tag="245" ind1="1" ind2="0"><subfield tag="a">My favorite title</subfield></datafield>
 137 </record>
 138 </collection>
 139 EOT
 140 $output= $engine->transform( $xml_2 );
 141     #note: second parameter not passed again
 142 is( $engine->err, undef, 'Engine returned no error for xml_2' );
 143 is( index($output,'I saw you')>0, 1, 'Saw the expected change for xml_2' ); #Just very simple check if new datafield was added
 144 #Test alternative parameter passing
 145 my $output2;
 146 $output2 = $engine->transform( { file => $xsltfile_1, xml => $xml_2 } );
 147 is( $output, $output2, 'Try hash parameter file');
 148 $output2 = $engine->transform( { code => $xsl_1, xml => $xml_2 } );
 149 is( $output, $output2, 'Try hash parameter code');
 150 #Check rerun on last code
 151 $output2 = $engine->transform( $xml_2 );
 152 is( $output, $output2, 'Rerun on previous passed code');
 153 #Check format xmldoc
 154 is( ref $engine->transform({
 155     file => $xsltfile_1, xml => $xml_2, format => 'xmldoc',
 156 }), 'XML::LibXML::Document',
 157 'Format parameter returns a xml document object' );
 158
 159 #The second test xsl contains bad code
 160 my $xsl_2 = <<'XSL_2';
 161 <!-- This is BAD coded xslt stylesheet -->
 162 <xsl:stylesheet version="1.0"
 163     xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
 164     xmlns:marc="http://www.loc.gov/MARC21/slim"
 165 >
 166   <xsl:output method="xml" version="1.0" encoding="UTF-8" indent="yes"/>
 167
 168   <xsl:variable name="redefine" select="0"/>
 169   <xsl:variable name="redefine" select="1"/>
 170       <!-- Intentional redefine to generate parsing error -->
 171   <xsl:template match="record">
 172   </xsl:template>
 173 </xsl:stylesheet>
 174 XSL_2
 175
 176 $engine->print_warns(0);
 177 $output = $engine->transform({ xml => $xml_2, code => $xsl_2 });
 178 is( $engine->err, Koha::XSLT::Base::XSLTH_ERR_4, 'Engine returned error for parsing bad xsl' );
 179
 180 #The third test xsl is okay again; main use is clearing two items from cache
 181 my $xsl_3 = <<'XSL_3';
 182 <xsl:stylesheet version="1.0"
 183     xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
 184     xmlns:marc="http://www.loc.gov/MARC21/slim"
 185 >
 186   <xsl:output method="xml" encoding="UTF-8" version="1.0" indent="yes"/>
 187
 188   <xsl:template match="/">
 189       <xsl:apply-templates/>
 190   </xsl:template>
 191
 192   <xsl:template match="node()">
 193     <xsl:copy select=".">
 194       <xsl:copy-of select="@*"/>
 195       <xsl:apply-templates/>
 196     </xsl:copy>
 197   </xsl:template>
 198 </xsl:stylesheet>
 199 XSL_3
 200
 201 $output= $engine->transform({ xml => $xml_2, code => $xsl_3 });
 202 is( $engine->err, undef, 'Unexpected error on transform with third xsl' );
 203 is( $engine->refresh, 3, 'Final test on clearing cache' );
 204
 205 # Test xsl no 4
 206 my $xsl_4 = <<'XSL_4';
 207 <xsl:stylesheet version="1.0"
 208     xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
 209     xmlns:marc="http://www.loc.gov/MARC21/slim"
 210 >
 211   <xsl:output method="xml" encoding="UTF-8" version="1.0" indent="yes"/>
 212   <xsl:param name="injected_variable" />
 213
 214   <xsl:template match="/">
 215       <xsl:apply-templates/>
 216   </xsl:template>
 217
 218   <xsl:template match="node()">
 219     <xsl:copy>
 220    <xsl:value-of select="$injected_variable"/>
 221     </xsl:copy>
 222   </xsl:template>
 223
 224 </xsl:stylesheet>
 225 XSL_4
 226
 227 my $parameters = { injected_variable => "'this is a test'",};
 228 $output = $engine->transform({
 229             xml => $xml_1,
 230             code => $xsl_4,
 231             parameters => $parameters,
 232         });
 233 require XML::LibXML;
 234 my $dom = XML::LibXML->load_xml(string => $output);
 235 my $result = $dom->find( '/just_a_tagname' );
 236 is ( $result->to_literal(), 'this is a test', "Successfully injected string into XSLT parameter/variable");
 237
 238 $output = $engine->transform({
 239             xml => $xml_1,
 240             code => $xsl_4,
 241         });
 242 $dom = XML::LibXML->load_xml(string => $output);
 243 $result = $dom->find( '/just_a_tagname' );
 244 is ( $result->to_literal(), '', "As expected, no XSLT parameters/variables were added");
 245
 246 sub mytempfile {
 247     my ( $fh, $fn ) = tempfile( SUFFIX => '.xsl', UNLINK => 1 );
 248     print $fh $_[0]//'';
 249     close $fh;
 250     return $fn;
 251 }