File Coverage

lib/String/Super.pm

Criterion	Covered	Total	%
statement	83	90	92.2
branch	27	44	61.3
condition			n/a
subroutine	11	11	100.0
pod	6	6	100.0
total	127	151	84.1

# Copyright (c) 2025 Philipp Schafft

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: Compactor for superstrings

package String::Super;

use v5.20;
use strict;
use warnings;

use Carp;

our $VERSION = v0.02;



sub new {
    my ($pkg, %opts) = @_;
    my $self = bless {
        strings => [],
        result => undef,
        keep_first => undef,
    }, $pkg;

    if (defined(my $prefix_blob = delete $opts{prefix_blob})) {
        $self->add_blob($prefix_blob);
        $self->{keep_first} = 1;
    }

    croak 'Stray options passed' if scalar keys %opts;

    return $self;
}


sub add_blob {
    my ($self, @blobs) = @_;
    my $res = scalar(@{$self->{strings}});

    croak 'Already compacted' if defined $self->{result};

    foreach my $blob (@blobs) {
        croak 'Provided blob is a reference' if ref $blob;
    }

    push(@{$self->{strings}}, @blobs);

    return $res;
}


sub add_utf8 {
    require Encode;

    my ($self, @strings) = @_;
    state $UTF_8 = Encode::find_encoding('UTF-8');

    foreach my $string (@strings) {
        croak 'Provided string is a reference' if ref $string;
    }

    return $self->add_blob(map {$UTF_8->encode($_)} @strings);
}


sub compact {
    my ($self, %opts) = @_;

    croak 'Stray options passed' if scalar keys %opts;

    return if defined $self->{result};

    {
        my @data = @{$self->{strings}};
        my $j_start = $self->{keep_first} ? 1 : 0;

        # eliminate all strings first that are already part of other strings
        outer:
        for (my $i = 0; $i < scalar(@data); $i++) {
            for (my $j = $j_start; $j < scalar(@data); $j++) {
                next if $i == $j;

                if (index($data[$i], $data[$j]) >= 0) {
                    splice(@data, $j, 1);
                    $i--;
                    next outer;
                }
            }
        }

        for (my $n = 8; $n > 0; $n--) {
            $self->_compact_n(\@data, $n);
        }

        $self->{result} = join('', @data);
    }
}


sub result {
    my ($self, %opts) = @_;

    croak 'Stray options passed' if scalar keys %opts;

    $self->compact;

    return $self->{result};
}


sub offset {
    my ($self, @args) = @_;
    my @res;

    while (scalar(@args) >= 2) {
        my ($key, $value) = (shift(@args), shift(@args));
        my $d;

        if ($key eq 'index') {
            $d = $self->{strings}[$value];
        } else {
            croak 'Invalid type: '.$key;
        }

        if (!defined($d)) {
            croak 'Undefined value';
        } elsif (ref($d)) {
            croak 'Not a valid value (reference passed as blob?)';
        }

        $d = index($self->{result}, $d);
        if ($d < 0) {
            croak 'Substring not found (this is most likely a bug in the callers code)';
        }

        push(@res, $d);
    }

    croak 'Stray options passed' if scalar @args;

    if (wantarray) {
        return @res;
    } else {
        croak 'Not exactly one result' unless scalar(@res) == 1;
        return $res[0];
    }
}

# ---- Private helpers ----

sub _compact_n {
    my ($self, $data, $n) = @_;
    my $j_start = $self->{keep_first} ? 1 : 0;

    outer:
    for (my $i = 0; $i < scalar(@{$data}); $i++) {
        my $suffix = substr($data->[$i], -$n);

        next if length($suffix) != $n;

        for (my $j = $j_start; $j < scalar(@{$data}); $j++) {
            next if $i == $j;

            #warn sprintf('%u, %u, -> %s, %s', $i, $j, defined($data->[$i]) ? 't' : 'f', defined($data->[$j]) ? 't' : 'f') unless defined($data->[$i]) && defined($data->[$j]);
            if ($suffix eq substr($data->[$j], 0, $n)) {
                substr($data->[$i], -$n, $n, $data->[$j]);
                splice(@{$data}, $j, 1);
                $i--;
                next outer;
            }
        }
    }
}
1;

__END__