2016-09-13 09:24:55 +00:00
|
|
|
# This package loads all the non-GUI Slic3r perl packages.
|
|
|
|
# In addition, it implements utility functions for file handling and threading.
|
|
|
|
|
2011-09-01 19:06:28 +00:00
|
|
|
package Slic3r;
|
|
|
|
|
2012-01-18 19:04:18 +00:00
|
|
|
# Copyright holder: Alessandro Ranellucci
|
|
|
|
# This application is licensed under the GNU Affero General Public License, version 3
|
|
|
|
|
2011-09-01 19:06:28 +00:00
|
|
|
use strict;
|
|
|
|
use warnings;
|
2012-01-22 12:56:15 +00:00
|
|
|
require v5.10;
|
2011-09-01 19:06:28 +00:00
|
|
|
|
2014-11-09 19:41:27 +00:00
|
|
|
our $VERSION = VERSION();
|
2011-11-13 21:57:58 +00:00
|
|
|
|
2011-09-05 11:33:09 +00:00
|
|
|
our $debug = 0;
|
|
|
|
sub debugf {
|
|
|
|
printf @_ if $debug;
|
|
|
|
}
|
|
|
|
|
2012-05-19 18:25:59 +00:00
|
|
|
# load threads before Moo as required by it
|
2012-05-21 17:16:42 +00:00
|
|
|
our $have_threads;
|
2012-05-21 16:44:31 +00:00
|
|
|
BEGIN {
|
2016-09-14 09:22:41 +00:00
|
|
|
# Test, whether the perl was compiled with ithreads support and ithreads actually work.
|
2012-05-21 16:44:31 +00:00
|
|
|
use Config;
|
2013-02-27 10:08:08 +00:00
|
|
|
$have_threads = $Config{useithreads} && eval "use threads; use threads::shared; use Thread::Queue; 1";
|
2014-12-17 13:53:36 +00:00
|
|
|
warn "threads.pm >= 1.96 is required, please update\n" if $have_threads && $threads::VERSION < 1.96;
|
2013-07-24 08:06:02 +00:00
|
|
|
|
|
|
|
### temporarily disable threads if using the broken Moo version
|
|
|
|
use Moo;
|
|
|
|
$have_threads = 0 if $Moo::VERSION == 1.003000;
|
2016-09-14 09:22:41 +00:00
|
|
|
|
|
|
|
# Disable multi threading completely by an environment value.
|
|
|
|
# This is useful for debugging as the Perl debugger does not work
|
|
|
|
# in multi-threaded context at all.
|
|
|
|
# A good interactive perl debugger is the ActiveState Komodo IDE
|
|
|
|
# or the EPIC http://www.epic-ide.org/
|
|
|
|
$have_threads = 0 if (defined($ENV{'SLIC3R_SINGLETHREADED'}) && $ENV{'SLIC3R_SINGLETHREADED'} == 1)
|
2012-05-21 16:44:31 +00:00
|
|
|
}
|
2012-05-19 18:25:59 +00:00
|
|
|
|
2016-09-13 09:24:55 +00:00
|
|
|
warn "Running Slic3r under Perl 5.16 is neither supported nor recommended\n"
|
2014-12-23 23:19:20 +00:00
|
|
|
if $^V == v5.16;
|
2012-09-11 14:02:26 +00:00
|
|
|
|
2012-05-29 12:19:14 +00:00
|
|
|
use FindBin;
|
2016-09-13 09:24:55 +00:00
|
|
|
# Path to the images.
|
2016-04-09 17:10:57 +00:00
|
|
|
our $var = sub { decode_path($FindBin::Bin) . "/var/" . $_[0] };
|
2012-05-29 12:19:14 +00:00
|
|
|
|
2013-09-12 09:09:03 +00:00
|
|
|
use Moo 1.003001;
|
2013-01-13 09:18:34 +00:00
|
|
|
|
2013-07-14 11:05:55 +00:00
|
|
|
use Slic3r::XS; # import all symbols (constants etc.) before they get parsed
|
2011-10-03 09:55:32 +00:00
|
|
|
use Slic3r::Config;
|
2011-10-15 09:36:05 +00:00
|
|
|
use Slic3r::ExPolygon;
|
2011-09-25 21:15:45 +00:00
|
|
|
use Slic3r::ExtrusionLoop;
|
2011-09-04 10:04:01 +00:00
|
|
|
use Slic3r::ExtrusionPath;
|
2011-09-05 10:21:27 +00:00
|
|
|
use Slic3r::Fill;
|
2012-06-06 16:05:03 +00:00
|
|
|
use Slic3r::Flow;
|
2012-02-25 16:35:25 +00:00
|
|
|
use Slic3r::Format::AMF;
|
2012-05-20 09:40:37 +00:00
|
|
|
use Slic3r::Format::OBJ;
|
2012-02-25 16:35:25 +00:00
|
|
|
use Slic3r::Format::STL;
|
2013-08-28 17:50:16 +00:00
|
|
|
use Slic3r::GCode::ArcFitting;
|
2013-04-03 23:17:44 +00:00
|
|
|
use Slic3r::GCode::CoolingBuffer;
|
2012-08-23 13:42:58 +00:00
|
|
|
use Slic3r::GCode::MotionPlanner;
|
2014-11-24 17:22:39 +00:00
|
|
|
use Slic3r::GCode::PressureRegulator;
|
2013-05-13 18:14:33 +00:00
|
|
|
use Slic3r::GCode::Reader;
|
2013-05-13 18:15:45 +00:00
|
|
|
use Slic3r::GCode::SpiralVase;
|
2013-08-28 14:51:58 +00:00
|
|
|
use Slic3r::GCode::VibrationLimit;
|
2011-12-07 18:33:59 +00:00
|
|
|
use Slic3r::Geometry qw(PI);
|
2013-06-07 21:16:02 +00:00
|
|
|
use Slic3r::Geometry::Clipper;
|
2011-09-01 19:06:28 +00:00
|
|
|
use Slic3r::Layer;
|
|
|
|
use Slic3r::Line;
|
2012-08-29 14:49:38 +00:00
|
|
|
use Slic3r::Model;
|
2011-09-01 19:06:28 +00:00
|
|
|
use Slic3r::Point;
|
2011-10-15 09:36:05 +00:00
|
|
|
use Slic3r::Polygon;
|
2011-09-01 19:06:28 +00:00
|
|
|
use Slic3r::Polyline;
|
|
|
|
use Slic3r::Print;
|
2014-11-30 17:09:06 +00:00
|
|
|
use Slic3r::Print::GCode;
|
2012-04-29 10:51:20 +00:00
|
|
|
use Slic3r::Print::Object;
|
2014-01-02 16:54:18 +00:00
|
|
|
use Slic3r::Print::Simple;
|
2013-09-17 21:27:57 +00:00
|
|
|
use Slic3r::Print::SupportMaterial;
|
2011-09-01 19:06:28 +00:00
|
|
|
use Slic3r::Surface;
|
2013-04-27 18:55:43 +00:00
|
|
|
our $build = eval "use Slic3r::Build; 1";
|
2014-07-12 09:41:18 +00:00
|
|
|
use Thread::Semaphore;
|
2015-06-13 09:41:55 +00:00
|
|
|
use Encode::Locale 1.05;
|
|
|
|
use Encode;
|
2015-06-02 14:10:15 +00:00
|
|
|
use Unicode::Normalize;
|
2011-09-01 19:06:28 +00:00
|
|
|
|
2016-09-13 09:24:55 +00:00
|
|
|
# Scaling between the float and integer coordinates.
|
|
|
|
# Floats are in mm.
|
2012-07-27 19:13:03 +00:00
|
|
|
use constant SCALING_FACTOR => 0.000001;
|
2016-09-13 13:02:28 +00:00
|
|
|
use constant LOOP_CLIPPING_LENGTH_OVER_NOZZLE_DIAMETER => 0.15;
|
|
|
|
|
|
|
|
# Following constants are used by the infill algorithms and integration tests.
|
2016-09-13 09:24:55 +00:00
|
|
|
# Resolution to simplify perimeters to. These constants are now used in C++ code only. Better to publish them to Perl from the C++ code.
|
|
|
|
# use constant RESOLUTION => 0.0125;
|
|
|
|
# use constant SCALED_RESOLUTION => RESOLUTION / SCALING_FACTOR;
|
2016-09-13 13:02:28 +00:00
|
|
|
use constant INFILL_OVERLAP_OVER_SPACING => 0.3;
|
2012-07-27 19:13:03 +00:00
|
|
|
|
2016-09-13 09:24:55 +00:00
|
|
|
# Keep track of threads we created. Each thread keeps its own list of threads it spwaned.
|
2014-12-13 14:01:53 +00:00
|
|
|
my @my_threads = ();
|
|
|
|
my @threads : shared = ();
|
|
|
|
my $pause_sema = Thread::Semaphore->new;
|
|
|
|
my $parallel_sema;
|
2014-07-12 09:41:18 +00:00
|
|
|
my $paused = 0;
|
2014-07-01 17:00:23 +00:00
|
|
|
|
|
|
|
sub spawn_thread {
|
|
|
|
my ($cb) = @_;
|
|
|
|
|
2014-12-12 23:01:24 +00:00
|
|
|
my $parent_tid = threads->tid;
|
2014-12-13 14:01:53 +00:00
|
|
|
lock @threads;
|
2014-12-12 23:01:24 +00:00
|
|
|
|
2014-07-12 09:41:18 +00:00
|
|
|
@_ = ();
|
|
|
|
my $thread = threads->create(sub {
|
2014-12-13 14:01:53 +00:00
|
|
|
@my_threads = ();
|
|
|
|
|
2014-12-22 23:39:22 +00:00
|
|
|
Slic3r::debugf "Starting thread %d (parent: %d)...\n", threads->tid, $parent_tid;
|
2014-07-12 09:41:18 +00:00
|
|
|
local $SIG{'KILL'} = sub {
|
2014-12-22 23:39:22 +00:00
|
|
|
Slic3r::debugf "Exiting thread %d...\n", threads->tid;
|
2014-12-13 14:01:53 +00:00
|
|
|
$parallel_sema->up if $parallel_sema;
|
2014-12-12 23:01:24 +00:00
|
|
|
kill_all_threads();
|
2014-07-12 09:41:18 +00:00
|
|
|
Slic3r::thread_cleanup();
|
|
|
|
threads->exit();
|
|
|
|
};
|
|
|
|
local $SIG{'STOP'} = sub {
|
2014-12-13 14:01:53 +00:00
|
|
|
$pause_sema->down;
|
|
|
|
$pause_sema->up;
|
2014-07-12 09:41:18 +00:00
|
|
|
};
|
|
|
|
$cb->();
|
|
|
|
});
|
2014-12-13 14:01:53 +00:00
|
|
|
push @my_threads, $thread->tid;
|
2014-07-01 17:00:23 +00:00
|
|
|
push @threads, $thread->tid;
|
|
|
|
return $thread;
|
|
|
|
}
|
2014-06-13 17:23:51 +00:00
|
|
|
|
2016-09-13 09:24:55 +00:00
|
|
|
# If the threading is enabled, spawn a set of threads.
|
|
|
|
# Otherwise run the task on the current thread.
|
|
|
|
# Used for
|
|
|
|
# Slic3r::Print::Object->layers->make_perimeters : This is a pure C++ function.
|
|
|
|
# Slic3r::Print::Object->layers->make_fill : This requires a rewrite of Fill.pm to C++.
|
|
|
|
# Slic3r::Print::SupportMaterial::generate_toolpaths
|
2012-04-09 10:29:47 +00:00
|
|
|
sub parallelize {
|
|
|
|
my %params = @_;
|
|
|
|
|
2014-12-22 18:47:39 +00:00
|
|
|
lock @threads;
|
2013-12-24 10:29:31 +00:00
|
|
|
if (!$params{disable} && $Slic3r::have_threads && $params{threads} > 1) {
|
2012-09-22 17:04:36 +00:00
|
|
|
my @items = (ref $params{items} eq 'CODE') ? $params{items}->() : @{$params{items}};
|
2012-04-09 10:29:47 +00:00
|
|
|
my $q = Thread::Queue->new;
|
2013-12-24 10:29:31 +00:00
|
|
|
$q->enqueue(@items, (map undef, 1..$params{threads}));
|
2012-04-09 10:29:47 +00:00
|
|
|
|
2014-12-13 14:01:53 +00:00
|
|
|
$parallel_sema = Thread::Semaphore->new(-$params{threads});
|
|
|
|
$parallel_sema->up;
|
2013-07-07 16:43:04 +00:00
|
|
|
my $thread_cb = sub {
|
2014-06-13 17:23:51 +00:00
|
|
|
# execute thread callback
|
2013-11-12 11:09:33 +00:00
|
|
|
$params{thread_cb}->($q);
|
2014-06-13 17:23:51 +00:00
|
|
|
|
2014-12-13 14:01:53 +00:00
|
|
|
# signal the parent thread that we're done
|
|
|
|
$parallel_sema->up;
|
|
|
|
|
2014-06-13 17:23:51 +00:00
|
|
|
# cleanup before terminating thread
|
2013-07-11 14:17:36 +00:00
|
|
|
Slic3r::thread_cleanup();
|
2013-11-12 11:09:33 +00:00
|
|
|
|
|
|
|
# This explicit exit avoids an untrappable
|
|
|
|
# "Attempt to free unreferenced scalar" error
|
|
|
|
# triggered on Ubuntu 12.04 32-bit when we're running
|
|
|
|
# from the Wx plater and
|
|
|
|
# we're reusing the same plater object more than once.
|
|
|
|
# The downside to using this exit is that we can't return
|
|
|
|
# any value to the main thread but we're not doing that
|
|
|
|
# anymore anyway.
|
|
|
|
threads->exit;
|
2013-07-07 16:43:04 +00:00
|
|
|
};
|
|
|
|
|
2013-05-19 15:34:33 +00:00
|
|
|
@_ = ();
|
2014-07-01 17:00:23 +00:00
|
|
|
my @my_threads = map spawn_thread($thread_cb), 1..$params{threads};
|
2014-12-13 14:01:53 +00:00
|
|
|
|
|
|
|
# We use a semaphore instead of $th->join because joined threads are
|
|
|
|
# not listed by threads->list or threads->object anymore, thus can't
|
|
|
|
# be signalled.
|
|
|
|
$parallel_sema->down;
|
|
|
|
$_->detach for @my_threads;
|
2012-04-09 10:29:47 +00:00
|
|
|
} else {
|
|
|
|
$params{no_threads_cb}->();
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-07-11 14:17:36 +00:00
|
|
|
# call this at the very end of each thread (except the main one)
|
|
|
|
# so that it does not try to free existing objects.
|
|
|
|
# at that stage, existing objects are only those that we
|
|
|
|
# inherited at the thread creation (thus shared) and those
|
|
|
|
# that we are returning: destruction will be handled by the
|
|
|
|
# main thread in both cases.
|
2013-09-17 21:14:49 +00:00
|
|
|
# reminder: do not destroy inherited objects in other threads,
|
|
|
|
# as the main thread will still try to destroy them when they
|
|
|
|
# go out of scope; in other words, if you're undef()'ing an
|
|
|
|
# object in a thread, make sure the main thread still holds a
|
|
|
|
# reference so that it won't be destroyed in thread.
|
2013-07-11 14:17:36 +00:00
|
|
|
sub thread_cleanup {
|
2014-06-13 17:23:51 +00:00
|
|
|
return if !$Slic3r::have_threads;
|
|
|
|
|
2015-11-02 00:36:35 +00:00
|
|
|
if (threads->tid == 0) {
|
|
|
|
warn "Calling thread_cleanup() from main thread\n";
|
|
|
|
return;
|
|
|
|
}
|
2016-09-13 09:24:55 +00:00
|
|
|
|
2013-07-11 14:17:36 +00:00
|
|
|
# prevent destruction of shared objects
|
|
|
|
no warnings 'redefine';
|
2014-11-15 21:41:22 +00:00
|
|
|
*Slic3r::BridgeDetector::DESTROY = sub {};
|
2013-12-21 23:39:03 +00:00
|
|
|
*Slic3r::Config::DESTROY = sub {};
|
2014-01-02 09:44:54 +00:00
|
|
|
*Slic3r::Config::Full::DESTROY = sub {};
|
2014-11-09 18:24:17 +00:00
|
|
|
*Slic3r::Config::GCode::DESTROY = sub {};
|
2013-12-21 23:39:03 +00:00
|
|
|
*Slic3r::Config::Print::DESTROY = sub {};
|
2014-01-02 09:44:54 +00:00
|
|
|
*Slic3r::Config::PrintObject::DESTROY = sub {};
|
|
|
|
*Slic3r::Config::PrintRegion::DESTROY = sub {};
|
2015-12-16 11:33:19 +00:00
|
|
|
*Slic3r::Config::Static::DESTROY = sub {};
|
2013-07-16 07:49:34 +00:00
|
|
|
*Slic3r::ExPolygon::DESTROY = sub {};
|
2013-07-13 22:38:01 +00:00
|
|
|
*Slic3r::ExPolygon::Collection::DESTROY = sub {};
|
2014-04-07 23:42:29 +00:00
|
|
|
*Slic3r::Extruder::DESTROY = sub {};
|
2013-07-16 07:49:34 +00:00
|
|
|
*Slic3r::ExtrusionLoop::DESTROY = sub {};
|
|
|
|
*Slic3r::ExtrusionPath::DESTROY = sub {};
|
2013-07-18 20:29:12 +00:00
|
|
|
*Slic3r::ExtrusionPath::Collection::DESTROY = sub {};
|
2016-04-11 15:05:58 +00:00
|
|
|
*Slic3r::ExtrusionSimulator::DESTROY = sub {};
|
2014-01-14 19:11:08 +00:00
|
|
|
*Slic3r::Flow::DESTROY = sub {};
|
2016-09-13 09:24:55 +00:00
|
|
|
*Slic3r::Filler::DESTROY = sub {};
|
2015-07-01 19:47:17 +00:00
|
|
|
*Slic3r::GCode::DESTROY = sub {};
|
2015-07-01 18:14:05 +00:00
|
|
|
*Slic3r::GCode::AvoidCrossingPerimeters::DESTROY = sub {};
|
2015-07-01 19:01:42 +00:00
|
|
|
*Slic3r::GCode::OozePrevention::DESTROY = sub {};
|
2014-05-06 08:07:18 +00:00
|
|
|
*Slic3r::GCode::PlaceholderParser::DESTROY = sub {};
|
2015-01-03 22:25:55 +00:00
|
|
|
*Slic3r::GCode::Sender::DESTROY = sub {};
|
2015-07-01 18:57:16 +00:00
|
|
|
*Slic3r::GCode::Wipe::DESTROY = sub {};
|
2014-11-09 18:02:45 +00:00
|
|
|
*Slic3r::GCode::Writer::DESTROY = sub {};
|
2014-01-14 19:11:08 +00:00
|
|
|
*Slic3r::Geometry::BoundingBox::DESTROY = sub {};
|
2014-09-21 08:51:36 +00:00
|
|
|
*Slic3r::Geometry::BoundingBoxf::DESTROY = sub {};
|
2014-01-14 19:11:08 +00:00
|
|
|
*Slic3r::Geometry::BoundingBoxf3::DESTROY = sub {};
|
2015-07-23 13:53:02 +00:00
|
|
|
*Slic3r::Layer::PerimeterGenerator::DESTROY = sub {};
|
2013-07-16 07:49:34 +00:00
|
|
|
*Slic3r::Line::DESTROY = sub {};
|
2014-12-16 00:12:37 +00:00
|
|
|
*Slic3r::Linef3::DESTROY = sub {};
|
2014-04-29 23:04:49 +00:00
|
|
|
*Slic3r::Model::DESTROY = sub {};
|
|
|
|
*Slic3r::Model::Object::DESTROY = sub {};
|
2013-07-16 07:49:34 +00:00
|
|
|
*Slic3r::Point::DESTROY = sub {};
|
2014-04-28 20:02:34 +00:00
|
|
|
*Slic3r::Pointf::DESTROY = sub {};
|
2014-01-14 19:11:08 +00:00
|
|
|
*Slic3r::Pointf3::DESTROY = sub {};
|
2013-07-16 07:49:34 +00:00
|
|
|
*Slic3r::Polygon::DESTROY = sub {};
|
|
|
|
*Slic3r::Polyline::DESTROY = sub {};
|
2013-09-12 09:09:03 +00:00
|
|
|
*Slic3r::Polyline::Collection::DESTROY = sub {};
|
2014-05-06 08:07:18 +00:00
|
|
|
*Slic3r::Print::DESTROY = sub {};
|
2015-01-24 22:35:29 +00:00
|
|
|
*Slic3r::Print::Object::DESTROY = sub {};
|
2014-05-06 08:07:18 +00:00
|
|
|
*Slic3r::Print::Region::DESTROY = sub {};
|
2013-07-16 07:49:34 +00:00
|
|
|
*Slic3r::Surface::DESTROY = sub {};
|
|
|
|
*Slic3r::Surface::Collection::DESTROY = sub {};
|
2013-09-12 09:09:03 +00:00
|
|
|
*Slic3r::TriangleMesh::DESTROY = sub {};
|
2013-09-19 14:00:47 +00:00
|
|
|
return undef; # this prevents a "Scalars leaked" warning
|
2013-07-11 14:17:36 +00:00
|
|
|
}
|
|
|
|
|
2014-07-12 09:41:18 +00:00
|
|
|
sub get_running_threads {
|
2014-12-13 14:01:53 +00:00
|
|
|
return grep defined($_), map threads->object($_), @_;
|
2014-07-12 09:41:18 +00:00
|
|
|
}
|
|
|
|
|
2014-07-01 17:00:23 +00:00
|
|
|
sub kill_all_threads {
|
2014-12-13 14:01:53 +00:00
|
|
|
# if we're the main thread, we send SIGKILL to all the running threads
|
|
|
|
if (threads->tid == 0) {
|
|
|
|
lock @threads;
|
|
|
|
foreach my $thread (get_running_threads(@threads)) {
|
2014-12-22 23:39:22 +00:00
|
|
|
Slic3r::debugf "Thread %d killing %d...\n", threads->tid, $thread->tid;
|
2014-12-13 14:01:53 +00:00
|
|
|
$thread->kill('KILL');
|
|
|
|
}
|
|
|
|
|
|
|
|
# unlock semaphore before we block on wait
|
|
|
|
# otherwise we'd get a deadlock if threads were paused
|
2014-12-22 18:47:39 +00:00
|
|
|
resume_all_threads();
|
2014-07-01 17:00:23 +00:00
|
|
|
}
|
2014-07-12 09:41:18 +00:00
|
|
|
|
2014-12-13 14:01:53 +00:00
|
|
|
# in any thread we wait for our children
|
|
|
|
foreach my $thread (get_running_threads(@my_threads)) {
|
2014-12-22 23:39:22 +00:00
|
|
|
Slic3r::debugf " Thread %d waiting for %d...\n", threads->tid, $thread->tid;
|
2014-12-12 23:01:24 +00:00
|
|
|
$thread->join; # block until threads are killed
|
2014-12-22 23:39:22 +00:00
|
|
|
Slic3r::debugf " Thread %d finished waiting for %d...\n", threads->tid, $thread->tid;
|
2014-12-12 23:01:24 +00:00
|
|
|
}
|
2014-12-13 14:01:53 +00:00
|
|
|
@my_threads = ();
|
2014-07-01 17:00:23 +00:00
|
|
|
}
|
|
|
|
|
2014-12-22 18:47:39 +00:00
|
|
|
sub pause_all_threads {
|
2014-07-12 09:41:18 +00:00
|
|
|
return if $paused;
|
2014-12-22 18:47:39 +00:00
|
|
|
lock @threads;
|
2014-07-12 09:41:18 +00:00
|
|
|
$paused = 1;
|
2014-12-13 14:01:53 +00:00
|
|
|
$pause_sema->down;
|
|
|
|
$_->kill('STOP') for get_running_threads(@threads);
|
2014-07-12 09:41:18 +00:00
|
|
|
}
|
|
|
|
|
2014-12-22 18:47:39 +00:00
|
|
|
sub resume_all_threads {
|
2014-07-12 09:41:18 +00:00
|
|
|
return unless $paused;
|
2014-12-22 18:47:39 +00:00
|
|
|
lock @threads;
|
2014-07-12 09:41:18 +00:00
|
|
|
$paused = 0;
|
2014-12-13 14:01:53 +00:00
|
|
|
$pause_sema->up;
|
2014-07-12 09:41:18 +00:00
|
|
|
}
|
|
|
|
|
2016-09-13 09:24:55 +00:00
|
|
|
# Convert a Unicode path to a file system locale.
|
|
|
|
# The encoding is (from Encode::Locale POD):
|
|
|
|
# Alias | Windows | Mac OS X | POSIX
|
|
|
|
# locale_fs | ANSI | UTF-8 | nl_langinfo
|
|
|
|
# where nl_langinfo is en-US.UTF-8 on a modern Linux as well.
|
|
|
|
# So this conversion seems to make the most sense on Windows.
|
2013-02-22 17:40:00 +00:00
|
|
|
sub encode_path {
|
2015-03-09 14:17:50 +00:00
|
|
|
my ($path) = @_;
|
|
|
|
|
2015-06-02 14:10:15 +00:00
|
|
|
$path = Unicode::Normalize::NFC($path);
|
2015-06-13 09:41:55 +00:00
|
|
|
$path = Encode::encode(locale_fs => $path);
|
2015-06-02 14:10:15 +00:00
|
|
|
|
2015-03-09 14:17:50 +00:00
|
|
|
return $path;
|
2013-02-22 17:40:00 +00:00
|
|
|
}
|
|
|
|
|
2016-09-13 09:24:55 +00:00
|
|
|
# Convert a path coded by a file system locale to Unicode.
|
2014-11-22 20:55:45 +00:00
|
|
|
sub decode_path {
|
2015-03-09 14:17:50 +00:00
|
|
|
my ($path) = @_;
|
|
|
|
|
2015-06-13 09:41:55 +00:00
|
|
|
$path = Encode::decode(locale_fs => $path)
|
|
|
|
unless utf8::is_utf8($path);
|
2015-06-02 14:10:15 +00:00
|
|
|
|
|
|
|
# The filesystem might force a normalization form (like HFS+ does) so
|
|
|
|
# if we rely on the filename being comparable after the open() + readdir()
|
|
|
|
# roundtrip (like when creating and then selecting a preset), we need to
|
|
|
|
# restore our normalization form.
|
|
|
|
$path = Unicode::Normalize::NFC($path);
|
2015-06-13 09:41:55 +00:00
|
|
|
|
2015-03-09 14:17:50 +00:00
|
|
|
return $path;
|
2014-11-22 20:55:45 +00:00
|
|
|
}
|
|
|
|
|
2016-09-13 09:24:55 +00:00
|
|
|
# Open a file by converting $filename to local file system locales.
|
2013-01-13 09:18:34 +00:00
|
|
|
sub open {
|
|
|
|
my ($fh, $mode, $filename) = @_;
|
2013-02-22 17:40:00 +00:00
|
|
|
return CORE::open $$fh, $mode, encode_path($filename);
|
2013-01-13 09:18:34 +00:00
|
|
|
}
|
|
|
|
|
2013-12-13 11:18:30 +00:00
|
|
|
# this package declaration prevents an ugly fatal warning to be emitted when
|
|
|
|
# spawning a new thread
|
|
|
|
package GLUquadricObjPtr;
|
|
|
|
|
2011-09-01 19:06:28 +00:00
|
|
|
1;
|