package Tools;

use strict;

use Cwd 'abs_path';
use File::Basename;

our $tools;
our $lego;

(undef, $tools) = fileparse(abs_path($0));  # все скрипты должны лежать в /tools/
$lego = abs_path("$tools/../");             # корень лего находится в .. считая от /tools/

# возвращает строку вида "../../..", позволяющую заменить
# абсолютный путь к файлу на относительный от корня Лего
sub dots {
    my ($name) = @_;

    my (undef, $dots) = fileparse(abs_path($name));

    $dots =~ s/^$lego//;
    $dots =~ s/[^\/]+/../g;
    $dots =~ s/^\///;
    $dots =~ s/\/$//;

    return $dots;
}

sub options {
    my ($name) = @_;
    open(F, "xsltproc --xinclude $tools/xml2options.xsl $name |");
    my $options = {};
    while (<F>) {
        chomp;
        my ($key , $value) = split(/=/);
        $options->{$key} = $value;
    }
    close(F);
    return $options;
}

sub rel_path {
    my ($name, $rel_to) = @_;

    $name = abs_path($name);
    $rel_to = abs_path($rel_to);

    my $common = starts_with($name, $rel_to);

    $name =~ s{^$common}{};
    $rel_to =~ s{^$common}{};

    if ($rel_to =~ m{/}) {
        $rel_to =~ s{/[^/]*$}{};
        $rel_to =~ s{[^/]+}{..}g;

        $name = "$rel_to/$name";
    }

    return $name;
}

sub starts_with {
    my ($a, $b) = @_;

    my $r = '';
    my @a = split('/', $a);
    my @b = split('/', $b);

    my $i = 0;
    my @path = ();
    while ($a[$i] eq $b[$i]) {
        push(@path, $a[$i]);
        $i++;
    }
    return join("/", @path) . "/";
}

1;

