xmltv-util 0.5.67-0.1 / usr / bin / tv_to_latex

#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

=pod

=head1 NAME

tv_to_latex - Convert XMLTV listings to LaTeX source.

=head1 SYNOPSIS

tv_to_latex [--help] [--with-desc] [--output FILE] [FILE...]

=head1 DESCRIPTION

Read XMLTV data and output LaTeX source for a summary of listings.
The programme titles, subtitles, times and channels are shown.

B<--with-desc> include programme description in output

B<--output FILE> write to FILE rather than standard output

=head1 SEE ALSO

L<xmltv(5)>.

=head1 AUTHOR

Ed Avis, ed@membled.com

=head1 BUGS

The LaTeX source generated is not perfect, it sometimes produces
spurious blank lines in the output.

=cut

use strict;
use XMLTV::Version '$Id: tv_to_latex,v 1.18 2014/05/05 16:02:53 bilbo_uk Exp $ ';
use IO::File;
use POSIX 'tmpnam';
use Getopt::Long;

# Use Log::TraceMessages if installed.
BEGIN {
    eval { require Log::TraceMessages };
    if ($@) {
	*t = sub {};
	*d = sub { '' };
    }
    else {
	*t = \&Log::TraceMessages::t;
	*d = \&Log::TraceMessages::d;
	Log::TraceMessages::check_argv();
    }
}

# Use Unicode::String if installed, else kludge.
my $warned_strip = 0;
sub my_u8_to_latin1( $ ) {
    local $_ = shift;
    tr/\000-\177//cd
      && (not $warned_strip++)
	&& warn "stripping non-ASCII characters, install Unicode::String\n";
    return $_;
}
BEGIN {
    eval { require Unicode::String };
    if ($@) {
	*u8_to_latin1 = \&my_u8_to_latin1;
    }
    else {
	*u8_to_latin1 = sub {
	    Unicode::String::utf8($_[0])->latin1()
	  };
    }
}

use XMLTV;
use XMLTV::Summarize qw(summarize);
use XMLTV::Usage <<END
$0: convert listings to LaTeX source for printing
usage: $0 [--help] [--with-desc] [--output FILE] [FILE...]
END
;

sub quote( $ );

my ($opt_help, $opt_output, $opt_withdesc);
GetOptions('help' => \$opt_help, 'output=s' => \$opt_output, 'with-desc' => \$opt_withdesc) or usage(0);
usage(1) if $opt_help;
@ARGV = ('-') if not @ARGV;
if (defined $opt_output) {
    open(STDOUT, ">$opt_output")
      or die "cannot write to $opt_output: $!";
}
$opt_withdesc = 0 if !defined $opt_withdesc;

########
# Configuration
#

# Width of programme title
my $WIDTH = '0.7\textwidth';
$WIDTH = '0.35\textwidth' if $opt_withdesc;		# adjust column width if outputting description

# Number of programmes in each table (should fit onto a page)
my $CHUNK_SIZE = 30; # at least 1, please

########
# End of configuration
#

# FIXME maybe memoize some stuff here

# Print the start of the LaTeX document.
print <<'END';
\documentclass[a4paper]{article}
\usepackage[latin1]{inputenc}
\begin{document}
\sf
\begin{flushleft}
END

# Read input and work out how to handle its encoding.
my ($encoding, $credits, $ch, $progs) = @{XMLTV::parsefiles(@ARGV)};
my $to_latin1;
for ($encoding) {
  START:
    if (not defined) {
	warn "encoding of input unknown, assuming ISO-8859-1\n";
	$_ = 'ISO-8859-1';
	goto START;
    }
    elsif (/^UTF-?8$/) {
	$to_latin1 = \&u8_to_latin1;
    }
    elsif (/^(?:US-?)ASCII$/ or /^[Ll]atin-?1/ or /^ISO-?8859-?1$/) {
	$to_latin1 = sub { $_[0] }; # identity
    }
    else {
	warn "unknown encoding $_, assuming ISO-8859-1\n";
	$_ = 'ISO-8859-1';
	goto START;
    }
}

my $table_size = 0; # 0 means no table currently open
sub maybe_end_table() {
    return if not $table_size;
    print '\end{tabular} \\\\ ', "\n";
    $table_size = 0;
}
# Pass in LaTeX source.
sub print_row( $ ) {
    my $tex = shift;
    if ($table_size == $CHUNK_SIZE) {
	maybe_end_table(); # back to 0
    }

    print '\begin{tabular}{r@{--}lp{', $WIDTH, '}r', ($opt_withdesc ? "p{$WIDTH}" : ''), '} ', "\n"
      if not $table_size++;
    print $tex;
}

my @summ = summarize($ch, $progs);
foreach (@summ) {
    die if not defined;
    if (not ref) {
	# Heading for a new day.
	maybe_end_table();
	print '\section*{\sf ', quote($to_latin1->($_)), "}\n";
    }
    else {
	my ($start, $stop, $title, $sub_title, $channel, $desc)
	  = map { defined() ? quote($to_latin1->($_)) : undef } @$_;
	die if not defined $start;
	die if not defined $title;
	die if not defined $channel;

	# Apparently, you have to put \smallskip _before_ each line
	# (even the first) in order to get consistent spacing.  The
	# blank line after $title is to explicitly end the paragraph,
	# so that \raggedright takes effect.
	#
	$stop = '' if not defined $stop;
	$title .= " // $sub_title" if defined $sub_title;
	$desc = '' if not defined $desc;
	my $row;
	if ($opt_withdesc) {
		$row = <<END
\\smallskip
$start & $stop &
{ \\small \\raggedright
$title
} & $channel &
{ \\small \\raggedright 
$desc 
} \\\\
END
	} else {
		$row = <<END
\\smallskip
$start & $stop &
{ \\small \\raggedright
$title
} & $channel \\\\
END
	}
        print_row($row);
    }
}
maybe_end_table();
print "\\end{flushleft}\n";

# Acknowledgements
my $g = $credits->{'generator-info-name'};
$g =~ s!/(\d)! $1! if defined $g;
my $s = $credits->{'source-info-name'};
if (not defined $g and not defined $s) {
    # No acknowledgement since unknown source.
}
elsif (not defined $g and defined $s) {
    print 'Generated from \textbf{', quote($to_latin1->($s)), "}.\n";
}
elsif (defined $g and not defined $s) {
    print 'Generated by \textbf{', quote($to_latin1->($g)),  "}.\n";
}
elsif (defined $g and defined $s) {
    print 'Generated from \textbf{', quote($to_latin1->($s)), '} by \textbf{', quote($to_latin1->($g)), "}.\n";
}
else { die }
print "\\end{document}\n";


# quote()
# 
# Quote at least some characters which do funny things in LaTeX.
# 
# Parameters: string to quote
# Returns: quoted version
# 
# Copied from <http://membled.com/work/apps/dtd2latex/>;
# should put something like this into a 'LaTeX' module some day.
# 
sub quote( $ ) {
    die 'usage: quote(string)' if @_ != 1;
    local $_ = shift;

    # Quote characters
    s/\\/\\(\\backslash\\)/g;
    foreach my $ch ('_', '#', '%', '{', '}', '&', '|') {
	s/\Q$ch\E/\\$ch/g;
    }
    s/\$/\\\$/g;
    foreach my $ch ('<', '>') {
	s/$ch/\\($ch\\)/g;
    }
    s/~/\\(\\sim\\)/g;
    s/\^/\\(\\hat{}\\)/g;
    s/¦/\|/g;

    # Lines of dots
    s/\.{3,}\s*$/\\dotfill/mg;

    return $_;
}