aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjake <jake@jakes-mail.top>2022-01-19 17:26:57 -0500
committerjake <jake@jakes-mail.top>2022-01-19 17:26:57 -0500
commit707dbdbba8958fb2119265cdff1d1dbe57cc5580 (patch)
treefe24d551fc30a1a7a008df0563c9601f8a66d058
parent9e948b878a55cd826df305063773dbc5c86ee7e0 (diff)
url relative is its own subroutine now
-rwxr-xr-xgmi.pl144
1 files changed, 84 insertions, 60 deletions
diff --git a/gmi.pl b/gmi.pl
index 15c8b20..9a58b46 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -10,7 +10,7 @@ use bytes;
use feature qw(refaliasing);
no warnings qw(experimental::refaliasing);
-our $VERSION = 'v0.0.19';
+our $VERSION = 'v0.0.20';
# TODO:
# back() only works once; should fix this
@@ -42,12 +42,17 @@ my %commands = (
'url' => [sub { url($_[0],0) }, 'Go to the specified URL.'],
'u' => [sub { url($_[0],0) }, 'Alias of `url\''],
- 'urlrelative' => [sub { url($_[0],1) }, "Navigate the current URL relatively.\n\n"
+ 'urlrelative' => [sub { urlrelative($_[0]) }, "Navigate the current URL relatively.\n\n"
."Note: if the current path is '/blog/my-post1.gmi' and 'my-post2.gmi'\n" .
- "was supplied then the resulting path will be: 'blog/my-post1.gmi/my-post2.gmi'\n" .
- "which is probably not what you want; in that case use '../my-post2.gmi'.\n\n" .
- "The very end of the path is treated like a directory which can be confusing."],
- 'ur' => [sub { url($_[0],1) }, 'Alias of `urlrelative\''],
+ "was supplied then the resulting path will be: '/blog/my-post2.gmi'\n" .
+ "which is probably what you want. You can also use './my-post2.gmi'.\n" .
+ "'.', of course, means 'same directory', in this case '/blog/'.\n\n" .
+ "To remove the forward slash ('/') at the end of the current url,\n" .
+ "type the back-slash ('\\') by itself.\n\n" .
+ "urlrelative without an argument will remove the ending '/' or go\n" .
+ "up a directory without appending a forward slash.\n" .
+ "IE: '/blog/drafts/secret/post.gmi -> '/blog/drafts/secret' -> '/blog/drafts'"],
+ 'ur' => [sub { urlrelative($_[0]) }, 'Alias of `urlrelative\''],
'cwu' => [sub { print "$current_url\n"; }, 'Returns the current working URL.'],
'c' => [sub { print "$current_url\n"; }, 'Alias of `cwu\'.'],
@@ -142,64 +147,14 @@ sub help {
}
sub url {
- # technically 'gemini://john/blog/thing.gmi' can be a valid url
- # where 'john' is the host
- # which makes determining relative movements a pain
- #
- # mode 0 = 'john' can be a host, 1 = 'john' is actually relative movement
- my ($url, $mode) = @_;
+ my ($url) = @_;
### $url
if (!$url) { print("Example: [gemini://]capsule.com/\n"); return 1;}
- if ($url eq '/') {
- $url = './';
- }
if ( $url !~ m|^.*://.*|) {
$url = "gemini://$url";
}
+
$url = parse_url($url);
- # ## $url
- my $need_slash;
-
- # relative movement
- if ($mode and $mode eq 1) {
- if (!$current_url) {print "Relative movement impossible: no current URL.\n"; return 1;}
- my $c_url = parse_url($current_url);
-
- #if ($url->{host} and $url->{host} eq '.') { # './' or '/'
- # $need_slash = 1;
- #}
-
- ### $url
- ### $need_slash
- if ($url->{path}) {
- $url->{path} = "$url->{host}/$url->{path}";
- }
- else {
- delete($url->{path}); # DO NOT DELETE THIS LINE (P)
- $url->{path} = "$url->{host}";
- }
- $url->{host} = $c_url->{host};
- $url->{port} = $c_url->{port};
-
-
- my $cp_url;
- if ($c_url->{path}) {
- $cp_url = split_url_path($c_url->{path}, 256);
- }
- else {
- $cp_url = [''];
- }
- $c_url->{path} = '';
-
- for (@$cp_url) {
- $c_url->{path} .= "$_/"
- }
-
- $c_url->{path} = "/$c_url->{path}/$url->{path}"; # adding first / for normalize_path
- $c_url->{path} = normalize_path($c_url->{path});
- substr($c_url->{path}, 0, 1, ''); # removing the first /
- $url->{path} = $c_url->{path};
- }
### $url
if (! $url->{port} or $url->{port} eq 0) {
@@ -212,7 +167,7 @@ sub url {
SSL_verify_mode => SSL_VERIFY_NONE,
SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1',
- );
+ );
if ($cl) {
my $path;
@@ -222,7 +177,7 @@ sub url {
else {
$path = normalize_path("$url->{path}");
}
- $url->{path} .= "/" if ($need_slash);
+ #$url->{path} .= "/" if ($need_slash);
$current_url = return_url($url);
### $current_url
@@ -252,6 +207,75 @@ sub url {
}
}
+sub urlrelative {
+ my ($urlr) = @_;
+ if (!$current_url) {print "Relative movement impossible: no current URL.\n"; return 1;}
+ my $end_with_slash = 1 if ($urlr =~ m|/$|);
+ my $dot_only = 1 if ($urlr =~ m|^\.$|);
+ my $dot_2_only = 1 if ($urlr =~ m|^\.\.$|); # since we are going up into a dir
+ my $c_url_directory = 1 if ($current_url =~ m|/$|);
+ my $remove_slash = 1 if ($urlr =~ m|^\\$|); # back slash \ not a forward slash /
+
+ ### is urlr a slash only ?
+ if ($urlr =~ m|^/$|) { # if slash only
+ $current_url .= "/";
+ url("$current_url");
+ return 0;
+ }
+
+ ### remove slash ?
+ if ($remove_slash) {
+ substr($current_url,-1,1,'');
+ ### $current_url
+ url($current_url);
+ return 0;
+ }
+
+ ### is the current url a directory?
+ if ($c_url_directory) {
+ $current_url .= "$urlr";
+ my $c_p_url = parse_url($current_url);
+ ### $c_p_url
+ # if $urlr has '..' then normalize_path will not go beyond the last element
+ # which is why prefixing a '/' and then taking it away (parse_url doesnt have
+ # the forward / ) will result in expected behavior as host always end with '/'
+ $c_p_url->{path} = normalize_path("/" . $c_p_url->{path});
+ if ($end_with_slash or $dot_only or $dot_2_only) {
+ $c_p_url->{path} .= "/"; # normalize path will remove it
+ }
+ substr($c_p_url->{path},0,1,'');
+ url(return_url($c_p_url));
+ return 0;
+ }
+
+ ### current url is not a directory, so should be fine to remove last item on path
+ # ^ some servers serve index page on 'dir' rather than 'dir/' :v annoying
+ # authors using servers like that will notice that the links on index page need to be
+ # carefully managed, because ALL clients (that handle links correctly) *will* mess up.
+ if (! $c_url_directory) {
+ my $c_p_url = parse_url($current_url);
+ ### $c_p_url
+ my $c_paths_url = split_url_path($c_p_url->{path}, 256);
+ ### $c_paths_url
+ pop(@$c_paths_url);
+ ### $c_paths_url
+ delete ($c_p_url->{path});
+ for (@$c_paths_url) {
+ $c_p_url->{path} .= "$_/";
+ }
+ ### $c_p_url
+ $c_p_url->{path} .= "$urlr";
+ $c_p_url->{path} = normalize_path("/" . "$c_p_url->{path}");
+ if ($end_with_slash or $dot_only or $dot_2_only) {
+ $c_p_url->{path} .= "/"; # normalize path will remove it
+ }
+ substr($c_p_url->{path},0,1,'');
+ ### $c_p_url
+ url(return_url($c_p_url));
+ return 0;
+ }
+}
+
sub return_url {
my ($url) = @_;
my $url_string;