PrusaSlicer-NonPlainar/lib/Slic3r/GCode/PlaceholderParser.pm

package Slic3r::GCode::PlaceholderParser;
use strict;
use warnings;

sub new {
    # TODO: move this code to C++ constructor, remove this method
    my ($class) = @_;
    my $self = $class->_new;
    $self->apply_env_variables;
    $self->update_timestamp;
    return $self;
}

sub apply_env_variables {
    my ($self) = @_;
    $self->_single_set($_, $ENV{$_}) for grep /^SLIC3R_/, keys %ENV;
}

sub update_timestamp {
    my ($self) = @_;

    my @lt = localtime; $lt[5] += 1900; $lt[4] += 1;
    $self->_single_set('timestamp', sprintf '%04d%02d%02d-%02d%02d%02d', @lt[5,4,3,2,1,0]);
    $self->_single_set('year',      "$lt[5]");
    $self->_single_set('month',     "$lt[4]");
    $self->_single_set('day',       "$lt[3]");
    $self->_single_set('hour',      "$lt[2]");
    $self->_single_set('minute',    "$lt[1]");
    $self->_single_set('second',    "$lt[0]");
    $self->_single_set('version',   $Slic3r::VERSION);
}

sub apply_config {
    my ($self, $config) = @_;
    
    # options with single value
    my @opt_keys = grep $Slic3r::Config::Options->{$_}{cli} !~ /\@$/,
        grep !$Slic3r::Config::Options->{$_}{multiline},
        @{$config->get_keys};
    $self->_single_set($_, $config->serialize($_)) for @opt_keys;

    # options with multiple values
    foreach my $opt_key (@opt_keys) {
        my $value = $config->$opt_key;
        next unless ref($value) eq 'ARRAY';
        # TODO: this is a workaroud for XS string param handling
        # https://rt.cpan.org/Public/Bug/Display.html?id=94110
        "$_" for @$value;
        $self->_multiple_set("${opt_key}_" . $_, $value->[$_]."") for 0..$#$value;
        $self->_multiple_set($opt_key, $value->[0]."");
        if ($Slic3r::Config::Options->{$opt_key}{type} eq 'point') {
            $self->_multiple_set("${opt_key}_X", $value->[0]."");
            $self->_multiple_set("${opt_key}_Y", $value->[1]."");
        }
    }
}

# TODO: or this could be an alias
sub set {
    my ($self, $key, $val) = @_;
    $self->_single_set($key, $val);
}

sub process {
    my ($self, $string, $extra) = @_;
    
    # extra variables have priority over the stored ones
    if ($extra) {
        my $regex = join '|', keys %$extra;
        $string =~ s/\[($regex)\]/$extra->{$1}/eg;
    }
    {
        my $regex = join '|', @{$self->_single_keys};
        $string =~ s/\[($regex)\]/$self->_single_get("$1")/eg;
    }
    {
        my $regex = join '|', @{$self->_multiple_keys};
        $string =~ s/\[($regex)\]/$self->_multiple_get("$1")/egx;
        
        # unhandled indices are populated using the first value
        $string =~ s/\[($regex)_\d+\]/$self->_multiple_get("$1")/egx;
    }
    
    return $string;
}

1;