File Coverage

blib/lib/Treex/PML/Instance/Common.pm

Criterion	Covered	Total	%
statement	24	51	47.0
branch	1	12	8.3
condition			n/a
subroutine	9	13	69.2
pod	2	2	100.0
total	36	78	46.1

package Treex::PML::Instance::Common;

use 5.008;
use strict;
use warnings;
use Carp;

require Exporter;
import Exporter qw( import );

our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
  'diagnostics' => [ qw( _die _warn _debug DEBUG XSLT_BUG ) ],
  'constants' => [ qw( LM AM PML_NS SUPPORTED_PML_VERSIONS ) ],
);
$EXPORT_TAGS{'all'} = [
  @{ $EXPORT_TAGS{'constants'} },
  @{ $EXPORT_TAGS{'diagnostics'} },
  qw( $DEBUG $XSLT_BUG SUPPORTED_PML_VERSIONS )
];

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(  );
our $VERSION = '2.24'; # version template


our $DEBUG = $ENV{PML_DEBUG}||0;

our $XSLT_BUG=0;
eval {
    require XML::LibXSLT;
    $XSLT_BUG = grep 10127 == $_, XML::LibXSLT::LIBXSLT_VERSION(),
                                  XML::LibXSLT::LIBXSLT_RUNTIME_VERSION();
};

use constant LM => 'LM';
use constant AM => 'AM';
use constant PML_NS => "http://ufal.mff.cuni.cz/pdt/pml/";
use constant SUPPORTED_PML_VERSIONS => " 1.1 1.2 ";

###################################
# DIAGNOSTICS
###################################

sub XSLT_BUG {
  return $XSLT_BUG;
}

sub DEBUG {
  if (@_) { $DEBUG=$_[0] };
  return $DEBUG
}

sub _die {
  my $msg = join q{},@_;
  chomp $msg;
  if ($DEBUG) {
    local $Carp::CarpLevel=1;
    confess($msg);
  } else {
    die "$msg\n";
  }
}

sub _debug {
  return unless $DEBUG;
  my $level = 1;
  my $node = undef;
  if (ref($_[0])) {
    $level=$_[0]->{level};
    $node=$_[0]->{node};
    shift;
  }
  return unless abs($DEBUG)>=$level;
  my $msg=join q{},@_;
  chomp $msg;
  $msg =~ s/\%N/_element_address($node)/e;
  print STDERR "Treex::PML: $msg\n"
}

sub _warn {
  my $msg = join q{},@_;
  chomp $msg;
  if ($DEBUG<0) {
    Carp::cluck("Treex::PML: WARNING: $msg");
  } else {
    warn("Treex::PML: WARNING: $msg\n");
  }
}



1;
__END__