view release on metacpan or  search on metacpan

lib/Bluesky.pm  view on Meta::CPAN

                    {
                    index    => { byteStart => $m->{start}, byteEnd => $m->{end} },
                    features => [ { '$type' => 'app.bsky.richtext.facet#link', uri => $m->{url} } ]
                    };
            }
            for my $m ( $self->parse_tags($text) ) {
                push @facets,
                    {
                    index    => { byteStart => $m->{start}, byteEnd => $m->{end} },
                    features => [ { '$type' => 'app.bsky.richtext.facet#tag', tag => $m->{tag} } ]
                    };
            }
            @facets;
        }

        method parse_uri($uri) {
            require At::Protocol::URI;    # Should already be loaded but...
            $uri = At::Protocol::URI->new($uri) unless builtin::blessed $uri;
            { repo => $uri->host, collection => $uri->collection, rkey => $uri->rkey };
        }

        method getReplyRefs($parent_uri) {
            my $res = $self->at->get( 'com.atproto.repo.getRecord', $self->parse_uri($parent_uri) );
            $res || return;
            my $root = my $parent = $res;
            if ( $parent->{value}{reply} ) {
                $root = $self->at->get( 'com.atproto.repo.getRecord', $self->parse_uri( $parent->{value}{reply}{root}{uri} ) );
                $res ||= $parent;    # escape hatch
            }
            { root => { uri => $root->{uri}, cid => $root->{cid} }, parent => { uri => $parent->{uri}, cid => $parent->{cid} } };
        }

        method uploadFile( $bytes, $mime_type //= undef ) {
            if    ( builtin::blessed $bytes ) { $bytes = $bytes->slurp_raw }
            elsif ( ( $^O eq 'MSWin32' ? $bytes !~ m/[\x00<>:"\/\\|?*]/ : 1 ) && -e $bytes ) {
                $bytes = path($bytes)->slurp_raw;
            }

            # TODO: a non-naive implementation would strip EXIF metadata from JPEG files here by default
            my $determined_mime
                = defined $mime_type ? $mime_type :
                ( $bytes =~ /^GIF89a/ ? 'image/gif' :
                    $bytes =~ /^.{2}JFIF/                                  ? 'image/jpeg' :
                    $bytes =~ /^.{4}PNG\r\n\x1a\n/                         ? 'image/png' :
                    $bytes =~ /^.{8}BM/                                    ? 'image/bmp' :
                    $bytes =~ /^.{4}(II|MM)\x42\x4D/                       ? 'image/tiff' :
                    $bytes =~ /^.{4}8BPS/                                  ? 'image/psd' :
                    $bytes =~ /^data:image\/svg\+xml;/                     ? 'image/svg+xml' :
                    $bytes =~ /^.{4}ftypqt /                               ? 'video/quicktime' :
                    $bytes =~ /^.{4}ftyp(isom|mp4[12]?|MSNV|M4[v|a]|f4v)/i ? 'video/mp4' :
                    'application/octet-stream' );
            my $at_http = $self->at->http;
            my $url     = sprintf( '%s/xrpc/%s', $self->at->host, 'com.atproto.repo.uploadBlob' );
            my %headers = ( 'Content-Type' => $determined_mime, ( $at_http->auth ? ( 'Authorization' => $at_http->auth ) : () ), );
            $headers{DPoP} = $at_http->_generate_dpop_proof( $url, 'POST' ) if $at_http->token_type eq 'DPoP';
            state $http //= HTTP::Tiny->new;
            my $res     = $http->post( $url, { content => $bytes, headers => \%headers } );
            my $content = $res->{content};

            if ( $res->{success} ) {
                $content = decode_json($content) if $content && ( $res->{headers}{'content-type'} // '' ) =~ m[json];
                return $content->{blob};
            }
            my $msg = $res->{reason} // 'Unknown error';
            if ( $content && ( $res->{headers}{'content-type'} // '' ) =~ m[json] ) {
                my $json = decode_json($content);
                $msg .= ': ' . $json->{message} if $json->{message};
            }
            return At::Error->new( message => $msg, fatal => 1 );
        }

        method uploadImages(@images) {
            my @ret;
            for my $img (@images) {
                my $alt  = '';
                my $mime = ();
                if ( ( builtin::reftype($img) // '' ) eq 'HASH' ) {
                    $alt  = $img->{alt};
                    $mime = $img->{mime} // ();
                    $img  = $img->{image};
                }
                if ( builtin::blessed $img ) {
                    At::Error->new( message => 'image file size too large. 1000000 bytes maximum, got: ' . $img->size )->throw
                        if $img->size > 1000000;
                    $img = $img->slurp_raw;
                }
                elsif ( ( $^O eq 'MSWin32' ? $img !~ m/[\x00<>:"\/\\|?*]/ : 1 ) && -e $img ) {
                    $img = path($img);
                    At::Error->new( message => 'image file size too large. 1000000 bytes maximum, got: ' . $img->size )->throw
                        if $img->size > 1000000;
                    $img = path($img)->slurp_raw;
                }
                else {
                    At::Error->new( message => 'image file size too large. 1000000 bytes maximum, got: ' . length $img )->throw
                        if length $img > 1000000;
                }
                my $blob = $self->uploadFile( $img, $mime );
                $blob || $blob->throw;
                push @ret, { alt => $alt, image => $blob };
            }
            { '$type' => 'app.bsky.embed.images', images => \@ret };
        }

        method uploadVideoCaption( $lang, $caption ) {
            if ( builtin::blessed $caption ) {
                At::Error->new( message => 'caption file size too large. 20000 bytes maximum, got: ' . $caption->size )->throw
                    if $caption->size > 20000;
                $caption = $caption->slurp_raw;
            }
            elsif ( ( $^O eq 'MSWin32' ? $caption !~ m/[\x00<>:"\/\\|?*]/ : 1 ) && -e $caption ) {
                $caption = path($caption);
                At::Error->new( message => 'caption file size too large. 20000 bytes maximum, got: ' . $caption->size )->throw
                    if $caption->size > 20000;
                $caption = path($caption)->slurp_raw;
            }
            else {
                At::Error->new( message => 'cation file size too large. 20000 bytes maximum, got: ' . length $caption )->throw
                    if length $caption > 20000;
            }
            my $blob = $self->uploadFile( $caption, 'text/vtt' );
            $blob || $blob->throw;
            { '$type' => 'app.bsky.embed.video#caption', lang => $lang, file => $blob };
        }

        method uploadVideo($vid) {
            my @ret;
            my ( $alt, $mime, $aspectRatio );
            my @captions;
            if ( ( builtin::reftype($vid) // '' ) eq 'HASH' ) {
                $alt         = $vid->{alt};
                $mime        = $vid->{mime} // ();
                $aspectRatio = $vid->{aspectRatio};
                @captions    = map { { lang => $_, file => $self->uploadFile( $vid->{captions}{$_}, 'text/vtt' ) } } keys %{ $vid->{captions} };
                $vid         = $vid->{video};
            }
            if ( builtin::blessed $vid ) {
                At::Error->new( message => 'video file size too large. 50000000 bytes maximum, got: ' . $vid->size )->throw if $vid->size > 50000000;
                $vid = $vid->slurp_raw;
            }
            elsif ( ( $^O eq 'MSWin32' ? $vid !~ m/[\x00<>:"\/\\|?*]/ : 1 ) && -e $vid ) {
                $vid = path($vid);
                At::Error->new( message => 'video file size too large. 50000000 bytes maximum, got: ' . $vid->size )->throw if $vid->size > 50000000;
                $vid = path($vid)->slurp_raw;
            }
            else {
                At::Error->new( message => 'video file size too large. 50000000 bytes maximum, got: ' . length $vid )->throw
                    if length $vid > 50000000;
            }
            my $blob = $self->uploadFile( $vid, $mime );
            $blob || return $blob->throw;
            return {
                '$type' => 'app.bsky.embed.video',
                video   => $blob,
                ( @captions            ? ( captions    => \@captions )   : () ), ( defined $alt ? ( alt => $alt ) : () ),
                ( defined $aspectRatio ? ( aspectRatio => $aspectRatio ) : () )
            };
        }

        method getEmbedRef($uri) {
            my $res = $self->at->get( 'com.atproto.repo.getRecord', $self->parse_uri($uri) );
            $res || return;
            { '$type' => 'app.bsky.embed.record', record => { uri => $res->{uri}, cid => $res->{cid} } };
        }

        method fetch_embed_url_card($url) {
            my %card = ( uri => $url, title => '', description => '' );
            state $http //= HTTP::Tiny->new;
            my $res = $http->get($url);
            if ( $res->{success} ) {
                ( $card{title} )       = $res->{content} =~ m[<title>(.*?)</title>.*</head>]is;
                ( $card{description} ) = ( $res->{content} =~ m[<meta name="description" content="(.*?)".+</meta>.*</head>]is ) // '';
                my ($image) = $res->{content} =~ m[<img.*?src="([^"]*)"[^>]*>(?:</img>)?]isp;
                if ( defined $image ) {
                    if ( $image =~ /^data:/ ) {
                        $card{thumb} = $self->uploadFile($image);
                    }
                    else {
                        $res = $http->get( URI->new_abs( $image, $url ) );
                        $card{thumb} = $res->{success} ? $self->uploadFile( $res->{content}, $res->{headers}{'content-type'} ) : ();
                    }
                }
            }
            { '$type' => 'app.bsky.embed.external', external => \%card };
        }
    }
};
#
1;