#! /usr/bin/perl

# a2pdf.pl - converts ASCII text to PDF format, with
#            optional Perl syntax highlighting
#
# Written by Jon Allen <jj@jonallen.info>


#--Load required modules and activate Perl's safety features------------

use strict;
use warnings;
use File::Spec::Functions;
use FindBin;
use Getopt::Long;
use Pod::Usage;
use POSIX qw(locale_h);
use Text::ParseWords;

our $VERSION = '1.10';


#--Tell the OS we are going to create binary data-----------------------

setlocale(LC_ALL,'C');
binmode *STDOUT;


#--Define available options---------------------------------------------

my @optionspec = qw/
  font_size|font-size=i
  font_face|font-face=s
  line_spacing|line-spacing=i
  page_size|page-size=s
  page_orientation|page-orientation=s
  page_height|page-height=i
  page_width|page-width=i
  margins=i
  left_margin|left-margin=i
  right_margin|right-margin=i
  top_margin|top-margin=i
  bottom_margin|bottom-margin=i
  header!
  footer|page_numbers|page-numbers!
  line_numbers|line-numbers!
  perl_syntax|perl-syntax|perl!
  title=s
  icon=s
  icon_scale|icon-scale=s
  timestamp
  noformfeed
  settings=s
  output_file|o|output-file=s
  /;
  

#--Look for a default settings file------------------------------------

my %default_options;
CONFIGSEARCH: {
  foreach my $configfile ( 'a2pdf.conf',
                           catfile($ENV{HOME},'a2pdf.conf'),
                           catfile($FindBin::Bin,'a2pdf.conf'),
                           catfile($FindBin::RealBin,'a2pdf.conf') ) {
    if (open CONFIGFILE,'<',$configfile) {
      local @ARGV = shellwords(map {s/^\s*(?!--)/--/;$_} (<CONFIGFILE>));
      GetOptions( \%default_options, @optionspec );
      last CONFIGSEARCH;
    }
  }
}


  
#--Parse command line options------------------------------------------
  
my (%commandline_options,%saved_options);
GetOptions(\%commandline_options,
  @optionspec,
  'help'       => sub { pod2usage(-verbose => 1) },
  'doc'        => sub { pod2usage(-verbose => 2) },
  'version'    => sub { print "This is a2pdf, version $VERSION\n"; exit; },
  'settings=s' => sub {
    if (open CONFIGFILE,'<',$_[1]) {
      local @ARGV = shellwords(map {s/^\s*(?!--)/--/;$_} (<CONFIGFILE>));
      GetOptions( \%saved_options, @optionspec );
    } else {
      warn("[Warning] Cannot load settings file $_[1]: $!\n");
    }
  },
 ) or die("[Error] Could not parse options\n");

my %options = (%saved_options,%commandline_options);

$options{title}  = (@ARGV) ? $ARGV[0] : 'STDIN' unless (exists $options{title});
$options{title} .= (' - ' . ((@ARGV) ? scalar localtime($^T - (-M $ARGV[0])*24*60*60) : scalar localtime)) if (exists $options{timestamp});


#--Set output location--------------------------------------------------

if (my $outfile = $options{output_file}) {
  open STDOUT,'>',$outfile or die("Cannot open output file $outfile: $!\n")
}


#--Create PDF object----------------------------------------------------

my @text = (<>);
my $pdf  = a2pdf->new(%options);
$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 List::Util qw/max min/;
use PDF::API2;

use constant TRUE  => 1;
use constant FALSE => 0;

BEGIN {
}



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

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

  my %user_options    = @_;
  my %default_options = (
    header        => TRUE,       # Include header on all pages
    footer        => TRUE,       # Include footer on all pages
    line_numbers  => TRUE,       # Print line numbers
    page_width    => 595,        # A4
    page_height   => 842,        # A4
    left_margin   => $user_options{margins} || 48,  # 0.75"
    right_margin  => $user_options{margins} || 48,  # 0.75"
    top_margin    => $user_options{margins} || 60,  # 
    bottom_margin => $user_options{margins} || 60,  # 
    font_face     => 'Courier',  # Monospaged text
    font_size     => 9,          # Text size = 9 points
    perl_syntax   => TRUE,       # Perform Perl syntax highlighting
    icon_scale    => 0.25,       # Icon scaling (%age)
  );
  
  my $self = { %default_options, %user_options }; 
  bless $self,$class;
  
  # Define style mapping
  # This will relate Perl::Tidy's token types to a printing style
  $self->{stylemap} = {
    'header'     => 'helvetica_bold_10',
    'footer'     => 'helvetica_bold_10',
    '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},
    'helvetica_bold_10'  => {font=>'Helvetica',size=>10,type=>'Bold'},
    '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
  PAGE_SIZE: {
    if ($self->{page_size}) {
      eval "use Paper::Specs units=>'pt';";
      if ($@) {
        warn("[Warning] Cannot use '--page-size' option, module Paper::Specs not installed");
      } else {
        # Bugfix for Paper::Specs 0.05      
        no warnings qw/once/;
        $Paper::Specs::units{mm} = 25.4;
        use warnings qw/all/;
        
        if (my $form = Paper::Specs->find(code=>$self->{page_size}, brand=>'standard')) {
          $self->{page_width}  = int($form->sheet_width + 0.5);
          $self->{page_height} = int($form->sheet_height + 0.5);
        } else {
          warn("[Warning] Unknown page size '".$self->{page_size}."'");
        } 
      }
    }
  }
  
  PAGE_ORIENTATION: {
    if ($self->{page_orientation}) {
      if (lc $self->{page_orientation} eq 'landscape') {
        ($self->{page_width},$self->{page_height}) = (
          max($self->{page_width},$self->{page_height}),
          min($self->{page_width},$self->{page_height}) 
        );
        last PAGE_ORIENTATION;
      }
      if (lc $self->{page_orientation} eq 'portrait') {
        ($self->{page_width},$self->{page_height}) = (
          min($self->{page_width},$self->{page_height}),
          max($self->{page_width},$self->{page_height}) 
        ); 
        last PAGE_ORIENTATION; 
      }
      warn("[Warning] Unknown page orientation '".$self->{page_orientation}."', must be 'portrait' or 'landscape'");
    }  
  }

  $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;
  if ($self->{icon}) {
    # Load required modules to handle images
    eval "use File::Type;use Image::Size";
    unless ($@) {
      if (-e $self->{icon}) {
        $self->{icon_img} = $self->{pdf}->image($self->{icon});
        ($self->{icon_width},$self->{icon_height}) = imgsize($self->{icon});      
      } else {
        warn("[Warning] Cannot open icon file: ".$self->{icon}."\n");
      }
    } else {
      warn("[Warning] The modules File::Type and Image::Size are required to use icons\n")
    }
  }
  $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->formfeed;
  } 
}


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

sub formfeed {
  my $self = shift;
  $self->{x_position} = $self->{left_margin};
  my $current_style = $self->{current_style};
  $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->{mspace}      = $self->{textobj}->{$self->{current_style}}->advancewidth('m');
  $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});
  $self->makeover($current_style);
}


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

sub generate_header {
  my $self           = shift;
  my $style          = $self->makeover('header');
  my $header_padding = 2;
  my $header_spacing = 3;
  my $header_height  = $self->{stylist}->{$style}->{size} + $header_spacing + $header_padding;
  $self->{gfx} = $self->{page}->gfx unless (exists $self->{gfx});
  
  # Draw header icon
  if ($self->{icon_img}) {
    my $icon_height_in_points = $self->{icon_height} * $self->{icon_scale};
    if ($icon_height_in_points > $self->{stylist}->{$style}->{size}) {
      $header_height += ($icon_height_in_points - $self->{stylist}->{$style}->{size});
    }
    my $ypos = $self->{page_height} - $self->{top_margin} - $icon_height_in_points;
    $self->{gfx}->image($self->{icon_img},$self->{left_margin},$ypos,$self->{icon_scale});
  }

  # Add page title  
  $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} - $header_height + $header_spacing + $header_padding,
    -w => $self->{textobj}->{$style}->advancewidth($self->{title}),
    -h => $header_height
    );

  # Draw horizontal line
  $self->{gfx}->move($self->{left_margin},$self->{page_height}-$self->{top_margin}-$header_height + $header_padding);
  $self->{gfx}->line($self->{page_width}-$self->{right_margin},$self->{page_height}-$self->{top_margin}-$header_height + $header_padding);
  $self->{gfx}->stroke;
  
  return $header_height;
}


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

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('Page '.$self->{page_number}),
    -h => 14
    );
  $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 18;  # 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 {
  my $self  = shift;
  my $text  = shift;
  my $style = $self->makeover(shift);

  while ($text =~ /(\f|[^\f]+)/g) {
    my $block = $1;
    if ($block =~ /\f/ && !exists $self->{noformfeed}) {
      $self->formfeed;
      $self->{x_position} = $self->{left_margin} + $self->{line_number_width};
    } else {
      while ($block =~ /(\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;
}


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

__END__

=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 --title

Sets the title to be included in the page header. If unspecified, the
title will default to the name of the file which is being converted,
or to 'STDIN' if B<a2pdf> is processing from standard input.

=item --timestamp

Boolean option - if set, the timestamp of the file to be converted will
be included in the page header. This option is turned off by default.

=item --icon

Path to an image file which will be included as part of the header in 
the top left of each page.

Image files may be in any format supported by L<PDF::API2>.

=item --icon-scale

Scaling value for icon images, default is 0.25.

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

Prints a header consististing of the page title, and optionally
the timestamp and an image icon at the top of each page.
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 --page-size

Sets the page size to one of the 'standard' paper formats, e.g. "A4" 
or "Letter". Requires the module L<Paper::Specs> to be installed.

=item --page-orientation

Sets the page orientation, acceptable values are 'portrait' or 
'landscape'. Overrides the "--page-height" and "--page-width" options, 
i.e. the option set "--page-height=300 --page-width=100 
--page-orientation=landscape" will set the page height to 100 points 
and the width to 300 points to force landscape format.

=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
the left and right margins is 48 points, and for the top and bottom margins is
60 points.

=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.

=item --noformfeed

By default, any formfeed characters in the input stream will be processed and
will act as expected, i.e. a new page will be started in the output PDF file.
This can be disabled with the C<--noformfeed> option which will cause all
formfeed characters to be ignored.

=item --settings

Location of a settings file (described below).

=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.

=head2 Config / settings files

Options to B<a2pdf> may be stored in settings files. These have the same 
format as the command line options with the exception that the '--' 
chharacters preceding the option name are optional.

A single option may be contained on each line of the settings file, e.g.

 --timestamp
 icon=/usr/local/images/logo.png

At startup, B<a2pdf> looks for a default settings file named L<a2pdf.conf> 
in the current directory, the user's home directory, and the directory 
containing the B<a2pdf> script.

Settings will cascade as follows;

 Default 'a2pdf.conf' settings file              -->
 Settings file specified by '--settings' option  -->
 Options given on the command line

i.e. options on the command line will always take precedence. 

=head1 DEPENDENCIES

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

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

To include images in the page header, the modules L<File::Type> and
L<Image::Size> must be installed.

To enable the "--page-size" option, the L<Paper::Specs> module must be installed.

=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. 

=back

=head1 SEE ALSO

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

pod2pdf - L<http://perl.jonallen.info/projects/pod2pdf>

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

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

=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
