#! /usr/bin/perl

=head1 NAME

a2pdf - converts ASCII text to PDF format, with optional line/page numbering and Perl syntax highlighting

=head1 SYNOPSIS

 a2pdf [options] [filename]

=head2 Options

B<a2pdf> recognises the following command line options:

=over 4

=item --help

Displays usage message and exits.

=item --doc

Displays full documentation and exits.

=item --version

Prints the version number and exits

=item --output-file | -o

Specifies the filename for the PDF file. If this option is not set,
B<a2pdf> will output to STDOUT.

=item --header | --noheader | --title | --notitle

Prints the name and modification timestamp of the input file at the top
of each page. If input is taken from STDIN, then the current date and time
is printed. This option is enabled by default, use C<--notitle> or 
C<--noheader> to disable.

=item --footer | --nofooter | --page-numbers | --nopage-numbers

Adds the current page number to the bottom of each page. This is enabled
by default, use C<--nofooter> or C<--nopage-numbers> to disable.

=item --line-numbers | --noline-numbers

By default, line numbers will be included in the output PDF file. To
disable this behaviour, use the C<--noline-numbers> option.

=item --perl-syntax | --noperl-syntax

Enables or disables (default is enabled) Perl syntax highlighting. This
feature requires that the Perl::Tidy module is installed.

=item --page-width

=item --page-height

Page width and height in points. Default page size is 595 x 842 (A4).

=item --margins

=item --left-margin

=item --right-margin

=item --top-margin

=item --bottom-margin

Specifies the non-printable area of the page. The C<--margin> option will set
all margins to the same value, however individual margins may be altered with
the appropriate options. Values must be given in points. The default value for
all margins is 48 points (0.75").

=item --font-face

Sets the font to use for the PDF file - currently this must be one of the PDF
core fonts. The default font face is Courier.

=item --font-size

Font size in points, default value is 10.

=item --line-spacing

Line spacing in points, default value is the font size + 2.

=back

Options may be given in any format recognised by the I<Getopt::Long> Perl
module, e.g. C<--name=value> or C<--name value>. Option names may be
abbreviated to their shortest unique value.

If the input filename is not given, then B<a2pdf> will expect to
receive input from STDIN.

=head1 DEPENDENCIES

B<a2pdf> requires the I<PDF::API2> Perl module (tested with PDF::API2
version 0.3r77).

Perl syntax highlighting requires the I<Perl::Tidy> module (tested with
Perl::Tidy version 20031021)

=head1 BUGS / ISSUES

=over 4

=item *

If the Perl syntax highlighting feature is used and the input Perl code
uses source filter modules, then depending on the changes made by the
source filter the syntax highlighting may not be performed correctly. 

A workaround for this is to use the Filter::ExtractSource module which
captures Perl code after the source filtering has been processed during
compilation. This can be run in a pipeline with B<a2pdf> as follows:

 perl -c -MFilter::ExtractSource input.pl | a2pdf >output.pdf

=item *

When running under Red Hat 9, the LANG environment variable must be set
to 'C'.

=back

=head1 SEE ALSO

B<a2pdf> homepage - L<http://perl.jonallen.info/projects/a2pdf>

PDF::API2 - L<http://search.cpan.org/dist/PDF-API2>

Perl::Tidy - L<http://search.cpan.org/dist/Perl-Tidy>

Filter::ExtractSource - L<http://search.cpan.org/dist/Filter-ExtractSource>

=head1 AUTHOR

Written by Jon Allen (JJ), <jj@jonallen.info> / L<http://perl.jonallen.info>

=head1 COPYRIGHT and LICENCE

Copyright (C) 2004 Jon Allen (JJ)

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;

our $VERSION = '1.07';

# Set default options
my %options = (
  header        => 1,          # Include header on all pages
  footer        => 1,          # Include footer on all pages
  line_numbers  => 1,          # Print line numbers
  page_width    => 595,        # A4
  page_height   => 842,        # A4
  left_margin   => 48,         # 0.75"
  right_margin  => 48,         # 0.75"
  top_margin    => 48,         # 0.75"
  bottom_margin => 48,         # 0.75"
  font_face     => 'Courier',  # Monospaged text
  font_size     => 9,          # Text size = 9 points
  perl_syntax   => 1           # Perform Perl syntax highlighting
  );
  
# Parse command line options
GetOptions(\%options,
  qw/
    font_size|font-size=i
    font_face|font-face=s
    line_spacing|line-spacing=i
    page_size|page-size=s
    page_height|page-height=i
    page_width|page-width=i
    left_margin|left-margin=i
    right_margin|right-margin=i
    top_margin|top-margin=i
    bottom_margin|bottom-margin=i
    header|title!
    footer|page_numbers|page-numbers!
    line_numbers|line-numbers!
    perl_syntax|perl-syntax|perl!
    /,
  'output_file|o|output-file=s' => sub{open STDOUT,">$_[1]" or die("Cannot open output file $_[1]: $!\n")},
  'margins=i'       => sub{$options{top_margin}    = $_[1];
                           $options{bottom_margin} = $_[1];
                           $options{left_margin}   = $_[1];
                           $options{right_margin}  = $_[1]},
  'version' => sub{print "a2pdf version $VERSION\n"; exit},
  'help'    => sub{pod2usage(-verbose => 1)},
  'doc'     => sub{pod2usage(-verbose => 2)}
  ) or die;

# Create PDF object
my @text = (<>);
my $pdf  = a2pdf->new(%options, title => ((-e $ARGV) ? $ARGV : 'STDIN')." - ".scalar localtime($^T-((-e $ARGV) ? -M $ARGV : 0)*24*60*60));
$pdf->line_number_chars(($options{line_numbers}) ? length sprintf("%d",scalar @text) : 0);
  
# Print document
if ($options{perl_syntax}) {
  PERL: {
    eval "use Perl::Tidy";
    if ($@) {
      warn "Cannot perform syntax highlighting, Perl::Tidy not installed\n";
      goto NOPERL;
    }
    Perl::Tidy::perltidy(
      source    => \@text,
      formatter => $pdf
    );
  }
} else {
  NOPERL: {
    my $line_number;  
    foreach my $line (@text) {
      $line_number++;
      $pdf->print(($options{line_numbers}) ? $line_number : undef,$line);
    }
  }
}

exit;

#-----------------------------------------------------------------------

package a2pdf;

# Wrapper runctions for PDF::API2 to handle creation  
# of multiple pages, performs word-wrap, etc.

use strict;
use warnings;
use PDF::API2;

#-----------------------------------------------------------------------

sub new {
  my $invocant = shift;
  my $class    = ref($invocant) || $invocant;;

  # Set default options
  my $self = { @_ }; 
  bless $self,$class;
  
  # Define style mapping
  # This will relate Perl::Tidy's token types to a printing style
  $self->{stylemap} = {
    'header'     => 'helvetica9',
    'footer'     => 'helvetica9',
    'k'          => 'black_bold',
    '{'          => 'black_bold',
    '}'          => 'black_bold',
    'POD'        => 'grey_italic',
    'POD_START'  => 'grey_italic',
    'POD_END'    => 'grey_italic',
    'END_START'  => 'grey_italic',
    'DATA_START' => 'grey_italic',
    'DATA'       => 'grey_italic',
    'SYSTEM'     => 'grey_italic',
    '#'          => 'grey_italic',
    'J'          => 'red_italic',
    'j'          => 'red_italic',
    'i'          => 'blue',
    '->'         => 'blue',
    'w'          => 'green',
    'L'          => 'brown',
    'R'          => 'brown',
    'Q'          => 'purple',
    'q'          => 'purple',
  };
  
  # Define styles
  # Supports 3 properties, font (e.g. Helvetica, Courier, Times),
  # color (in hex), and type (Bold, Oblique, or BoldOblique)
  $self->{stylist} = {
    'helvetica9'  => {font=>'Helvetica',size=>9},
    'black_bold'  => {color=>'#000000',type=>'Bold'},
    'grey_italic' => {color=>'#333333',type=>'Oblique'},
    'red_italic'  => {color=>'#cc2222',type=>'Oblique'},
    'blue'        => {color=>'#222288'},
    'green'       => {color=>'#228822'},
    'brown'       => {color=>'#666622'},
    'purple'      => {color=>'#882288'},
  };
  
  # Set up first page
  $self->{page_number}   = 1;
  $self->{line_spacing}  = $self->{font_size}+2 unless ($self->{line_spacing});
  $self->{x_position}    = $self->{left_margin};
  $self->{y_position}    = $self->{page_height} - $self->{top_margin};
  $self->{pdf}           = PDF::API2->new;
  $self->{pdf}->mediabox($self->{page_width},$self->{page_height});
  $self->{page}          = $self->{pdf}->page;
  $self->makeover;
  $self->{header_height} = ($self->{header}) ? $self->generate_header : 0;
  $self->{footer_height} = ($self->{footer}) ? $self->generate_footer : 0;
  $self->{y_position}   -= $self->{header_height};
  
  return $self;
}

#-----------------------------------------------------------------------

sub print {
  my $self                = shift;
  my ($line_number,$text) = @_;

  $self->newline;
  $self->print_text_with_style(($line_number) ? sprintf($self->{line_number_template},$line_number,$text) : $text);
}

#-----------------------------------------------------------------------

sub write_line {    # This is the write_line method called by Perl::Tidy
  my $self        = shift;
  my $line        = shift;
  my $line_number = $line->{_line_number};
  my $line_type   = $line->{_line_type};
  my $line_text   = $line->{_line_text};
  chomp $line_text;

  $self->newline;
  $self->print_text_with_style(sprintf($self->{line_number_template},$line_number,'')) if ($self->{line_numbers});

  if ($line_type eq 'CODE') {
    $self->print_text_with_style($1) if ($line_text =~ /^(\s+)/);
    my @rtoken_list  = @{$line->{_rtokens}};
    my @rtoken_types = @{$line->{_rtoken_type}};
    foreach my $rtoken (@rtoken_list) {
      my $rtoken_type = shift @rtoken_types;
      $self->print_text_with_style($rtoken,$rtoken_type);
    }
  } else {
    $self->print_text_with_style($line_text,$line_type);
  }
}

#-----------------------------------------------------------------------

sub newline {
  my $self = shift;

  $self->{y_position} -= $self->{line_spacing};
  $self->{x_position} = $self->{left_margin};

  if ($self->{y_position} < ($self->{bottom_margin} + $self->{footer_height})) {
    $self->{page_number}++;
    $self->{page}        = $self->{pdf}->page;
    delete $self->{textobj};
    delete $self->{gfx};
    $self->makeover;
    $self->{nspace}      = $self->{textobj}->{$self->{current_style}}->advancewidth('n');
    $self->{y_position}  = $self->{page_height} - $self->{top_margin} - $self->{line_spacing};
    $self->{y_position} -= $self->{header_height};
    $self->generate_header if ($self->{header});
    $self->generate_footer if ($self->{footer});
  }  
}

#-----------------------------------------------------------------------

sub generate_header {
  my $self  = shift;
  my $style = $self->makeover('header');
  $self->{textobj}->{$style}->paragraph(
    $self->{title},
    -x => $self->{page_width}-$self->{right_margin}-$self->{textobj}->{$style}->advancewidth($self->{title}),
    -y => $self->{page_height}-$self->{top_margin}-12,
    -w => $self->{textobj}->{$style}->advancewidth($self->{title}),
    -h => 12
    );
  $self->{gfx} = $self->{page}->gfx unless (exists $self->{gfx});
  $self->{gfx}->move($self->{left_margin},$self->{page_height}-$self->{top_margin}-14);
  $self->{gfx}->line($self->{page_width}-$self->{right_margin},$self->{page_height}-$self->{top_margin}-14);
  $self->{gfx}->stroke;
  return 16;  # Header height in points
}

#-----------------------------------------------------------------------

sub generate_footer {
  my $self  = shift;
  my $style = $self->makeover('footer');
  $self->{textobj}->{$style}->paragraph(
    'Page '.$self->{page_number},
    -x => $self->{page_width}-$self->{right_margin}-$self->{textobj}->{$style}->advancewidth('Page '.$self->{page_number}),
    -y => $self->{bottom_margin},
    -w => $self->{textobj}->{$style}->advancewidth($self->{title}),
    -h => 12
    );
  $self->{gfx} = $self->{page}->gfx unless (exists $self->{gfx});
  $self->{gfx}->move($self->{left_margin},$self->{bottom_margin}+10);
  $self->{gfx}->line($self->{page_width}-$self->{right_margin},$self->{bottom_margin}+10);
  $self->{gfx}->stroke;
  return 16;  # Footer height in points
}

#-----------------------------------------------------------------------

sub DESTROY {
  my $self = shift;
  print $self->{pdf}->stringify;
  $self->{pdf}->end;
}

#-----------------------------------------------------------------------

sub line_number_chars {
  my $self                      = shift;
  my $line_number_chars         = shift;
  $self->{line_number_chars}    = $line_number_chars;
  $self->{line_number_width}    = ($self->{line_numbers}) ? $self->{textobj}->{default}->advancewidth('X' x ($line_number_chars + 2)) : 0;
  $self->{line_number_template} = '%'.$line_number_chars.'d: %s';
}

#-----------------------------------------------------------------------

sub _print_text_with_style {                              # Classy... :-)
  my $self  = shift;
  my $text  = shift;
  my $style = $self->makeover(shift);
  
  # PDF::API2 compresses repeated space characters into a single space...
  # so to print something like '1 2  3   4' correctly we need to manually
  # process the spaces ourselves by moving the x_position cursor.
  while ($text =~ /(\s+|\S+)/g) {
    my $word = $1;
    if ($word =~ /\s/) {
      $self->{x_position} += ($self->{nspace} * length($word));
      if ($self->{x_position} > $self->{page_width} - $self->{right_margin}) {
        $self->newline;
        $self->{x_position} = $self->{left_margin} + $self->{line_number_width};
      }
    } else {
      my $width = $self->{textobj}->{$style}->advancewidth($word);
      #
      # bug: this cannot handle a single word which is longer than a complete line
      #
      # while (split words) {
      #   print word
      # }
      # 
      # sub print {
      #   if (word longer than space) {
      #     if (word linger than line) {
      #       print while (split word)
      #       exit
      #     }
      #     newline
      #   }
      # }
      #
      if ($self->{x_position} + $width > $self->{page_width} - $self->{right_margin}) {
        $self->newline;
        $self->{x_position} = $self->{left_margin} + $self->{line_number_width};
      }
      my ($w,$y,$t) = $self->{textobj}->{$style}->paragraph(
        $word,
        -x => $self->{x_position}, 
        -y => $self->{y_position}, 
        -w => $self->{page_width}  - $self->{x_position}, 
        -h => $self->{page_height} - $self->{y_position} 
        );
      $self->{x_position} += $w;
      if ($self->{x_position} > $self->{page_width} - $self->{right_margin}) {
        $self->newline;
        $self->{x_position} = $self->{left_margin} + $self->{line_number_width};
      }
    }
  }    
}

#-----------------------------------------------------------------------

sub print_text_with_style {
  my $self  = shift;
  my $text  = shift;
  my $style = $self->makeover(shift);

  while ($text =~ /(\s+|\S+)/g) {
    my $word = $1;
    $self->print_word($word);
  }
}

#-----------------------------------------------------------------------

sub print_word {
  my $self = shift;
  my $word = shift;

  # PDF::API2 compresses repeated space characters into a single space...
  # so to print something like '1 2  3   4' correctly we need to manually
  # process the spaces ourselves by moving the x_position cursor.
  if ($word =~ /\s/) {
    # 
    # Need to check here if the whitespace will fit on current line
    #
    $self->{x_position} += ($self->{nspace} * length($word));
    if ($self->{x_position} > $self->{page_width} - $self->{right_margin}) {
      $self->newline;
      $self->{x_position} = $self->{left_margin} + $self->{line_number_width};
    }
  } else {
    my $width = $self->{textobj}->{$self->{current_style}}->advancewidth($word);
    if ($self->{x_position} + $width > $self->{page_width} - $self->{right_margin}) {
      # If the word will not fit on one line, split it up and recurse the 'print_word' sub
      if ($width > ($self->{page_width} - $self->{left_margin} - $self->{right_margin})) {
        my $fit = int(($self->{page_width} - $self->{x_position} - $self->{right_margin}) / $self->{nspace});
        my @words = (substr($word,0,$fit),substr($word,$fit));
        $self->print_word($_) foreach @words; 
        return;
      }
      $self->newline;
      $self->{x_position} = $self->{left_margin} + $self->{line_number_width};
    }
    my ($w,$y,$t) = $self->{textobj}->{$self->{current_style}}->paragraph(
      $word,
      -x => $self->{x_position}, 
      -y => $self->{y_position}, 
      -w => $self->{page_width}  - $self->{x_position}, 
      -h => $self->{page_height} - $self->{y_position} 
      );
    $self->{x_position} += $w;
    if ($self->{x_position} > $self->{page_width} - $self->{right_margin}) {
      $self->newline;
      $self->{x_position} = $self->{left_margin} + $self->{line_number_width};
    }
  }

}

#-----------------------------------------------------------------------

sub makeover {                            # Makes an object more stylish
  my $self   = shift;
  my $style  = shift || 'default';
 
  $style = (exists $self->{stylemap}->{$style}) ? $self->{stylemap}->{$style} : 'default';
  unless (exists $self->{textobj}->{$style}) {

    BEFORE: {
      $self->{textobj}->{$style} = $self->{page}->text;
    }
  
    AFTER: {
      if (exists $self->{stylist}->{$style}) {
        my $font = ($self->{stylist}->{$style}->{font} || $self->{font_face}).((exists $self->{stylist}->{$style}->{type}) ? '-'.$self->{stylist}->{$style}->{type} : '');
        my $size = (exists $self->{stylist}->{$style}->{size}) ? $self->{stylist}->{$style}->{size} : $self->{font_size};
        unless (exists $self->{fontcache}->{$font}) {
          $self->{fontcache}->{$font} = $self->{pdf}->corefont($font,1);
        }
        $self->{textobj}->{$style}->font($self->{fontcache}->{$font},$size);
        $self->{textobj}->{$style}->fillcolor($self->{stylist}->{$style}->{color} || '#000000');
        $self->{textobj}->{$style}->lead(-($size + 2));
      } else {
        # Default style
        my $font = $self->{font_face};
        unless (exists $self->{fontcache}->{$font}) {
          $self->{fontcache}->{$font} = $self->{pdf}->corefont($font,1);
        }
        $self->{textobj}->{$style}->font($self->{fontcache}->{$font},$self->{font_size});
        $self->{textobj}->{$style}->fillcolor('#000000');
        $self->{textobj}->{$style}->lead(-$self->{line_spacing});
      }
    }
    
  }
  
  $self->{current_style} = $style;
  $self->{nspace}        = $self->{textobj}->{$style}->advancewidth('n n') - (2 * $self->{textobj}->{$style}->advancewidth('n'));
  return $style;
}

#-----------------------------------------------------------------------
