File Coverage

blib/lib/MojoMojo/Formatter/File.pm

Criterion	Covered	Total	%
statement	85	86	98.8
branch	24	30	80.0
condition	5	6	83.3
subroutine	14	14	100.0
pod	6	6	100.0
total	134	142	94.3

package MojoMojo::Formatter::File;

use strict;
use warnings;
use base qw/MojoMojo::Formatter/;
use File::Slurp;
use Encode;
use MojoMojo::Formatter::Dir;
use File::Basename;
use Module::Pluggable (
    search_path => ['MojoMojo::Formatter::File'],
    require => 1,
);
my $debug=0;

=head1 NAME

MojoMojo::Formatter::File - format file as XHTML

=head1 DESCRIPTION

This formatter will format the file argument as XHTML.

Usage: {{file TYPE filename}}


       {{file Text uploads/Files/test.txt}}


TYPE is a plugin present in Formatter/File/ directory.

Currently there are only three: Pod, DocBook and Text

The plugin TYPE format only the file which the extension match with 'can_format' method. Respectively pod, xml and txt for existing plugins.

For security reasons the path of file must be include in 'whitelisting' directory. You can use path_to(DIR) to describe directory in mojomojo.conf:


Just an example to view the test pod file t/var/files/test.pod :

Add this to mojomojo.conf :

<Formatter::Dir>
    prefix_url /myfiles
    whitelisting __path_to(t/var/files)__
</Formatter::Dir>

To see the pod content formatted in xhtml, write in the text area:

{{file Pod path_to(t/var/files)test.pod}}


To show recursively all files of directory see script/util/dir2mojomojo.pl script. To test it:

# start mojomojo

./script/mojomojo_server.pl

# run dir2mojomojo script

./script/util/dir2mojomojo.pl --dir=~/dev/mojomojo/t/var/files/ --url=/myfiles


Connect to http://server:3000/myfiles/


=head1 METHODS

=over 4

=item format_content_order

Format order can be 1-99. The File formatter runs on 92.

=cut

sub format_content_order { 92 }

=item format_content

Calls the formatter. Takes a ref to the content as well as the
context object.

=cut


sub format_content {
  my ( $self, $content, $c ) = @_;


  # TODO : Add cache if file is not modified


  my @lines = split /\n/, $$content;

  $$content = "";
  my $is_image = 0;
  foreach my $line (@lines) {

    if ( $line =~ m|\{\{\s*file\s*(\w+)\s*(.*)}}.*| ) {
      my $plugin=$1; # DocBook, Pod, ...
      my $file=$2;   # File, Attachment

      $is_image = 1 if ( $plugin eq 'Image' );

      # use path_to(dir)/filename ?
      my $path_to = $c->path_to();
      $file =~ s/path_to\([\s|\/]*(\S*)[\s|\/]*\)\s*(\S*)\s*/${path_to}\/$1\/$2/;

      my $error;
      if ( $error = checkplugin($plugin, $file)){
        $$content .= $error;
      }
      if ( ! $error && ( $error = $self->checkfile($file, $c))){
        $$content .= $error;
      }

      if ( ! $error ){
	# format with plugin
        $$content .= $self->format($plugin,$file);
      }
    }
    else{
      # Image have not more content
      if ( ! $is_image ){
        $$content .= $line  . "\n";
      }
    }
  }
  return $content;
}


=item plugin

Return the plugin to use with file attachment

=cut

sub plugin {
  my $self     = shift;
  my $filename = shift;

  my ($name,$extension) = $filename =~ /(.*)\.(.*)/;

  foreach my $plugin ( plugins() ) {
    if ( $plugin->can('can_format') && $plugin->can_format($extension)){
      my $pluginname = $plugin;
      $pluginname =~ s/.*:://;

      return $pluginname;
    }
  }
}


=item format

Return the content formatted

=cut

sub format {
  my $self       = shift;
  my $pluginname = shift;
  my $file       = shift;

  my $error;
  if ( $error = checkplugin($pluginname)){
    return $error;
  }

  my $text = read_file( $file );
  utf8::decode($text);
  $text = encode('utf-8', $text);
  $text = Encode::decode('utf-8', $text);

  my $plugin = __PACKAGE__ . "::$pluginname";
  return $plugin->to_xhtml($text,$file) . "\n";
}


=item checkplugin

Return 0 if plugin exist

=cut
sub checkplugin{
  my $pluginname = shift;
  my $file       = shift;

  my $plugin = __PACKAGE__ . "::$pluginname";

  return 0 if $plugin->can('can_format');

  return "Can't find plugin for $file !";
}

=item checkfile

Directory must be include in whitelisting

=cut
sub checkfile{
  my ($self, $file, $c) = @_;

  return "Append a file after 'file'"
    if ( ! $file );

  return "You can't use '..' in the name of file"
    if ( $file =~ /\.\./ );

  my $dir = dirname($file);

  my $confwl = $c->config->{'Formatter::Dir'}{whitelisting};
  my @whitelist = ref $confwl eq 'ARRAY' ?
                       @$confwl : ( $confwl );
  # Add '/' if not exist at the end of whitelist directories
  my @wl =  map { $_ . '/' }            # Add '/'
                  ( map{ /(\S*[^\/])/ } # Delete '/' if exist
                    @whitelist );


  # Add '/' if not exist at the end of dierctory
  $dir =~ s|^(\S*[^/])$|$1\/|;

  # if $dir is not include in whitelisting
  if ( ! map ( $dir =~ m|^$_| , @wl) ){
    return "Directory '$dir' must be include in whitelisting ! see Formatter::Dir:whitelisting in mojomojo.conf"
  }


  return "'$dir' is not a directory !\n"
    if ( ! -d $dir );

  return "Can not read '$file' !\n"
    if ( ! -r $file );

  return 0;
}

=back

=head1 SEE ALSO

L<MojoMojo>,L<Module::Pluggable::Ordered>

=head1 AUTHORS

Daniel Brosseau <[e-mail]>

=head1 LICENSE

This module is licensed under the same terms as Perl itself.

=cut

1;