diff options
| -rwxr-xr-x | gmi.pl | 327 |
1 files changed, 311 insertions, 16 deletions
@@ -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"); + } +} |