#  Quick and dirty facsimile of Apache mod_index
#
<start_html 
    title="File Index" 
    include_style="@{qw(index.css index_highlight.css)}"
    style="@{qw(
        https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.9.0/build/styles/atom-one-dark.min.css
        https://cdn.jsdelivr.net/npm/@picocss/pico@2/css/pico.classless.min.css
    )}" 
    meta="%{viewport=>'width=device-width, initial-scale=1.0'}"
    script="@{qw(
        https://cdn.jsdelivr.net/npm/htmx.org@1.9.5
        https://cdn.jsdelivr.net/npm/alpinejs@3/dist/cdn.min.js#defer
        https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.11.1/build/highlight.min.js
    )}"
    include_script="index_highlight.js" 
>
<perl handler="index">
<header>
  <h1>Index of <span id="current-path">${path_dn}</span></h1>
  <hr>
</header>

<main>
  <table role="grid">
    <thead>
      <tr>
        <th><a href="${sort_name_href}">Filename</a></th>
        <th><a href="${sort_mtime_href}">Last Modified</a></th>
        <th><a href="${sort_size_href}">Size</a></th>
        <th style="text-align: right">View</th>
      </tr>
    </thead>
    <tbody>
      <block name="index">
      <tr>
        <td><a href="${href}">${filename}</a></td>
        <td>${date}</td>
        <td>${size}</td>
        <td style="text-align: right"  x-data="{ isOpen: false }">
            <a href="#" 
              @click.prevent="toggleSourceRow($el, $data)"
              data-filename="${filename}"
              x-text="isOpen ? 'Hide Source' : 'View Source'"
            >
            View Source
            <!-- <img src="https://unpkg.com/lucide-static/icons/code.svg" alt="View Source icon" width="18" height="18"> -->
            </a>

        </td>
      </tr>
      </block>
    </tbody>
  </table>
</main>

<! -- HTMX section start -->

<htmx display="+{source}" handler="source">
<tr class="source-row"><td colspan="4">

<script id="srce_html" data-language="html" type="text/plain">
${srce_html}
</script>
<script id="srce_lang" data-language="${language}" type="text/plain">
${srce_lang}
</script>

<pre>
<code class="hljs" data-mode="${mode}" id="srce_highlight"></code>
</pre>

</td></tr>
</htmx>

<! -- HTMX section end -->

<footer>
  <hr>
  <small>Generated on ${timestamp} by WebDyne Indexer in ${sec} sec.</small>
</footer>
</perl>


__PERL__

use strict;
use File::stat;
use File::Spec::Unix;
use File::Basename qw(dirname);
use POSIX qw(strftime);
use WebDyne::Util;
use Cwd qw(realpath);
use IO::File;

sub source {


    #  Get source file and display
    #
    my $self=shift();
    my $cgi_or=$self->CGI() ||
        return err('unable to get CGI object');
    
    
    #  Massage to get full file name path
    #
    my $srce_fn=$_{'source'} ||
        return err('no filename to display');
    my $full_dn=$self->full_dn() ||
        return err('no full_dn');
    my $path_fn=File::Spec->catfile($full_dn, $srce_fn);
    $path_fn=$self->sanitize_path($cgi_or, $path_fn) ||
        return err('unable to get path');
    

    #  Vars we need
    #
    my $srce;
    my @srce_html;
    my @srce_lang;
    my $perl;
    
    
    #  Open and run through file line by line, splitting out perl and HTML bits
    #
    my $path_fh=IO::File->new($path_fn, O_RDONLY) ||
        return err("unable to open file: $srce_fn, $!");
    
    
    #  If not .psp file then flick perl flag so goes into the lang bucket
    #
    unless ($srce_fn=~/\.psp$/) { $perl++ }
    
    
    #  Now iterate over file
    #
    my ($binary, $language);  
    while (my $line=<$path_fh>) {
        
        if ($line =~ /[\x00-\x08\x0B\x0C\x0E-\x1F\x80-\xFF]/) {
            push @srce_lang, 'Binary file - not displaying';
            $language='text';
            $binary++;
            last;
        }

        if ($line=~/^__PERL__/) {
            $perl++;
        }
        if ($perl) {
            push @srce_lang, $line
        }
        else {
            push @srce_html, $line
        }
    }
    
    
    #  Get mapping hash
    #
    my $ext_to_lang_hr=&ext_to_lang();
    my ($ext)=($srce_fn=~/\.(.*?)$/);
    $language ||= $ext_to_lang_hr->{$ext};
    $language ||= $ext ? 'automatic' : 'text';
    #$language= $ext_to_lang_hr->{$ext};
    
    
    #  Concatenate together and escape </script> tag in HTML
    #
    my $srce_html=join(undef, @srce_html);
    my $srce_lang=join(undef, @srce_lang);
    $srce_html=~s/<\/script>/<\\\/script>/gm;
    $srce_lang=~s/<\/script>/<\\\/script>/gm;
    return $self->render(
        srce_html   => $srce_html, 
        srce_lang   => $srce_lang, 
        language    => $language, 
        mode        => $srce_html ? 'combined' : 'single'
    );
    
}


sub full_dn {


    #  Get the full dn of the URI location we are currently at
    #
    my $self=shift();
    my $cgi_or=$self->CGI() ||
         return err('unable to get CGI object');
    my $r=$self->r() || 
        return err('unable to get request object');


    #  Where do we want to be ? Use File::Spec::Unix rather than URI, 
    #  it's not happy when we don't have a base component.
    #
    my $path_dn=$self->sanitize_path($cgi_or, ($r->path_info() || $ENV{'PATH_INFO'})) ||
        return err('unable to get path');
        
    
    #  Now get real dn and check not higher than document root
    #    
    my $root_dn=$r->document_root();
    my $full_dn;
    for (1..2) { # Max 2 loops to check and sanitise path
        $full_dn=File::Spec->catdir($root_dn, split(m{/+}, $path_dn));
        $full_dn=realpath($full_dn);
        if (!defined($full_dn) || (index($full_dn,$root_dn) !=0)) {
            # Bad person, trying to escape
            $full_dn=$root_dn;
            next;
        }
        elsif(-f $full_dn) {
            #  Clicked on a file URL which isn't recognised. Go back to index
            #
            $path_dn=dirname($path_dn);
            next;
        }
        last;
    }
    
    
    #  Reset if things go bad
    #
    unless ($full_dn && (-d $full_dn)) {
        $full_dn=$root_dn;
    }
    
    
    #  Done;
    #
    return $full_dn;
    
}
    

sub index {


    #  Index current directory
    #
    my $self=shift();
    
    
    #  Get request object
    #
    my $r=$self->r() || 
        return err('unable to get request object');
    my $cgi_or=$self->CGI() ||
         return err('unable to get CGI object');


    #  Where do we want to be ? Use File::Spec::Unix rather than URI, 
    #  it's not happy when we don't have a base component.
    #
    my $path_dn=$self->sanitize_path($cgi_or, ($r->path_info() || $ENV{'PATH_INFO'})) ||
        return err('unable to get path');
        
    
    #  Now get real dn and check not higher than document root
    #    
    my $root_dn=$r->document_root();
    my $full_dn=$self->full_dn() ||
        return err('no full_dn');

    
    #  Reset if things go bad
    #
    unless ($full_dn && (-d $full_dn)) {
        $full_dn=$root_dn;
        $path_dn='/';
    }
    
    
    #  And iterate over it to get file names and stat info
    #
    opendir(my $dh, $full_dn) ||
        return err("unable to open directory $full_dn, $!");
    my @fn;
    my %fn;
    while (my $fn=readdir($dh)) {
        # Skip any special files, [.],[..] etc.
        next if ($fn=~/^\./);
        $fn.='/' if (-d File::Spec->catfile($full_dn, $fn));
        my $fn_or=stat(File::Spec->catfile($full_dn,$fn)) || next;
        #debug("fn: $fn");
        push @fn, $fn;
        map { $fn{$fn}{$_}=$fn_or->$_ } qw(size mtime);
        $fn{$fn}{'name'}=$fn;
    }
    
    
    #  Create Parent Directory link unless we're at top level
    #
    unless ($path_dn eq '/') {
        my $parent_dn=dirname($path_dn);
        $self->render_block('index',
            filename   => 'Parent Directory',
            href        => $parent_dn,
            date       => '',
            size       => ''
            
        );
    }
    

    #  Sort by user selected sort field, or by name if no sort selected
    #
    my $fn_ar;
    my $sort_fg;
    foreach my $sort_type (qw(name size mtime)) {
        if ($_{"sort_${sort_type}"}) {
            $fn_ar=$self->sort_file(\@fn, \%fn, $sort_type, $_{"sort_${sort_type}_order"});
            $sort_fg++;
            last; 
        }
    }
    unless ($sort_fg) {
        #  Default sort is by name
        $fn_ar=$self->sort_file(\@fn, \%fn, 'name', $_{'sort_name_order'});
    }
        
    
    #  Now go over every file in sort order and format info, build output
    # 
    foreach my $fn (@{$fn_ar}) {
    
        
        #  Mtime and Size in human readable format
        #
        #my $mtime=strftime('%X', localtime($fn{$fn}{'mtime'}));
        my $mtime=strftime('%Y-%m-%d %H:%M:%S', localtime($fn{$fn}{'mtime'}));
        my $size=$self->human_size($fn{$fn}{'size'});
        
        
        #  Build file href differently if dir vs file
        #
        my $href;
        if ($fn=~m{/$}) {
            #  Dir
            $href=File::Spec->catdir($path_dn, split(m{/+}, $fn));
        }
        else {
            #  Normal file
            $href=File::Spec->catfile($path_dn, $fn);
        }
        
        
        #  Now render info about file into page
        #
        $self->render_block('index',
            filename    => $fn,
            href        => $href || $fn,
            date        => $mtime,
            size        => $size
        );
        
    }
    
    
    #  Construct the sort hrefs
    #
    use URI;
    my %query=$cgi_or->Vars();
    #  Delete any existing sort params when creating href lower/
    map {delete @query{("sort_${_}", "sort_${_}_order")} } qw(name size mtime);
    my %sort_href;
    foreach my $sort_type (qw(name size mtime)) {
        my $uri_or=URI->new();
        $uri_or->query_form(%{{%query, "sort_${sort_type}"=>1, "sort_${sort_type}_order"=>$_{"sort_${sort_type}_order"}?0:1 }});
        $sort_href{"sort_${sort_type}_href"}=$uri_or;
    }
    

    #  And fill out page
    #
    my %param=(
        path_dn         => $path_dn,
        timestamp       => strftime('%X', localtime()),
        sec             => sprintf('%.3f', $self->render_time()),
        %sort_href
    );
    
    
    #  Done
    #
    return $self->render(%param);
    
}


sub sort_file {

    #  Sort by name, size, mtime but keep directories at top
    #
    my ($self, $fn_ar, $fn_hr, $field, $desc)=@_;
    my @fn=sort {

        # Keep folders at top
        #
        my $dn_a = ($fn_hr->{$a}{'name'} =~ m{/$}) ? 1 : 0;
        my $dn_b = ($fn_hr->{$b}{'name'} =~ m{/$}) ? 1 : 0;
        if ($dn_a && !$dn_b) { return -1 }
        if ($dn_b && !$dn_a) { return 1 }
        
        my $cmp;
        if ($field eq 'name') {
            $cmp=lc($fn_hr->{$a}{$field}) cmp lc($fn_hr->{$b}{$field})
        }
        else {
            $cmp=$fn_hr->{$a}{$field} <=> $fn_hr->{$b}{$field};
            if ($cmp == 0) {
                #  Secondary sort by name if size or mtime equal
                $cmp=lc($fn_hr->{$a}{'name'}) cmp lc($fn_hr->{$b}{'name'})
            }
        }
        $desc ? -$cmp : $cmp
    } @{$fn_ar};
    return \@fn;
    
}


sub human_size {

    #  Return human readable bytes size suffixes
    #
    my ($self, $size)=@_;
    #return '0' unless $size && $size > 0;

    my @units = (undef, qw(K M G T P));
    my $i = 0;

    while (($size >= 1024) && ($i < (@units - 1))) {
        $size /= 1024;
        $i++;
    }
    return $units[$i] ? sprintf("%.1f%s", $size, $units[$i]) : $size;
}


sub sanitize_path {

    my ($self, $cgi_or, $dn)=@_;
    $dn=$cgi_or->url_decode($dn);
    $dn =~ s/[\x00-\x1F\x7F]//g;
    $dn =~ s{//+}{/}g;
    $dn =~ s{^/*}{/};
    $dn =~ s{/$}{} unless $dn eq '/';
    $dn = File::Spec->canonpath($dn);
    $dn =~ s{[^A-Za-z0-9_\-.\s/]}{}g;
    $dn ='/' unless $dn =~ m{^/};
    return $dn;
    
}


sub ext_to_lang {

    my %ext_to_lang = (
    
        # Perl
        'pl'      => 'perl',
        'pm'      => 'perl',
        't'       => 'perl',
        'psp'     => 'perl',
        'PL'      => 'perl',

        # Python
        'py'      => 'python',

        # Ruby
        'rb'      => 'ruby',

        # JavaScript & TypeScript
        'js'      => 'javascript',
        'jsx'     => 'javascript',
        'ts'      => 'typescript',
        'tsx'     => 'typescript',

        # Web
        'html'    => 'xml',  # HTML is treated as XML in highlight.js
        'htm'     => 'xml',
        'xml'     => 'xml',
        'css'     => 'css',
        'scss'    => 'scss',

        # JSON / YAML / Config
        'json'    => 'json',
        'yaml'    => 'yaml',
        'yml'     => 'yaml',
        'ini'     => 'ini',
        'toml'    => 'toml',

        # Bash / Shell
        'sh'      => 'bash',
        'bash'    => 'bash',
        'zsh'     => 'bash',

        # C / C++
        'c'       => 'c',
        'h'       => 'cpp',  # highlight.js prefers 'cpp'
        'cpp'     => 'cpp',
        'cc'      => 'cpp',
        'cxx'     => 'cpp',
        'hpp'     => 'cpp',
        'hxx'     => 'cpp',

        # Java / JVM
        'java'    => 'java',
        'kt'      => 'kotlin',
        'kts'     => 'kotlin',
        'scala'   => 'scala',
        'groovy'  => 'groovy',

        # C#
        'cs'      => 'csharp',

        # PHP
        'php'     => 'php',

        # Go
        'go'      => 'go',

        # Rust
        'rs'      => 'rust',

        # Swift / Apple
        'swift'   => 'swift',
        'm'       => 'objectivec',
        'mm'      => 'objectivec',

        # SQL
        'sql'     => 'sql',

        # R
        'r'       => 'r',

        # Lua
        'lua'     => 'lua',

        # Markdown / Text
        'md'      => 'markdown',
        'markdown'=> 'markdown',
        'txt'     => 'plaintext',

        # Makefiles & build
        'makefile'=> 'makefile',
        'mk'      => 'makefile',
        'cmake'   => 'cmake',

        # Docker / CI
        'dockerfile' => 'dockerfile',
        'env'        => 'bash',

        # LaTeX
        'tex'     => 'latex',

        # Assembly
        'asm'     => 'x86asm',
        's'       => 'x86asm',

        # Powershell
        'ps1'     => 'powershell'
        
    );
    
    return \%ext_to_lang
    
}

     