Misc.pm (1470B)
1 #!/usr/bin/env perl 2 3 # LSG::Misc - miscellaneous functions for the LSG 4 # Written by lumidify <nobody@lumidify.org> 5 # 6 # To the extent possible under law, the author has dedicated 7 # all copyright and related and neighboring rights to this 8 # software to the public domain worldwide. This software is 9 # distributed without any warranty. 10 # 11 # You should have received a copy of the CC0 Public Domain 12 # Dedication along with this software. If not, see 13 # <http://creativecommons.org/publicdomain/zero/1.0/>. 14 15 package LSG::Misc; 16 use strict; 17 use warnings; 18 use utf8; 19 use open qw< :encoding(UTF-8) >; 20 binmode STDIN, ":encoding(UTF-8)"; 21 binmode STDOUT, ":encoding(UTF-8)"; 22 binmode STDERR, ":encoding(UTF-8)"; 23 24 # Generate relative link - both paths must already be relative, 25 # starting at the same place! 26 # e.g. "bob/hi/whatever/meh.txt","bob/hi/bla/fred.txt" => ../bla/fred.txt 27 sub gen_relative_link { 28 my ($base, $linked) = @_; 29 my @parts_base = split("/", $base); 30 my @parts_linked = split("/", $linked); 31 # don't include last element in @parts_base (the filename) 32 my $i = 0; 33 while ($i < $#parts_base && $i < $#parts_linked) { 34 if ($parts_base[$i] ne $parts_linked[$i]) { 35 last; 36 } 37 $i++; 38 } 39 my $rel_lnk = ""; 40 $rel_lnk .= "../" x ($#parts_base-$i); 41 $rel_lnk .= join("/", @parts_linked[$i..$#parts_linked]); 42 return $rel_lnk; 43 } 44 45 1;