File Coverage

blib/lib/MojoMojo/Formatter/Dir.pm

Criterion	Covered	Total	%
statement	88	88	100.0
branch	28	34	82.3
condition	3	3	100.0
subroutine	10	10	100.0
pod	5	5	100.0
total	134	140	95.7

package MojoMojo::Formatter::Dir;

use strict;
use warnings;
use base qw/MojoMojo::Formatter/;
use Path::Class ();
use MojoMojo::Formatter::File::Image;

my $debug=0;

=head1 NAME

MojoMojo::Formatter::Dir - format local directory as XHTML

=head1 DESCRIPTION

This formatter will format the directory argument as XHTML.
Usage:

    {{dir directory exclude=exclude_regex}}


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

<Formatter::Dir>
    prefix_url /myfiles
    whitelisting __path_to(uploads)__
</Formatter::Dir>


=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 directory is not modified

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

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

    if ( $line =~ m|<p>\{\{dir\s*(\S*)\s*(\S*)}}</p>| ) {
      my $dir     = $1;
      my $exclude = $2;

      $exclude =~ s/exclude=//;

      my $path_to = $c->path_to();
      # use path_to(dir) ?
      $dir =~ s/path_to\((\S*)\)/${path_to}\/$1/;
      $dir =~ s/\/$//;

      my $error;
      if ( $error = $self->checkdir($dir, $c)){
        $$content .= $error;
      }

      if ( ! $error ){
        # format with plugin
        $$content .= $self->format($dir, $exclude, $c);
      }
    }
    else{
      $$content .= $line  . "\n";
    }
  }
  return $content;
}



=item format

Return the content formatted

=cut

sub format {
  my $self    = shift;
  my $dir     = shift;
  my $exclude = shift;
  my $c       = shift;

  my $baseuri = $c->base_uri;
  my $path    = $c->stash->{path};

  return $self->to_xhtml($dir, $exclude, $baseuri, $path);
}


=item to_xhtml

Return Directory and files lists in xhtml

=cut

sub to_xhtml{
  my ($self, $dir, $exclude, $baseuri, $path) = @_;

  my $pcdir = Path::Class::dir->new("$dir");

  my @subdirs;
  my @files;
  while (my $file = $pcdir->next) {
    next if ($file =~ m/^$dir\/?\.*$/ );
    next if ( "$exclude" && grep(/$exclude/, $file ));

    if ( -d $file ){
      push @subdirs , $file;
    }
    else{
      push @files, $file;
    }
  }

  #-mxh Sort the array for predictable ordering in formatter_dir.t
  @subdirs = sort @subdirs;
  @files   = sort @files;

  $path =~ s/^\///;
  $path =~ s/\/$//;
  my $url = "${baseuri}/${path}";

  my $ret;
  if ( $subdirs[0] ){
    $ret = '<div id="dirs"><ul>';
    $ret .= "<li><a href=\"$url\">..</a></li>" if ( $url =! "/$path");
    foreach my $d (@subdirs){
      next if ( ! -r $d);
      $d =~ s/$dir\///;

      $ret .= "<li><a href=\"$url/$path/$d\">[$d]</a></li>";
    }
    $ret .= "</ul></div>\n";
  }

  if ( $files[0] ){
    $ret .= '<div id="files"><ul>';
    foreach my $f (@files){
      next if ( ! -r $f);
      $f =~ s/$dir\///;
      $f =~ s/^\///;

      # Use Image controller if it is a image
      $f =~ /.*\.(.*)$/;

      # replace dot with '_' if it's not a image
      $f =~ s/\./_/
        if ( ! MojoMojo::Formatter::File::Image->can_format($1) );

      $ret .= "<li><a href=\"$url/$f\">$f</a></li>";
    }
    $ret .= "</ul></div>\n";
  }
  return $ret;
}


=item checkdir

Directory must be include in whitelisting

=cut
sub checkdir{
  my ($self,$dir,$c) = @_;

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

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

  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 0;
}

=back

=head1 SEE ALSO

L<MojoMojo>

=head1 AUTHORS

Daniel Brosseau <[e-mail]>

=head1 LICENSE

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

=cut

1;