<commit_before>package NonameTV;

use strict;
use warnings;

# Mark this source-file as encoded in utf-8.
use utf8;
use Env;

use Encode;
use File::Slurp;
use File::Temp qw/tempfile tempdir/;
use LWP::UserAgent;

use NonameTV::StringMatcher;
use NonameTV::Log qw/w/;
use XML::LibXML;

BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    
    # set the version for version checking
    $VERSION     = 0.3;

    @ISA         = qw(Exporter);
    @EXPORT      = qw( );
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
    @EXPORT_OK   = qw/MyGet expand_entities 
                      Html2Xml Htmlfile2Xml
                      Word2Xml Wordfile2Xml 
		      File2Xml Content2Xml
		      FindParagraphs
                      norm normLatin1 normUtf8 AddCategory
                      ParseDescCatSwe FixProgrammeData
		      ParseXml ParseXmltv
                      MonthNumber
                      CompareArrays
                     /;
}
our @EXPORT_OK;

my $wvhtml = 'wvHtml --charset=utf-8';
# my $wvhtml = '/usr/bin/wvHtml';

my $ua = LWP::UserAgent->new( agent => "nonametv (http://nonametv.org)", 
                              cookie_jar => {},
                              env_proxy => 1 );

# Fetch a url. Returns ($content, true) if data was fetched from server and
# different from the last time the same url was fetched, ($content, false) if
# it was fetched from the server and was the same as the last time it was
# fetched and (undef,$error_message) if there was an error fetching the data.
 
sub MyGet
{
  my( $url ) = @_;
  my $res = $ua->get( $url );
  
  if( $res->is_success )
  {
    return ($res->content, not defined( $res->header( 'X-Content-Unchanged' ) ) );
  }
  else
  {
    return (undef, $res->status_line );
  }
}

# åäö ÅÄÖ
my %ent = (
           257  => 'ä',
	   231  => 'c', # This should really be a c with a special mark on it.
	                # Unicode 000E7, UTF-8 195 167.
           337  => 'ö',
           8211 => '-',
           8212 => '--',
           8216 => "'",
           8217 => "'",
           8220 => '"',
           8221 => '"',
           8230 => '...',
           8364 => "(euro)",
           );

sub _expand
{
  my( $num, $str ) = @_;

  if( not defined( $ent{$num} ) )
  {
    $ent{$num} = "";
    print STDERR "Unknown entity $num in $str\n";
  }

  return $ent{$num};
}

sub expand_entities
{
  my( $str ) = @_;

  $str =~ s/\&#(\d+);/_expand($1,$str)/eg;

  return $str;
}

=item Html2Xml( $content )

Convert the HTML in $content into an XML::LibXML::Document.

Prints an error-message to STDERR and returns undef if the conversion
fails.

=cut

sub Html2Xml {
  my( $html ) = @_;

  my $xml = XML::LibXML->new;
  $xml->recover(1);
  
  # Remove character that makes the parser stop.
  $html =~ s/\x00//g;

  my $doc;
  eval { $doc = $xml->parse_html_string($html, {
    recover => 1,
    suppress_errors => 1,
    suppress_warnings => 1,
  }); };
  
  if( $@ ne "" ) {
    my ($package, $filename, $line) = caller;
    print "parse_html_string failed: $@ when called from $filename:$line\n";
    return undef;
  }

  return $doc;
}

=item Htmlfile2Xml( $filename )

Convert the HTML in a file into an XML::LibXML::Document.

Prints an error-message to STDERR and returns undef if the conversion
fails.

=cut

sub Htmlfile2Xml
{
  my( $filename ) = @_;

  my $html = read_file( $filename );

  return Html2Xml( $html );
}


=item Word2Xml( $content )

Convert the Microsoft Word document in $content into html and return
the html as an XML::LibXML::Document.

Prints an error-message to STDERR and returns undef if the conversion
fails.

=cut

sub Word2Xml
{
  my( $content ) = @_;
  
  my( $fh, $filename ) = tempfile();
  print $fh $content;
  close( $fh );

  my $doc = Wordfile2Xml( $filename );
  unlink( $filename );
  return $doc;
}

sub Wordfile2Xml
{
  my( $filename ) = @_;

  my $html = qx/$wvhtml "$filename" -/;
  if( $? )
  {
    w "$wvhtml $filename - failed: $?";
    return undef;
  }
  
  # Remove character that makes LibXML choke.
  $html =~ s/\&hellip;/.../g;
  
  return Html2Xml( $html );
}

sub File2Xml {
  my( $filename ) = @_;

  my $data = read_file( $filename );
  my $doc;
  if( $data =~ /^\<\!DOCTYPE HTML/ )
  {
    # This is an override that has already been run through wvHtml
    $doc = Html2Xml( $data );
  }
  else
  {
    $doc = Word2Xml( $data );
  }

  return $doc;
}

sub Content2Xml {
  my( $cref ) = @_;

  my $doc;
  if( $$cref =~ /^\<\!DOCTYPE HTML/ )
  {
    # This is an override that has already been run through wvHtml
    $doc = Html2Xml( $$cref );
  }
  else
  {
    $doc = Word2Xml( $$cref );
  }

  return $doc;
}

=pod

FindParagraphs( $doc, $expr )

Finds all paragraphs in the part of an xml-tree that matches an 
xpath-expression. Returns a reference to an array of strings.
All paragraphs are normalized and empty strings are removed from the
array.

Both <div> and <br> are taken into account when splitting the document
into paragraphs.

Use the expression '//body//.' for html-documents when you want to see
all paragraphs in the page.

=cut 

my %paraelem = (
		p => 1,
		br => 1,
		div => 1,
		td => 1,
		);

sub FindParagraphs {
  my( $doc, $elements ) = @_;

  my $ns = $doc->find( $elements );

  my @paragraphs;
  my $p = "";

  foreach my $node ($ns->get_nodelist()) {
    if( $node->nodeName eq "#text" ) {
      $p .= $node->textContent();
    }
    elsif( defined $paraelem{ $node->nodeName } ) {
      $p = norm( $p );
      if( $p ne "" ) {
	push @paragraphs, $p;
	$p = "";
      }
    }
  }

  return \@paragraphs;
}


# Remove any strange quotation marks and other syntactic marks
# that we don't want to have. Remove leading and trailing space as well
# multiple whitespace characters.
# Returns the empty string if called with an undef string.
sub norm
{
  my( $str ) = @_;

  return "" if not defined( $str );

# Uncomment the code below and change the regexp to learn which
# character code perl thinks a certain character has.
# These codes can be used in \x{YY} expressions as shown below.
#  if( $str =~ /unique string/ ) {
#    for( my $i=0; $i < length( $str ); $i++ ) {
#      printf( "%2x: %s\n", ord( substr( $str, $i, 1 ) ), 
#               substr( $str, $i, 1 ) ); 
#    }
#  }

  $str = expand_entities( $str );
  
  $str =~ tr/\x{96}\x{93}\x{94}/-""/; #
  $str =~ tr/\x{201d}\x{201c}/""/;
  $str =~ tr/\x{2022}/*/; # Bullet
  $str =~ tr/\x{2013}\x{2018}\x{2019}/-''/;
  $str =~ tr/\x{017c}\x{0144}\x{0105}/zna/;
  $str =~ s/\x{85}/... /g;
  $str =~ s/\x{2026}/.../sg;
  $str =~ s/\x{2007}/ /sg;

  $str =~ s/^\s+//;
  $str =~ s/\s+$//;
  $str =~ tr/\n\r\t /    /s;
  $str =~ s/ +/ /;
  
  return $str;
}

#
# fixup utf8 with the microsoft variant of latin1 instead of iso-8859-1 in the lower 256 code points
#
# see http://en.wikipedia.org/wiki/Windows-1252
#
sub normLatin1
{
  my( $str ) = @_;

  return undef if not defined( $str );

  $str =~ tr/\x{80}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8e}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9e}\x{9f}/\x{20ac}\x{201a}\x{0192}\x{201e}\x{2026}\x{2020}\x{2021}\x{02c6}\x{2030}\x{0160}\x{2039}\x{0152}\x{017d}\x{2018}\x{2019}\x{201c}\x{201d}\x{2022}\x{2012}\x{2014}\x{02dc}\x{2122}\x{0161}\x{203a}\x{0153}\x{017e}\x{0178}/; #

  return $str;
}

#
# fixup utf8 encoded twice
#
sub normUtf8
{
  my( $str ) = @_;

  return undef if not defined( $str );

  # we have got a string of perl characters
  $str = encode('utf-8', $str);

  $str =~ s|([\x{C3}][\x{82}-\x{83}][\x{C2}][\x{80}-\x{BF}])|encode('iso-8859-1', decode('utf-8', $1) )|eg;

  # it should still be a string of perl characters
  $str = decode('utf-8', $str);

  return $str;
}

=item AddCategory

Add program_type and category to an entry if the entry does not already
have a program_type and category. 

AddCategory( $ce, $program_type, $category );

=cut

sub AddCategory
{<commit_msg>add normUndef to turn empty strings into undef<commit_after>package NonameTV;

use strict;
use warnings;

# Mark this source-file as encoded in utf-8.
use utf8;
use Env;

use Encode;
use File::Slurp;
use File::Temp qw/tempfile tempdir/;
use LWP::UserAgent;

use NonameTV::StringMatcher;
use NonameTV::Log qw/w/;
use XML::LibXML;

BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    
    # set the version for version checking
    $VERSION     = 0.3;

    @ISA         = qw(Exporter);
    @EXPORT      = qw( );
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
    @EXPORT_OK   = qw/MyGet expand_entities 
                      Html2Xml Htmlfile2Xml
                      Word2Xml Wordfile2Xml 
		      File2Xml Content2Xml
		      FindParagraphs
                      norm normLatin1 normUndef normUtf8 AddCategory
                      ParseDescCatSwe FixProgrammeData
		      ParseXml ParseXmltv
                      MonthNumber
                      CompareArrays
                     /;
}
our @EXPORT_OK;

my $wvhtml = 'wvHtml --charset=utf-8';
# my $wvhtml = '/usr/bin/wvHtml';

my $ua = LWP::UserAgent->new( agent => "nonametv (http://nonametv.org)", 
                              cookie_jar => {},
                              env_proxy => 1 );

# Fetch a url. Returns ($content, true) if data was fetched from server and
# different from the last time the same url was fetched, ($content, false) if
# it was fetched from the server and was the same as the last time it was
# fetched and (undef,$error_message) if there was an error fetching the data.
 
sub MyGet
{
  my( $url ) = @_;
  my $res = $ua->get( $url );
  
  if( $res->is_success )
  {
    return ($res->content, not defined( $res->header( 'X-Content-Unchanged' ) ) );
  }
  else
  {
    return (undef, $res->status_line );
  }
}

# åäö ÅÄÖ
my %ent = (
           257  => 'ä',
	   231  => 'c', # This should really be a c with a special mark on it.
	                # Unicode 000E7, UTF-8 195 167.
           337  => 'ö',
           8211 => '-',
           8212 => '--',
           8216 => "'",
           8217 => "'",
           8220 => '"',
           8221 => '"',
           8230 => '...',
           8364 => "(euro)",
           );

sub _expand
{
  my( $num, $str ) = @_;

  if( not defined( $ent{$num} ) )
  {
    $ent{$num} = "";
    print STDERR "Unknown entity $num in $str\n";
  }

  return $ent{$num};
}

sub expand_entities
{
  my( $str ) = @_;

  $str =~ s/\&#(\d+);/_expand($1,$str)/eg;

  return $str;
}

=item Html2Xml( $content )

Convert the HTML in $content into an XML::LibXML::Document.

Prints an error-message to STDERR and returns undef if the conversion
fails.

=cut

sub Html2Xml {
  my( $html ) = @_;

  my $xml = XML::LibXML->new;
  $xml->recover(1);
  
  # Remove character that makes the parser stop.
  $html =~ s/\x00//g;

  my $doc;
  eval { $doc = $xml->parse_html_string($html, {
    recover => 1,
    suppress_errors => 1,
    suppress_warnings => 1,
  }); };
  
  if( $@ ne "" ) {
    my ($package, $filename, $line) = caller;
    print "parse_html_string failed: $@ when called from $filename:$line\n";
    return undef;
  }

  return $doc;
}

=item Htmlfile2Xml( $filename )

Convert the HTML in a file into an XML::LibXML::Document.

Prints an error-message to STDERR and returns undef if the conversion
fails.

=cut

sub Htmlfile2Xml
{
  my( $filename ) = @_;

  my $html = read_file( $filename );

  return Html2Xml( $html );
}


=item Word2Xml( $content )

Convert the Microsoft Word document in $content into html and return
the html as an XML::LibXML::Document.

Prints an error-message to STDERR and returns undef if the conversion
fails.

=cut

sub Word2Xml
{
  my( $content ) = @_;
  
  my( $fh, $filename ) = tempfile();
  print $fh $content;
  close( $fh );

  my $doc = Wordfile2Xml( $filename );
  unlink( $filename );
  return $doc;
}

sub Wordfile2Xml
{
  my( $filename ) = @_;

  my $html = qx/$wvhtml "$filename" -/;
  if( $? )
  {
    w "$wvhtml $filename - failed: $?";
    return undef;
  }
  
  # Remove character that makes LibXML choke.
  $html =~ s/\&hellip;/.../g;
  
  return Html2Xml( $html );
}

sub File2Xml {
  my( $filename ) = @_;

  my $data = read_file( $filename );
  my $doc;
  if( $data =~ /^\<\!DOCTYPE HTML/ )
  {
    # This is an override that has already been run through wvHtml
    $doc = Html2Xml( $data );
  }
  else
  {
    $doc = Word2Xml( $data );
  }

  return $doc;
}

sub Content2Xml {
  my( $cref ) = @_;

  my $doc;
  if( $$cref =~ /^\<\!DOCTYPE HTML/ )
  {
    # This is an override that has already been run through wvHtml
    $doc = Html2Xml( $$cref );
  }
  else
  {
    $doc = Word2Xml( $$cref );
  }

  return $doc;
}

=pod

FindParagraphs( $doc, $expr )

Finds all paragraphs in the part of an xml-tree that matches an 
xpath-expression. Returns a reference to an array of strings.
All paragraphs are normalized and empty strings are removed from the
array.

Both <div> and <br> are taken into account when splitting the document
into paragraphs.

Use the expression '//body//.' for html-documents when you want to see
all paragraphs in the page.

=cut 

my %paraelem = (
		p => 1,
		br => 1,
		div => 1,
		td => 1,
		);

sub FindParagraphs {
  my( $doc, $elements ) = @_;

  my $ns = $doc->find( $elements );

  my @paragraphs;
  my $p = "";

  foreach my $node ($ns->get_nodelist()) {
    if( $node->nodeName eq "#text" ) {
      $p .= $node->textContent();
    }
    elsif( defined $paraelem{ $node->nodeName } ) {
      $p = norm( $p );
      if( $p ne "" ) {
	push @paragraphs, $p;
	$p = "";
      }
    }
  }

  return \@paragraphs;
}


# Remove any strange quotation marks and other syntactic marks
# that we don't want to have. Remove leading and trailing space as well
# multiple whitespace characters.
# Returns the empty string if called with an undef string.
sub norm
{
  my( $str ) = @_;

  return "" if not defined( $str );

# Uncomment the code below and change the regexp to learn which
# character code perl thinks a certain character has.
# These codes can be used in \x{YY} expressions as shown below.
#  if( $str =~ /unique string/ ) {
#    for( my $i=0; $i < length( $str ); $i++ ) {
#      printf( "%2x: %s\n", ord( substr( $str, $i, 1 ) ), 
#               substr( $str, $i, 1 ) ); 
#    }
#  }

  $str = expand_entities( $str );
  
  $str =~ tr/\x{96}\x{93}\x{94}/-""/; #
  $str =~ tr/\x{201d}\x{201c}/""/;
  $str =~ tr/\x{2022}/*/; # Bullet
  $str =~ tr/\x{2013}\x{2018}\x{2019}/-''/;
  $str =~ tr/\x{017c}\x{0144}\x{0105}/zna/;
  $str =~ s/\x{85}/... /g;
  $str =~ s/\x{2026}/.../sg;
  $str =~ s/\x{2007}/ /sg;

  $str =~ s/^\s+//;
  $str =~ s/\s+$//;
  $str =~ tr/\n\r\t /    /s;
  $str =~ s/ +/ /;
  
  return $str;
}

#
# fixup utf8 with the microsoft variant of latin1 instead of iso-8859-1 in the lower 256 code points
#
# see http://en.wikipedia.org/wiki/Windows-1252
#
sub normLatin1
{
  my( $str ) = @_;

  return undef if not defined( $str );

  $str =~ tr/\x{80}\x{82}\x{83}\x{84}\x{85}\x{86}\x{87}\x{88}\x{89}\x{8a}\x{8b}\x{8c}\x{8e}\x{91}\x{92}\x{93}\x{94}\x{95}\x{96}\x{97}\x{98}\x{99}\x{9a}\x{9b}\x{9c}\x{9e}\x{9f}/\x{20ac}\x{201a}\x{0192}\x{201e}\x{2026}\x{2020}\x{2021}\x{02c6}\x{2030}\x{0160}\x{2039}\x{0152}\x{017d}\x{2018}\x{2019}\x{201c}\x{201d}\x{2022}\x{2012}\x{2014}\x{02dc}\x{2122}\x{0161}\x{203a}\x{0153}\x{017e}\x{0178}/; #

  return $str;
}

#
# fixup utf8 encoded twice
#
sub normUtf8
{
  my( $str ) = @_;

  return undef if not defined( $str );

  # we have got a string of perl characters
  $str = encode('utf-8', $str);

  $str =~ s|([\x{C3}][\x{82}-\x{83}][\x{C2}][\x{80}-\x{BF}])|encode('iso-8859-1', decode('utf-8', $1) )|eg;

  # it should still be a string of perl characters
  $str = decode('utf-8', $str);

  return $str;
}

#
# turn empty strings into undef / NULL
#
sub normUndef
{
  my( $str ) = @_;

  return undef if( !$str );
  return $str;
}

=item AddCategory

Add program_type and category to an entry if the entry does not already
have a program_type and category. 

AddCategory( $ce, $program_type, $category );

=cut

sub AddCategory
{
{'fraction_non_alphanumeric': 0.16987577639751553, 'fraction_numerical': 0.04012422360248447, 'mean_word_length': 2.473037100949094, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 79, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 8}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5062728', 'n_tokens_mistral': 6600, 'n_tokens_neox': 6077, 'n_words': 1692}