Less basic client

1 files changed, 311 insertions, 16 deletions

diff --git a/gmi.pl b/gmi.pl
index b16a178..3012dda 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -6,28 +6,323 @@ use strict;
 use warnings;
 use utf8;
 use bytes;
+use feature qw(refaliasing);
+no warnings qw(experimental::refaliasing);
 
-our $VERSION = '0.0.1';
+our $VERSION = 'v0.0.9';
+
+#TODO: back() only works once; should fix this
 
 # Modules
-use IO::Socket::SSL;     # CPAN
+use IO::Socket::SSL;                                      # CPAN
 use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN
+use Term::TUI qw(:all);                                   # CPAN
+use IO::Pager;                                            # CPAN
+require Text::Wrapper;                                    # CPAN
+use Term::ReadKey;                                        # CPAN
+use Term::ANSIColor;                                      # Core
+use Smart::Comments;                                      # CPAN
+
+#my ($wchar) = GetTerminalSize();
+my $wrapper = Text::Wrapper->new(columns=>70, body_start=>'');
+$ENV{pager} = 'less';
+my $use_pager = 1;
+my $pager_text_wrap_auto = 1;
+my $doc_out = 1; # display doc for human consumption?
+my $doc;
+my @links;
+my $current_url = "";
+my @history;
+
+# The way Term::TUI handles the data makes it impossible
+# to just give it a variable, but it does support stdin
+my %modes =
+(".HELP"  => "Super basic gemini glient.\nVersion: $VERSION\n" . 
+	"Type 'go' to enter 'go' mode. You can also: 'go url capsule.com' without being in 'go' mode.",
+
+	"go" => {".HELP" => "going to browse",
+
+		"url"  => [ "Make a request to a URL\nThis will set the current working URL" .
+			"\nExample: [gemini://]capsule.com/", \&url ],
+
+		"cwu" => ["Returns current working URL", \&cwu ],
+
+		"links" => ["Current working URL's links", \&links ],
+
+		"nav" => ["Follow a link.\n" . 
+			"Sets current working URL.", \&nav, 0 ],
+
+		"navh" => ["Follow a link from history.\n", \&nav, 1 ],
+
+		"root" => ["Go to current working URL root\n" .
+			"E.G. gemini://capsule.com/blog/20220112.gmi -> gemini://capsule.com/", \&root ],
+
+		"hist" => ["Returns history.", \&hist ],
+
+		"back" => ["Go back to the previous URL (uses history)", \&back, 0 ],
+		"b" => ["Alias of `back'", \&back, 0 ],
+
+		"backnodisplay" => ["Go back to the previous URL (uses history), ".
+			"but do not display the page.", \&back, 1 ],
+		"bd" => ["Alias of `backnodisplay'.", \&back, 1 ],
+
+		"display" => ["Display the current working URL.", \&display] ,
+		"d" => ["Alias of `display'", \&display ],
+
+	},
+	"cert" => {".HELP" => "Manage certs",
+		"aaa" => [ "This command returns `aaa'.", \&aaa ],
+	},
+	"config" => {".HELP" => "Config settings to your liking.",
+		"usepager" => ["This toggles pager use.\n" . 
+			"1 = use pager, 0 = stdout\n", \&toggle, 'pager'],
+
+		"textwrap" => ["Input must be an interger or 'auto'. No\n".
+			"input returns the current text-wrap.", \&textwrap],
+
+		"pager" => ["Set which pager to use.", \&pager],
+
+		"save" => ["Save your settings (not implimented yet)", \&asdf],
+	}
+);
+
+my $flag;
+$flag=TUI_Run("gc",\%modes);
+#print "*** ABORT ***\n" if ($flag);
+
+#TUI_Script(\%modes,"/config pager;");
+
+sub url {
+	# gemini://website.com/request-path.gmi
+	my ($url) = @_;
+	if (!$url) { TUI_Out("Example: [gemini://]capsule.com/\n"); return 0;}
+	if ( $url !~ m|^.*://.*|) {
+		$url = "gemini://$url";
+	}
+	### $url
+	$url = parse_url($url);
+	
+	my $cl = IO::Socket::SSL->new(
+		PeerHost => "$url->{host}",
+		PeerPort => '1965',
+	
+		SSL_verify_mode => SSL_VERIFY_NONE,
+		# will update version when support is better or
+		# when gemini removes TLSv1_2 as a supported version
+		SSL_version => 'TLSv1_2',
+	
+	); #or die "error=$!, ssl_error=$SSL_ERROR";
+
+	if ($cl) {
+		my $path;
+		if (! $url->{path}) {
+			$path = '' 
+		}
+		else {
+			$path = "$url->{path}";
+		}
+		
+		$current_url = "$url->{scheme}://$url->{host}/$path";
+
+		# ["absolute_url", "description"]
+		update_history( ["$url->{scheme}://$url->{host}/$path", "$url->{host}/$path"] );
+	
+		# gemini spec: <URL><CR><LF>
+		# <URL> is an absolute path
+		print $cl "$url->{scheme}://$url->{host}/$path\r\n";
+	
+		undef($doc);
+
+		while (<$cl>) {
+			$doc .= $_;
+		}
+		
+		get_links($doc);
+	
+		if ($doc_out) {
+			display($doc);
+		}
+	}
+	else {
+		TUI_Out("error=$!, ssl_error=$SSL_ERROR\n");
+	}
+}
+
+sub get_links {
+	undef(@links);
+	my ($doc) = @_;
+	#map(push(@links, $_), $doc =~ m/^=>[\s]*([\w\-\\\/\.\:\~\?\=]+)[\s]*(.+)?$/gm);
+	for my $line (split('\n', $doc)) {
+		if ($line =~ m/^=>[\s]*([\w\d\-\\\/\.\:\~\?\=\#]+)[\s]*(.+)?$/gm) {
+			if ($2) {
+				push(@links, ["$1", "$2"]);
+			}
+			else {
+				push(@links, ["$1", "$1"]);
+			}
+		}
+	}
+	## @links
+}
+
+sub hist {
+	my $hist;
+	my $counter = 1;
+	for my $item (@history) {
+		$hist .= "[$counter] $$item[0] $$item[1]\n";
+		#$hist .= "$$item[1][0]\n";
+		$counter++;
+	}
+	if ($hist) {
+		TUI_Out($hist);
+	}
+	else {
+		TUI_Out("\n");
+	}
+}
+
+sub update_history {
+	my ($history) = @_;
+	push(@history, $history);
+}
+
+sub links {
+	my $d;
+	my $counter = 1;
+	for my $item (@links) {
+		$d .= "[$counter] ". colored($$item[0], 'underline') . " $$item[1]\n";
+		$counter++;
+	}
+	if ($d) {
+		TUI_Out($d);
+	}
+	else {
+		TUI_Out("No links.\n");
+	}
+	0;
+}
+
+sub cwu {
+	TUI_Out("$current_url\n");
+	0;
+}
+
+sub nav {
+	# Setting 0: from links
+	# Setting 1: from history
+	my ($setting,$n) = @_;
+	$n -= 1;
+
+	### $n
+	### $setting
+	### @_
+	my $link;
+
+	if ($setting == 0) {
+		$link = $links[$n][0];
+	} elsif ($setting == 1) {
+		$link = $history[$n][0];
+	}
+
+	if (has_scheme($link)) {
+		url("$link");
+		0;
+	}
+	else {
+		url("$current_url$link");
+		0;
+	}
+}
+
+sub has_scheme {
+	print ($_[0]);
+	return ($_[0] =~ m|^.*(://)|);
+}
+
+sub root {
+	TUI_Out("Not implimented yet.");
+}
+
+sub back {
+	my ($display) = @_;
+
+	### @_
+	### $display
+	#
+	my $dok_out = $doc_out;
+
+	$doc_out = 0 if ($display == 1);
+
+	url("$history[-2][0]");
+	### @history
+
+	$doc_out = $dok_out if ($display == 1);
+}
+
+sub aaa {
+	TUI_Out("aaa\n");
+}
 
-# Global variables
-# ARGV[0]: gemini://website.com/request-path.gmi
-my $url = $ARGV[0];
-$url = parse_url($url);
+sub display {
+	if ($pager_text_wrap_auto) {
+		my ($wc) = GetTerminalSize();
+		$wrapper->columns($wc);
+	}
+	if ($use_pager) {
+		IO::Pager::open(my $FH) or warn($!);
+		print $FH $wrapper->wrap($doc);
+	}
+	else { 
+		TUI_Out($wrapper->wrap($doc));
+	}
+}
 
-my $cl = IO::Socket::SSL->new(
-	PeerHost => "$url->{host}",
-	PeerPort => '1965',
+sub toggle {
+	my ($t) = @_;
+	if ($t eq 'pager') {
+		set_toggle($use_pager);
+		print "$use_pager\n";
+	}
+}
 
-	SSL_verify_mode => SSL_VERIFY_NONE,
-	# will update version when support is better or
-	# when gemini removes TLSv1_2 as a supported version
-	SSL_version => 'TLSv1_2',
+sub set_toggle {
+	# refaliasing
+	\my $t = \$_[0];
+	if ($t == 1) {
+		$t = 0;
+	}
+	else {
+		$t = 1;
+	}
+}
 
-) or die "error=$!, ssl_error=$SSL_ERROR";
+sub textwrap {
+	my ($c) = @_;
+	if ($c and $c =~ m/^\d+$/) {
+		$wrapper->columns($c);
+		#$wchar = $c;
+		$pager_text_wrap_auto = 0;
+	} elsif ($c and $c eq 'auto') {
+		$pager_text_wrap_auto = 1;
+	}
+	else {
+		if ($pager_text_wrap_auto) {
+			my ($c) = GetTerminalSize();
+			TUI_Out("[AUTO] $c\n");
+		}
+		else {
+			TUI_Out("$wrapper->{columns}\n");
+		}
+	}
+}
 
-print $cl "$url->{scheme}://$url->{host}/$url->{path}\r\n";
-print <$cl>;
+sub pager {
+	my ($p) = @_;
+	if ($p) {
+		$ENV{pager} = $p;
+		0;
+	}
+	else {
+		TUI_Out("$ENV{pager}\n");
+	}
+}