Add proper long path support on Windows

lib/LANraragi/Controller/Api/Archive.pm

@@ -16,6 +16,7 @@ use LANraragi::Utils::Generic  qw(render_api_response is_archive get_bytelength
 use LANraragi::Utils::Database qw(get_archive_json set_isnew);
 use LANraragi::Utils::Logging  qw(get_logger);
 use LANraragi::Utils::Redis    qw(redis_encode);
+use LANraragi::Utils::Path     qw(compat_path);
 
 use LANraragi::Model::Archive;
 use LANraragi::Model::Category;
@@ -111,7 +112,7 @@ sub serve_file {
 
     my $file = $redis->hget( $id, "file" );
     $redis->quit();
-    $self->render_file( filepath => $file );
+    $self->render_file( filepath => compat_path( $file ), filename => basename( $file ) );
 }
 
 # Create a file archive along with any metadata.
@@ -298,7 +299,7 @@ sub delete_archive {
             json => {
                 operation => "delete_archive",
                 id        => $id,
-                filename  => $delStatus,
+                filename  => decode_utf8($delStatus),
                 success   => $delStatus eq "0" ? 0 : 1
             }
         );

lib/LANraragi/Model/Archive.pm

@@ -23,6 +23,7 @@ use LANraragi::Utils::Database
   qw(invalidate_cache set_title set_tags set_summary get_archive_json get_archive_json_multi);
 use LANraragi::Utils::PageCache  qw(fetch put);
 use LANraragi::Utils::Redis      qw(redis_decode redis_encode);
+use LANraragi::Utils::Path       qw(create_path unlink_path);
 
 # get_title(id)
 #   Returns the title for the archive matching the given id.
@@ -318,7 +319,7 @@ sub update_metadata {
 sub delete_archive ($id) {
 
     my $redis    = LANraragi::Model::Config->get_redis;
-    my $filename = $redis->hget( $id, "file" );
+    my $filename = create_path( $redis->hget( $id, "file" ) );
     my $oldtags  = $redis->hget( $id, "tags" );
     $oldtags = redis_decode($oldtags);
 
@@ -351,7 +352,7 @@ sub delete_archive ($id) {
     LANraragi::Utils::Database::update_indexes( $id, $oldtags, "" );
 
     if ( -e $filename ) {
-        my $status = unlink $filename;
+        my $status = unlink_path( $filename );
 
         my $thumbdir  = LANraragi::Model::Config->get_thumbdir;
         my $subfolder = substr( $id, 0, 2 );

lib/LANraragi/Model/Opds.pm

@@ -11,6 +11,8 @@ use Mojo::Util qw(xml_escape);
 use LANraragi::Utils::Generic  qw(get_tag_with_namespace);
 use LANraragi::Utils::Archive  qw(get_filelist);
 use LANraragi::Utils::Database qw(get_archive_json );
+use LANraragi::Utils::Path     qw(create_path);
+
 use LANraragi::Model::Category;
 use LANraragi::Model::Search;
 
@@ -93,7 +95,7 @@ sub get_opds_data {
     my $id    = shift;
     my $redis = LANraragi::Model::Config->get_redis;
 
-    my $file = $redis->hget( $id, "file" );
+    my $file = create_path( $redis->hget( $id, "file" ) );
     unless ( -e $file ) { return; }
 
     my $arcdata = get_archive_json( $redis, $id );

lib/LANraragi/Model/Upload.pm

@@ -85,7 +85,7 @@ sub handle_incoming_file ( $tempfile, $catid, $tags, $title, $summary ) {
 
     # Add the file to the database ourselves so Shinobu doesn't do it
     # This allows autoplugin to be ran ASAP.
-    my $name = add_archive_to_redis( $id, $output_file, $output_file, $redis, $redis_search );
+    my $name = add_archive_to_redis( $id, $output_file, $redis, $redis_search );
 
     # If additional tags were given to the sub, add them now.
     if ($tags) {

lib/LANraragi/Plugin/Metadata/DateAdded.pm

@@ -9,6 +9,7 @@ use Mojo::UserAgent;
 
 use LANraragi::Model::Plugins;
 use LANraragi::Utils::Logging qw(get_logger);
+use LANraragi::Utils::Path    qw(date_modified);
 
 #Meta-information about your plugin.
 sub plugin_info {
@@ -51,7 +52,7 @@ sub get_tags {
 
     if ( $oneshot_file_time || ( $use_filetime && !$oneshot_current_time ) ) {
         $logger->info("Using file date");
-        $newtags = "date_added:" . ( stat( $lrr_info->{file_path} ) )[9];    #9 is the unix time stamp for date modified.
+        $newtags = "date_added:" . date_modified( $lrr_info->{file_path} );
     } else {
         $logger->info("Using current date");
         $newtags = "date_added:" . time();

lib/LANraragi/Plugin/Metadata/Eze.pm

@@ -15,6 +15,7 @@ use LANraragi::Utils::Database;
 use LANraragi::Utils::Logging qw(get_plugin_logger);
 use LANraragi::Utils::String  qw(trim);
 use LANraragi::Utils::Archive qw(is_file_in_archive extract_file_from_archive);
+use LANraragi::Utils::Path    qw(create_path open_path);
 
 #Meta-information about your plugin.
 sub plugin_info {
@@ -52,7 +53,7 @@ sub get_tags {
     my $path_in_archive = is_file_in_archive( $lrr_info->{file_path}, "info.json" );
 
     my ( $name, $path, $suffix ) = fileparse( $lrr_info->{file_path}, qr/\.[^.]*/ );
-    my $path_nearby_json = $path . $name . '.json';
+    my $path_nearby_json = create_path( $path . $name . '.json' );
 
     my $filepath;
     my $delete_after_parse;
@@ -73,7 +74,7 @@ sub get_tags {
     #Open it
     my $stringjson = "";
 
-    open( my $fh, '<:encoding(UTF-8)', $filepath )
+    open_path( my $fh, '<:encoding(UTF-8)', $filepath )
       or die "Could not open $filepath!\n";
 
     while ( my $row = <$fh> ) {

lib/LANraragi/Utils/Archive.pm

@@ -27,6 +27,7 @@ use LANraragi::Utils::TempFolder qw(get_temp);
 use LANraragi::Utils::Logging    qw(get_logger);
 use LANraragi::Utils::Generic    qw(is_image shasum_str);
 use LANraragi::Utils::Redis      qw(redis_decode);
+use LANraragi::Utils::Path       qw(create_path);
 
 # Utilitary functions for handling Archives.
 # Relies on Libarchive, ImageMagick and GhostScript for PDFs.
@@ -250,7 +251,7 @@ sub is_file_in_archive ( $archive, $wantedname ) {
     $logger->debug("Iterating files of archive $archive, looking for '$wantedname'");
     $Data::Dumper::Useqq = 1;
 
-    my $peek = Archive::Libarchive::Peek->new( filename => $archive );
+    my $peek = Archive::Libarchive::Peek->new( filename => create_path( $archive ) );
     my $found;
     my @files = $peek->files;
 
@@ -318,7 +319,7 @@ sub extract_single_file ( $archive, $filepath ) {
     } else {
 
         my $contents = "";
-        my $peek     = Archive::Libarchive::Peek->new( filename => $archive );
+        my $peek     = Archive::Libarchive::Peek->new( filename => create_path( $archive ) );
         my @files    = $peek->files;
 
         for my $name (@files) {

lib/LANraragi/Utils/Database.pm

@@ -22,6 +22,8 @@ use LANraragi::Utils::String  qw(trim trim_CRLF trim_url);
 use LANraragi::Utils::Tags    qw(unflat_tagrules tags_rules_to_array restore_CRLF join_tags_to_string split_tags_to_array );
 use LANraragi::Utils::Archive qw(get_filelist);
 use LANraragi::Utils::Logging qw(get_logger);
+use LANraragi::Utils::Path    qw(create_path open_path date_modified);
+
 use LANraragi::Model::Config;
 
 # Functions for interacting with the DB Model.
@@ -34,29 +36,26 @@ our @EXPORT_OK = qw(
 
 # Creates a DB entry for a file path with the given ID.
 # This function doesn't actually require the file to exist at its given location.
-# On Unix-like $file and $file_fs must the same.
-# On Windows $file should contain the original path and $file_fs the file system
-# path in either long or short form.
-sub add_archive_to_redis ( $id, $file, $file_fs, $redis, $redis_search ) {
+sub add_archive_to_redis ( $id, $file, $redis, $redis_search ) {
 
     my $logger = get_logger( "Archive", "lanraragi" );
     my ( $name, $path, $suffix ) = fileparse( $file, qr/\.[^.]*/ );
 
     # Initialize Redis hash for the added file
     $logger->debug("Pushing to redis on ID $id:");
     $logger->debug("File Name: $name");
-    $logger->debug("Filesystem Path: $file_fs");
+    $logger->debug("Filesystem Path: $file");
 
     $redis->hset( $id, "name",    LANraragi::Utils::Redis::redis_encode($name) );
     $redis->hset( $id, "tags",    "" );
     $redis->hset( $id, "summary", "" );
 
-    if ( defined($file_fs) && -e $file_fs ) {
-        $redis->hset( $id, "arcsize", -s $file_fs );
+    if ( defined($file) && -e $file ) {
+        $redis->hset( $id, "arcsize", -s $file );
     }
 
     # Don't encode filenames.
-    $redis->hset( $id, "file", $file_fs );
+    $redis->hset( $id, "file", $file );
 
     # Set title so that index is updated
     # Throw a decode in there just in case the filename is already UTF8
@@ -124,7 +123,7 @@ sub add_timestamp_tag ( $redis, $id ) {
 
         if ( LANraragi::Model::Config->use_lastmodified eq "1" ) {
             $logger->debug("Using file date");
-            $date = ( stat( $redis->hget( $id, "file" ) ) )[9];    #9 is the unix time stamp for date modified.
+            $date = date_modified( $redis->hget( $id, "file" ) );
         } else {
             $logger->debug("Using current date");
             $date = time();
@@ -234,6 +233,8 @@ sub build_json ( $id, %hash ) {
     my ( $name, $title, $tags, $summary, $file, $isnew, $progress, $pagecount, $lastreadtime, $arcsize ) =
       @hash{qw(name title tags summary file isnew progress pagecount lastreadtime arcsize)};
 
+    $file = create_path( $file );
+
     # Return undef if the file doesn't exist.
     return unless ( defined($file) && -e $file );
 
@@ -358,7 +359,7 @@ sub clean_database {
         }
 
         # Check if the linked file exists
-        my $file = $redis->hget( $id, "file" );
+        my $file = create_path( $redis->hget( $id, "file" ) );
         unless ( -e $file ) {
             LANraragi::Model::Archive::delete_archive($id);
             $deleted_arcs++;
@@ -542,7 +543,7 @@ sub update_indexes ( $id, $oldtags, $newtags ) {
 sub compute_id ($file) {
 
     #Read the first 512 KBs only (allows for faster disk speeds )
-    open( my $handle, '<:raw', $file ) or die "Couldn't open $file :" . $!;
+    open_path( my $handle, '<:raw', $file ) or die "Couldn't open $file :" . $!;
     my $data;
     my $len = read $handle, $data, 512000;
     close $handle;
@@ -608,7 +609,7 @@ sub get_computed_tagrules {
 }
 
 sub add_arcsize ( $redis, $id ) {
-    my $file = $redis->hget( $id, "file" );
+    my $file = create_path( $redis->hget( $id, "file" ) );
     $redis->hset( $id, "arcsize", -s $file );
 }
 

lib/LANraragi/Utils/Generic.pm

@@ -131,7 +131,7 @@ sub start_minion {
         return $proc;
     } else {
         my $proc;
-        Win32::Process::Create($proc, undef, "perl " . abs_path(".") ."/lib/Worker.pm", 0, NORMAL_PRIORITY_CLASS, ".");
+        Win32::Process::Create($proc, undef, "perl \"" . abs_path(".") ."/lib/Worker.pm\"", 0, NORMAL_PRIORITY_CLASS, ".");
         $logger->info("Starting new Minion worker with PID " . $proc->GetProcessID() . "." );
         return $proc;
     }
@@ -162,7 +162,7 @@ sub start_shinobu {
         return $proc;
     } else {
         my $proc;
-        Win32::Process::Create($proc, undef, "perl " . abs_path(".") ."/lib/Shinobu.pm", 0, NORMAL_PRIORITY_CLASS, ".");
+        Win32::Process::Create($proc, undef, "perl \"" . abs_path(".") ."/lib/Shinobu.pm\"", 0, NORMAL_PRIORITY_CLASS, ".");
         open( my $fh, ">", get_temp() . "/shinobu.pid-s6" );
         print $fh $proc->GetProcessID();
         close($fh);

lib/LANraragi/Utils/Path.pm

@@ -0,0 +1,66 @@
+package LANraragi::Utils::Path;
+
+use strict;
+use warnings;
+use utf8;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use Encode;
+use Config;
+
+use constant IS_UNIX => ( $Config{osname} ne 'MSWin32' );
+
+use Exporter 'import';
+our @EXPORT_OK = qw(create_path open_path date_modified compat_path unlink_path);
+
+BEGIN {
+    if ( !IS_UNIX ) {
+        require Win32::LongPath;
+        require Win32::LongPath::Path;
+        require Win32::FileSystemHelper;
+    }
+}
+
+sub create_path($file) {
+    if ( IS_UNIX ) {
+        return $file;
+    } else {
+        return Win32::LongPath::Path->new( $file );
+    }
+}
+
+sub open_path {
+    if ( IS_UNIX ) {
+        return CORE::open( $_[0], $_[1], $_[2] );
+    } else {
+        return Win32::LongPath::openL( \$_[0], $_[1], decode_utf8( $_[2] ) );
+    }
+}
+
+sub date_modified($file) {
+    if ( IS_UNIX ) {
+        return ( CORE::stat( $file) )[9]; #9 is the unix time stamp for date modified.
+    } else {
+        return Win32::LongPath::statL( decode_utf8( $file ) )->{mtime};
+    }
+}
+
+sub compat_path($file) {
+    if ( !IS_UNIX ) {
+        if ( length($file) >= 260 ) {
+            $file = Win32::FileSystemHelper::get_short_path($file);
+        }
+    }
+    return $file;
+}
+
+sub unlink_path($file) {
+    if ( IS_UNIX ) {
+        return unlink $file;
+    } else {
+        return Win32::LongPath::unlinkL( decode_utf8( $file ) );
+    }
+}
+
+1;