#!/usr/bin/perl
#
# 0wx.pl -- a command line client for the 0wx API.
#
#     ./0wx.pl <action> [--parameter value ...]
#     ./0wx.pl help
#
# Like the shell and Python clients, this is meant to be read before it is
# run. It uses only core modules -- HTTP::Tiny and JSON::PP have shipped with
# Perl since 5.14, so there is nothing to install and nothing to trust beyond
# your own Perl.
#
# It parses the reply and prints what the fields mean; --json gives the raw
# form back. If you are writing your own client, send() and report() are the
# parts worth reading: between them they show how to build a request, how a
# failed one differs from a failed connection, and what the replies contain.

use strict;
use warnings;

use HTTP::Tiny ();
use JSON::PP   ();
use File::Basename qw(basename);

# ---------------------------------------------------------------------------
# Settings
# ---------------------------------------------------------------------------
# Either may come from the environment, which keeps the key out of your
# shell history:
#
#     export OWX_KEY=...
#     ./0wx.pl listfiles
#
my $DEFAULT_URL = 'https://0wx.es/api.cgi';

# Parameters that may be given more than once. Everything else is a single
# value, and repeating it is a mistake worth reporting rather than silently
# keeping the last one.
my %REPEATABLE = map { $_ => 1 } qw(file share g otl);

# Column headings, kept beside the row formatter in describe() because the
# widths have to match between them.
my %HEADINGS = (
    files     => sprintf( '%-10s %10s  %-24s %s', 'SHARE', 'SIZE', 'TYPE', 'NAME' ),
    pastes    => sprintf( '%-10s %10s  %s',       'SHARE', 'SIZE', 'PREVIEW' ),
    urls      => sprintf( '%-10s %-8s %s',        'SHARE', 'KIND', 'TARGET' ),
    galleries => sprintf( '%-6s %-24s %10s  %s',  'ID', 'NAME', 'FILES', 'STATE' ),
    otl       => sprintf( '%-10s    %-10s %s',    'LINK', 'FILE', 'NAME' ),
);

sub usage {
    print <<"EOF";
0wx.pl -- command line client for the 0wx API

USAGE
    ./0wx.pl <action> [--parameter value ...]
    ./0wx.pl help

SETTINGS
    OWX_URL   API endpoint   (default $DEFAULT_URL)
    OWX_KEY   your API key   (generate one on your account page)

    Both can also be given as --url and --key. Using the environment keeps
    the key out of your shell history.

NO KEY NEEDED
    whoami                                  check a key, read the limits
    ip                                      how your address looks from here
    tinyurl   --url URL                     shorten a URL
    hugeurl   --url URL                     lengthen a URL, absurdly
    paste     --content TEXT                store text, get a link
    translate --content TEXT --to LANG      translate text
    upload    --file PATH                   upload a file

KEY NEEDED
    listfiles     [--page N] [--g ID]       your files; --g none = ungrouped
    listpastes    [--page N]                your pastes
    listurls      [--page N]                your short and huge URLs
    listgalleries                           your galleries
    listotl       [--page N]                your one-time links

    upload    --file PATH --gallery NAME    upload into a gallery
    otl       --share SHARE                 mint a one-time link
    move      --share SHARE --gallery NAME  move files into a gallery
    move      --share SHARE                 move them back out
    gallery   --g ID --publish true|false   publish or withdraw a gallery
    delete    --share SHARE                 delete files, pastes or URLs
    delete    --g ID [--withfiles true]     delete a gallery
    delete    --otl TOKEN                   kill a one-time link

REPEATING A PARAMETER
    --file, --share, --g and --otl may be given more than once:

        ./0wx.pl delete --share Ab3xK9pQ --share Zz7yT2mN
        ./0wx.pl upload --file one.png --file two.png

OUTPUT
    The reply is summarised in plain text. Add --json for the raw JSON,
    which is what you want when piping this into something else.

EXAMPLES
    ./0wx.pl paste --content 'hello & world'
    ./0wx.pl upload --file holiday.jpg --gallery 'Holiday 2026'
    ./0wx.pl listfiles --page 2
    ./0wx.pl gallery --g 7 --publish true --json
EOF
}

sub die_with {
    my ($message) = @_;
    print STDERR "0wx.pl: $message\n";
    exit 1;
}

# ---------------------------------------------------------------------------
# Sizes
# ---------------------------------------------------------------------------
# Binary units, matching OWX::Util::human_bytes on the server: a listing
# saying "2.0 MB" where the file page says "1.9 MiB" would look like two
# different files.
sub human_bytes {
    my ($n) = @_;
    return '?' unless defined $n && $n =~ /^\d+$/;
    return '0 B' unless $n > 0;

    my @unit = qw(B KiB MiB GiB TiB);
    my ( $v, $i ) = ( $n, 0 );
    while ( $v >= 1024 && $i < $#unit ) { $v /= 1024; $i++ }

    return $i == 0 ? "$n B" : sprintf( '%.1f %s', $v, $unit[$i] );
}

# ---------------------------------------------------------------------------
# Reading the command line
# ---------------------------------------------------------------------------
# Getopt is not used on purpose: the parameters are whatever the API takes,
# and declaring them here as well as in the documentation is how the two
# drift apart. Anything --name value is passed straight through, so a
# parameter added to the API works without touching this script.
sub parse_args {
    my (@argv) = @_;

    usage(), exit 0 unless @argv;

    my $action = shift @argv;
    usage(), exit 0 if $action eq 'help' || $action eq '--help' || $action eq '-h';

    die_with("the first argument must be an action, not '$action'."
           . ' Try: ./0wx.pl help')
        if $action =~ /^-/;

    my %fields;
    my @files;
    my $url = $ENV{OWX_URL} // $DEFAULT_URL;
    my $key = $ENV{OWX_KEY} // '';

    while (@argv) {
        my $name = shift @argv;
        die_with("unexpected argument '$name'."
               . ' Parameters look like --name value.')
            unless $name =~ /^--/;

        die_with("$name needs a value") unless @argv;
        my $value = shift @argv;
        $name =~ s/^--//;

        if    ( $name eq 'url' )  { $url = $value }
        elsif ( $name eq 'key' )  { $key = $value }
        elsif ( $name eq 'file' ) { push @files, $value }
        else {
            die_with("--$name was given twice, and only one value is used")
                if exists $fields{$name} && !$REPEATABLE{$name};
            push @{ $fields{$name} }, $value;
        }
    }

    return ( $action, \%fields, \@files, $url, $key );
}

# ---------------------------------------------------------------------------
# Building the request
# ---------------------------------------------------------------------------
# HTTP::Tiny has no multipart builder, so here is one. A body is a sequence
# of parts, each introduced by a boundary line, and the boundary is any
# string that does not appear in the data.
sub multipart {
    my ( $fields, $files ) = @_;

    my $boundary = '----0wx' . unpack( 'H*', join '', map { chr int rand 256 } 1 .. 16 );
    my $body     = '';

    for my $name ( sort keys %$fields ) {
        for my $value ( @{ $fields->{$name} } ) {
            $body .= "--$boundary\r\n"
                   . qq(Content-Disposition: form-data; name="$name"\r\n\r\n)
                   . "$value\r\n";
        }
    }

    for my $path (@$files) {
        open my $fh, '<:raw', $path
            or die_with("cannot read $path: $!");
        my $blob = do { local $/; <$fh> };
        close $fh;

        ( my $name = basename($path) ) =~ s/"//g;

        $body .= "--$boundary\r\n"
               . qq(Content-Disposition: form-data; name="file"; filename="$name"\r\n)
               . "Content-Type: application/octet-stream\r\n\r\n"
               . $blob . "\r\n";
    }

    $body .= "--$boundary--\r\n";
    return ( $body, "multipart/form-data; boundary=$boundary" );
}

# Percent-encode a value for a form body. Everything is encoded, not only
# what looks risky: the server splits fields on "&", so one unencoded
# ampersand in a paste would arrive as two fields and truncate it.
sub form_escape {
    my ($s) = @_;
    $s = '' unless defined $s;
    utf8::encode($s) if utf8::is_utf8($s);
    $s =~ s/([^A-Za-z0-9._~-])/sprintf '%%%02X', ord $1/ge;
    return $s;
}

sub send_request {
    my ( $action, $fields, $files, $url, $key ) = @_;

    my %all = ( %$fields, action => [$action] );

    my ( $body, $type );
    if (@$files) {
        ( $body, $type ) = multipart( \%all, $files );
    }
    else {
        $body = join '&', map {
            my $name = $_;
            map { form_escape($name) . '=' . form_escape($_) } @{ $all{$name} };
        } sort keys %all;
        $type = 'application/x-www-form-urlencoded';
    }

    my %headers = ( 'Content-Type' => $type );
    $headers{Authorization} = "Bearer $key" if length $key;

    my $res = HTTP::Tiny->new( agent => '0wx.pl' )
        ->request( 'POST', $url, { content => $body, headers => \%headers } );

    # HTTP::Tiny does not die on a failed request -- unlike Python's urllib,
    # which raises. It reports everything through the returned hash, and the
    # trap is at the other end: a connection failure comes back as status
    # 599, which is NOT a real HTTP status. It is HTTP::Tiny's marker for
    # "never got an answer", and its content is a plain-text message.
    #
    # A client that treats every status alike will try to JSON-decode
    # "Could not connect to ..." and report a parse error instead of the
    # connection failure.
    if ( $res->{status} == 599 ) {
        my $why = $res->{content} // $res->{reason} // 'unknown error';
        $why =~ s/\s+$//;
        die_with("could not reach $url: $why");
    }

    # Any other status carries a real reply. The API answers its own errors
    # with 400, 401, 404 or 413 and a JSON body saying what went wrong, so
    # the body is worth decoding whatever the status.
    my $data = eval { JSON::PP->new->utf8->decode( $res->{content} ) };
    unless ( ref $data eq 'HASH' ) {
        my $seen = $res->{content} // '';
        $seen = substr( $seen, 0, 500 );
        die_with("the server did not return JSON:\n$seen");
    }

    return $data;
}

# ---------------------------------------------------------------------------
# Reading the reply
# ---------------------------------------------------------------------------
# Every reply has an "ok" field. When it is false there is a stable "error"
# code to branch on and a "message" for a human -- so a script reads the
# code and a person reads the message.
#
# Fields are read with a default throughout. A reply from a newer server may
# carry fields this script does not know, and one from a proxy may be
# missing fields it expects; neither is a reason to die.
sub at {
    my ( $row, $name, $fallback ) = @_;
    $fallback = '?' unless defined $fallback;
    my $v = $row->{$name};
    return ( defined $v && $v ne '' ) ? $v : $fallback;
}

sub report {
    my ($data) = @_;

    unless ( $data->{ok} ) {
        print STDERR 'error: ' . at( $data, 'error', 'unknown' ) . "\n";
        print STDERR at( $data, 'message', '' ) . "\n";
        return 1;
    }

    my $kind = $data->{type} // '';

    if ( $kind eq 'upload' ) {
        printf "%s  %s\n", at( $_, 'url' ), at( $_, 'name' )
            for @{ $data->{files} || [] };
        printf STDERR "rejected: %s (%s)\n", at( $_, 'name' ), at( $_, 'error' )
            for @{ $data->{rejected} || [] };
        printf "in gallery %s\n", at( $data, 'gallery_id' )
            if defined $data->{gallery_id};
    }
    elsif ( $kind eq 'tinyurl' || $kind eq 'hugeurl' || $kind eq 'paste' ) {
        print at( $data, 'url' ) . "\n";
    }
    elsif ( $kind eq 'otl' && !ref $data->{otl} ) {
        print at( $data, 'url' ) . "\n";
    }
    elsif ( exists $HEADINGS{$kind} ) {
        my $rows = $data->{$kind} || $data->{otl} || [];

        # Only when there is something to head: a heading over an empty
        # listing reads as a failure to fetch rather than an empty account.
        if (@$rows) {
            print "$HEADINGS{$kind}\n";
            print describe( $kind, $_ ) . "\n" for @$rows;
        }
        else {
            print "(nothing here)\n";
        }

        printf "page %s of %s\n", at( $data, 'page' ), at( $data, 'pages' )
            if ( $data->{pages} // 1 ) > 1;
    }
    elsif ( $kind eq 'gallery' ) {
        printf "%s  %s\n", at( $data, 'name' ),
            $data->{published} ? at( $data, 'url' ) : '(private)';
    }
    elsif ( $kind eq 'move' ) {
        printf "moved %s of %s\n", at( $data, 'moved', 0 ),
            at( $data, 'requested', 0 );
    }
    elsif ( $kind eq 'delete' ) {
        printf "deleted %s file(s), %s link(s), %s gallery(s), %s one-time link(s)\n",
            at( $data, 'files', 0 ), at( $data, 'links', 0 ),
            at( $data, 'galleries', 0 ), at( $data, 'otl', 0 );
    }
    elsif ( $kind eq 'translate' ) {
        print at( $data, 'text' ) . "\n";
    }
    else {
        # whoami, ip, and anything added to the API after this was written.
        # Printing the fields is more useful than saying nothing.
        for my $name ( sort keys %$data ) {
            next if $name eq 'ok' || $name eq 'type';
            next if ref $data->{$name};
            # at(), not the value directly. A JSON null decodes to undef,
            # and printf warns on it under "use warnings" -- so a reply with
            # an empty field printed a warning per field, which is noise a
            # user cannot act on. "ip" alone can carry several nulls when
            # the geolocation database has no entry for an address.
            printf "%-14s %s\n", $name, at( $data, $name, '-' );
        }
    }

    return 0;
}

sub describe {
    my ( $kind, $row ) = @_;

    return sprintf '%-10s %10s  %-24s %s',
        at( $row, 'share' ), human_bytes( $row->{bytes} ),
        at( $row, 'mime' ), at( $row, 'name' )
        if $kind eq 'files';

    if ( $kind eq 'pastes' ) {
        my $preview = $row->{preview} // '';
        $preview =~ s/\n/ /g;
        $preview = substr( $preview, 0, 40 );
        return sprintf '%-10s %10s  %s',
            at( $row, 'share' ), human_bytes( $row->{bytes} ), $preview;
    }

    return sprintf '%-10s %-8s %s',
        at( $row, 'share' ), at( $row, 'kind' ), at( $row, 'target' )
        if $kind eq 'urls';

    return sprintf '%-6s %-24s %10s  %s',
        at( $row, 'id' ), at( $row, 'name' ), at( $row, 'files', 0 ),
        ( $row->{published} ? at( $row, 'url' ) : 'private' )
        if $kind eq 'galleries';

    return sprintf '%-10s -> %-10s %s%s',
        at( $row, 'otl' ), at( $row, 'share' ), at( $row, 'name' ),
        ( $row->{expired} ? '  (file expired)' : '' )
        if $kind eq 'otl';

    return join ' ', map {"$_=" . at( $row, $_ )} sort keys %$row;
}

# ---------------------------------------------------------------------------
# Main
# ---------------------------------------------------------------------------
my @argv = @ARGV;
my $raw  = grep { $_ eq '--json' } @argv;
@argv = grep { $_ ne '--json' } @argv;

my ( $action, $fields, $files, $url, $key ) = parse_args(@argv);
my $data = send_request( $action, $fields, $files, $url, $key );

if ($raw) {
    binmode STDOUT, ':encoding(UTF-8)';
    print JSON::PP->new->pretty->canonical->encode($data);
    exit( $data->{ok} ? 0 : 1 );
}

binmode STDOUT, ':encoding(UTF-8)';
binmode STDERR, ':encoding(UTF-8)';
exit report($data);