CPAN::Groonga

package SMS::API::VoIP::MS;

use 5.006;
use strict;
use warnings;

use Mo qw( build default required is );

use URI;
use URI::QueryParam;

use Date::Parse;

use Image::Magick;

use LWP::UserAgent;

use Cpanel::JSON::XS;

use Scalar::Util qw( openhandle );

use MIME::Base64 qw( encode_base64 );

use Unicode::LineBreak;

use POSIX qw( strftime );

=head1 NAME

SMS::API::VoIP::MS - VoIP.ms SMS client with MMS support.

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

A simple module that attempts to implement the SMS/MMS portion of VoIP.ms's
API.

    use SMS::API::VoIP::MS;

    my $sms = SMS::API::VoIP::MS->new(
        # Required
        username => 'john.doe@test.com',
        api_key  => 'abcd1234',

        # Optional; you can set it as a 'from' parameter when sending
        # messages.  Or it'll use the only one you have if you only have 1 DID
        # with SMS enabled.
        did      => '1231231234',

        # Optional.  Default is 0, which will split texts > 160 chars into
        # multiples.
        convert_long_sms_to_mms => 1,
    );

    $sms->send_sms(
        did => 1231231234,
        to  => '1231231235',
        'This is a message!',
    );

    $sms->send_mms(
        to         => '1231231235',
        attachment => $io,
        'This is also a message!',
    );

=head1 SUBROUTINES/METHODS

=head2 new

Method that constructs your SMS object.  This method will contact VoIP.ms and
verify the DID provided is in fact available to perform messaging.  Failures
will die, so use try/catch if you want to fail gracefully.

=cut

has username => (
    is       => 'ro',
    required => 1,
);

has did => ();

has api_key => (
    is       => 'ro',
    required => 1,
);

has _available_dids => ();

has _lwp => (
    default => sub {
        LWP::UserAgent->new(
            ssl_opts => { verify_hostname => 1 },

            # Someone at VoIP.ms told Cloudflare to block libwww-perl, which
            # is idiotic.
            agent    => q{},
        )
    },
);

has _json_parser => (
    default => sub { Cpanel::JSON::XS->new }
);

has convert_long_sms_to_mms => (
    is      => 'ro',
    default => sub { 0 },
);

=head2 BUILD

Gets the DIDs that have SMS enabled, verifies the one provided (if any) is
available.

=cut

sub BUILD {
    my ( $self ) = @_;

    $self->did( $self->_sanitise_number( $self->did ) ) if $self->did;

    $self->_populate_sms_dids;

    if ( my $num = $self->did ) {
        $self->did( $num );

        die $self->did
          . " either isn't your DID, or doesn't have SMS available.\n"
          if !$self->_available_dids->{ $self->did };
    }
}

=head2 _sanitise_number

Just regexes to delete non digits, and leading 1s (yes, this makes it
NA-centric.  I'm sorry.)

=cut

sub _sanitise_number {
    my ( $self, $number ) = @_;

    $number =~ tr/0-9//cd;
    $number =~ s/^1//;

    return $number;
}

=head2 _get_method

Wrapper for calling API methods with GET

=cut

sub _get_method  {
    my ( $self, $method, %parameters ) = @_;

    return $self->_parse_result(
        $self->_lwp->get( $self->_get_uri( $method, %parameters ) ),
        $method,
    );
}
    
=head2 _post_method

Wrapper for calling API methods with POST.  We also specify form-data, because
VOIP.ms doesn't seem to like www encoded data in POSTs.

=cut

sub _post_method {
    my ( $self, $method, %parameters ) = @_;

    return $self->_parse_result(
        $self->_lwp->post(
            $self->_api_url,
            Content_Type => 'form-data',
            Content      => [
                $self->_default_params( $method ),

                %parameters,
            ],
        ),
        $method
    );
}

=head2 _parse_result

Does error handling, decodes JSON.

=cut

sub _parse_result {
    my ( $self, $res, $method ) = @_;

    if ( !$res->is_success ) {
        warn $res->request->as_string;

        die "Failed calling $method: (" . $res->status_line . ") "
          .  $res->content;
    }

    my $json = $self->_json_parser->decode( $res->decoded_content );

    if ( $json->{ status } ne 'success' ) {
        warn $res->request->as_string;
    }

    die "$method call failed: " . $json->{ status }
        if exists $json->{ status }
        && $json->{ status } ne 'success';

    return $json;
}

=head2 _default_params

Just a quick utility to put the username, api_key, and method into every call.

=cut

sub _default_params {
    my ( $self, $method ) = @_;

    (
        api_username => $self->username,
        api_password => $self->api_key,
        method       => $method,
    )
};

=head2 _api_url

Pretty self-explanatory.

=cut

sub _api_url { 'https://voip.ms/api/v1/rest.php' }

=head2 _get_uri

Assembles the URI for doing a GET call.

=cut

sub _get_uri {
    my ( $self, $method, %params ) = @_;

    my $uri = URI->new( $self->_api_url );

    $uri->query_param( $_ => $params{ $_ } ) for keys %params;

    my %default_params = $self->_default_params( $method );

    $uri->query_param( $_ => $default_params{ $_ } ) for keys %default_params;

    return $uri->canonical;
}

=head2 _populate_sms_dids

Parses out the available DIDs on this account with SMS enabled.

Dies if there aren't any because we can't really do much without one.

=cut

sub _populate_sms_dids {
    my ( $self ) = @_;

    my $result = $self->_get_method( 'getDIDsInfo' );

    my @dids = grep { $_->{ sms_enabled } } @{ $result->{ dids } };

    die "You don't have any DIDs with SMS enabled!\n" if !@dids;

    $self->_available_dids({ map {( $_->{ did } => 1 )} @dids });
}

=head2 _get_sms_did

Gets an SMS DID by: verifying if you provided one that it has SMS enabled, or
returning the default if you only have one phone number with SMS enabled.

Otherwise, dies.

=cut

sub _get_sms_did {
    my ( $self, $from ) = @_;

    $from //= $self->did;

    die "You have more than one SMS enabled DID and didn't specify a "
      . "from address!\n" if !$from && scalar keys %{ $self->_available_dids } > 1;

    $from //= @{ $self->_available_dids }[0];

    die "Messages cannot be sent from $from!\n" if
        !$self->_available_dids->{ $from };

    return $from;
}

=head2 _wrap_text

I ran into some issues with line breaks, and character encoding, and text
message limits with voip.ms's systems because it looks like they may have some
encoding/escaping bugs, so this may still get punched in the mouth, but the
idea here is to do line breaks for messages that are too long in a sensible
way and understand other character encodings in the process.

YMMV for obvious reasons.

=cut

sub _wrap_text {
    my ( $self, $text, $cols ) = @_;

    return ( $text ) if length( $text ) <= $cols;

    my $sep = chr( 29 );
    $text =~ s/\r?\n/ $sep/g;

    my $lb = Unicode::LineBreak->new(
        CharMax => $cols,
        ColMin  => 1,
        ColMax  => $cols,
        Format  => 'TRIM',
        Newline => "\0",
    );

    my $broken = $lb->break( $text );

    $broken =~ s/ $sep/\n/g;

    return map { s/\n$//; $_ } split m{\0}, $broken;
}

=head2 send_sms
=head2 send_mms
=head2 _send_text

Sends an SMS message to a number.  Expects a hash of parameters, and then the
message.

Acceptable parameters are:

=over 3

=item did

This is the DID to send the message from.  If one isn't specified, we'll use
the DID specified in ->new.  If that wasn't specified, but you only have one
SMS enabled DID in your VOIP account, we'll use that.  If you have multiple,
we'll die.

=item to

The number we're sending the message to.

=item media\d+

Any images being attached to the message.  This will guarantee MMS instead of
SMS.

=back

=cut

sub send_sms { shift->_send_text( sms => @_ ) }

sub send_mms { shift->_send_text( mms => @_ ) }

sub _send_text {
    my $self = shift;
    my $type = shift;

    my $method = 'send' . uc( $type );

    die "Incorrect usage of $method!\n" if !( @_ % 2 );

    my $message = pop;

    my %params = @_;

    if ( length( $message ) > 160 ) {
        if ( $self->convert_long_sms_to_mms ) {
            $method = 'sendMMS';
        }
        else {
            die "Message is > 160 characters and automatic MMS conversion is disabled.";
        }
    }

    $params{ did } = $self->_get_sms_did( delete $params{ did } );
    die "You need to specify the from DID!\n" if !defined $params{ did };

    $params{ dst } = delete $params{ to };
    die "You didn't specify a to address!\n" if !defined $params{ dst };

    my @msgs = $self->_wrap_text( $message, 160 );

    foreach my $media_key ( grep { m{^media(\d+)} } keys %params ) {
        $method = 'sendMMS';

        my $file = $params{ $media_key };

        if ( !openhandle( $file ) ) {
            if ( -f $file && -r _ && -s _ ) {
                open my $fh, '<', $file or die "can't open $file: $!";

                $file = $fh;
            }
            else {
                # TODO -- handle URLs?
                die "I don't know what to do with $file.";
            }
        }
        
        my $magick = Image::Magick->new;

        binmode $file;

        $magick->read( file => $file );
        $magick->Strip();
        $magick->set( magick => 'jpg' );
        $magick->set( quality => 90 );

        my $base_encoded = encode_base64(
            join q{}, $magick->imagetoblob
        );

        $base_encoded =~ s/\r\n//g;

        $params{ $media_key } = "data:image/jpeg;base64,$base_encoded";
    }

    $self->_post_method(
        $method => (
            %params,

            message => $_,
        )
    ) for @msgs;
}

=head2 get_sms

Just a goto to get_mms because get_mms can get SMSes too (and we tell it to).

=cut

sub get_sms { goto &get_mms }

=head2 get_mms

Gets MMS messages.  You have to specify the did and the from date, but you can
optionally specify any other parameter voip.ms supports.

We by default ask for received (type 1), sms *and* mms (all_messages 1), and
(effectively) no limit.  You can override these, though.

=cut

sub get_mms {
    my ( $self, %params ) = @_;

    $params{ did } = $self->_get_sms_did( delete $params{ did } );
    die "You need to specify the DID to search!\n" if !defined $params{ did };

    die "You need to specify the earliest search date!"
        if !defined $params{ from };

    my $date_parse = sub {
        my $parsed = Date::Parse::str2time( $_[0] );

        die "Couldn't parse a from date of $_[0]!" if !$parsed;

        return strftime( '%Y-%m-%dT%H:%M:%S%z', localtime $parsed );
    };

    $params{ from } = $date_parse->( $params{ from } );
    $params{ to   } = $date_parse->( $params{ to } ) if $params{ to };

    $self->_post_method( getMMS => (
        type         => 1,
        all_messages => 1,
        limit        => 999999,

        %params,
    ));
}

=head1 AUTHOR

Justin Wheeler, C<< <cpan at datademons.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-sms-voip-ms at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=SMS-API-VoIP-MS>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SMS::API::VoIP::MS

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=SMS-API-VoIP-MS>

=item * CPAN Ratings

L<https://cpanratings.perl.org/d/SMS-API-VoIP-MS>

=item * Search CPAN

L<https://metacpan.org/release/SMS-API-VoIP-MS>

=back

=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2022 by Justin Wheeler.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)


=cut

1; # End of SMS::API::VoIP::MS