xmltv/lib XMLTV.pm.in,1.159,1.160
Geoff <[email protected]>
| Newsgroups | gmane.comp.tv.xmltv.cvs |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/xmltv/xmltv/lib
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv4406
Modified Files:
XMLTV.pm.in
Log Message:
allow tv_cat to merge files with different encodings (Bug #144)
Index: XMLTV.pm.in
===================================================================
RCS file: /cvsroot/xmltv/xmltv/lib/XMLTV.pm.in,v
retrieving revision 1.159
retrieving revision 1.160
diff -C2 -d -r1.159 -r1.160
*** XMLTV.pm.in 1 Apr 2014 18:44:48 -0000 1.159
--- XMLTV.pm.in 19 Apr 2014 08:49:59 -0000 1.160
***************
*** 34,37 ****
--- 34,42 ----
my $KEEP_ENCODING = 1;
+ # We need a way of telling parsefiles_callback() to optionally *not* die when presented with multiple encodings,
+ # but without affecting any other packages which uses it (i.e. so a new sub param is out of the question)
+ # - best I can think of for the minute is a global (yuk)
+ my $DIE_ON_MULTIPLE_ENCODINGS = 1;
+
my %warned_unknown_key;
sub warn_unknown_keys( $$ );
***************
*** 499,503 ****
my %all_channels;
! my $do_next_file; # to be defined below
my $my_enc_cb = sub( $ ) {
my $e = shift;
--- 504,510 ----
my %all_channels;
! my $do_next_file; # sub to parse file ( defined below)
! my $do_file_number; # current file in @files array
!
my $my_enc_cb = sub( $ ) {
my $e = shift;
***************
*** 510,514 ****
}
elsif (not $da and $de) {
! warn "encoding $e not being returned to caller\n";
$all_encoding = $e;
}
--- 517,521 ----
}
elsif (not $da and $de) {
! ##warn "encoding $e not being returned to caller\n";
$all_encoding = $e;
}
***************
*** 518,529 ****
elsif ($da and $de) {
if (uc($all_encoding) ne uc($e)) {
die "this file's encoding $e differs from others' $all_encoding - aborting\n";
}
}
else { die }
}
else {
t 'not seen encoding before, call user';
! $enc_cb->($e) if $enc_cb;
$all_encoding = $e;
$have_encoding = 1;
--- 525,542 ----
elsif ($da and $de) {
if (uc($all_encoding) ne uc($e)) {
+ if ( defined $DIE_ON_MULTIPLE_ENCODINGS && !$DIE_ON_MULTIPLE_ENCODINGS ) {
+ warn "this file's encoding $e differs from others' $all_encoding \n";
+ } else {
die "this file's encoding $e differs from others' $all_encoding - aborting\n";
}
}
+ }
else { die }
+ t 'have encoding, call user';
+ $enc_cb->($e, $do_file_number) if $enc_cb;
}
else {
t 'not seen encoding before, call user';
! $enc_cb->($e, $do_file_number) if $enc_cb;
$all_encoding = $e;
$have_encoding = 1;
***************
*** 555,565 ****
else {
$all_channels{$id} = $c;
! $ch_cb->($c) if $ch_cb;
}
};
my $my_p_cb = sub( $ ) {
$do_next_file->(); # if any
! $p_cb->(@_) if $p_cb;
};
--- 568,582 ----
else {
$all_channels{$id} = $c;
! $ch_cb->($c, $do_file_number) if $ch_cb;
}
};
my $my_p_cb = sub( $ ) {
+ my $doing_file = $do_file_number;
+
$do_next_file->(); # if any
!
! $do_file_number = $doing_file;
! $p_cb->(@_, $do_file_number) if $p_cb;
};
***************
*** 569,572 ****
--- 586,591 ----
my $f = pop @files;
+ $do_file_number = scalar @files;
+
# In older versions of perl there were segmentation faults
# when calling die() inside the parsing callbacks, so we
***************
*** 929,934 ****
The first argument is a hash reference giving information to pass to
C<XMLTV::Writer>E<39>s constructor. But do not specify encoding, this
! will be taken from the input files. Currently C<catfiles()> will fail
! work if the input files have different encodings.
=cut
--- 948,954 ----
The first argument is a hash reference giving information to pass to
C<XMLTV::Writer>E<39>s constructor. But do not specify encoding, this
! will be taken from the input files. C<catfiles()> will abort if the
! input files have different encodings, unless the 'UTF8'=1 argument
! is passed in.
=cut
***************
*** 937,945 ****
my $w_args = shift;
my $w;
my %seen_ch;
XMLTV::parsefiles_callback
(sub {
! die if defined $w;
! $w = new XMLTV::Writer(%$w_args, encoding => shift);
},
sub { $w->start(shift) },
--- 957,973 ----
my $w_args = shift;
my $w;
+ my $enc; # encoding of current file
+ my @encs; # encoding of all files being catenated
my %seen_ch;
+
+ $DIE_ON_MULTIPLE_ENCODINGS = ( defined $w_args->{UTF8} ? 0 : 1 );
+
XMLTV::parsefiles_callback
(sub {
! $enc = shift;
! my $do_file = shift;
! $encs[$do_file] = (defined $enc ? $enc : 'unknown');
! t "file $do_file = $enc" if defined $enc;
! $w = new XMLTV::Writer(%$w_args, encoding => ( defined $w_args->{UTF8} ? 'UTF-8' : $enc ) ) if !defined $w;
},
sub { $w->start(shift) },
***************
*** 948,951 ****
--- 976,990 ----
my $id = $c->{id};
if (not defined $seen_ch{$id}) {
+
+ my $do_file = shift;
+ if (defined $w_args->{UTF8}) {
+ if (uc($encs[$do_file]) ne 'UTF-8' && $encs[$do_file] ne 'unknown') {
+ # recode the incoming channel name
+ t 'recoding channel from '.$encs[$do_file].' to UTF-8';
+ require XMLTV::Data::Recursive::Encode;
+ $c = XMLTV::Data::Recursive::Encode->from_to($c, $encs[$do_file], 'UTF-8');
+ }
+ }
+
$w->write_channel($c);
$seen_ch{$id} = $c;
***************
*** 959,963 ****
}
},
! sub { $w->write_programme(shift) },
@_);
$w->end();
--- 998,1014 ----
}
},
! sub {
! my $p = shift;
! my $do_file = shift;
! if (defined $w_args->{UTF8}) {
! if (uc($encs[$do_file]) ne 'UTF-8' && $encs[$do_file] ne 'unknown') {
! # recode the incoming programme
! t 'recoding prog from '.$encs[$do_file].' to UTF-8';
! require XMLTV::Data::Recursive::Encode;
! $p = XMLTV::Data::Recursive::Encode->from_to($p, $encs[$do_file], 'UTF-8');
! }
! }
! $w->write_programme($p);
! },
@_);
$w->end();
------------------------------------------------------------------------------
Learn Graph Databases - Download FREE O'Reilly Book
"Graph Databases" is the definitive new guide to graph databases and their
applications. Written by three acclaimed leaders in the field,
this first edition is now available. Download your free book today!
http://p.sf.net/sfu/NeoTech