Bluesky
view release on metacpan or search on metacpan
lib/Bluesky.pm view on Meta::CPAN
$self->_at_for('app.bsky.bookmark.deleteBookmark')->post( 'app.bsky.bookmark.deleteBookmark' => { uri => $uri } );
}
method getQuotes(%args) {
my $res = $self->_at_for('app.bsky.feed.getQuotes')->get( 'app.bsky.feed.getQuotes' => \%args );
$res ? $res->{quotes} // () : $res;
}
method getActorLikes(%args) {
my $res = $self->_at_for('app.bsky.feed.getActorLikes')->get( 'app.bsky.feed.getActorLikes' => \%args );
$res ? $res->{feed} // () : $res;
}
method searchPosts(%args) {
my $res = $self->_at_for('app.bsky.feed.searchPosts')->get( 'app.bsky.feed.searchPosts' => \%args );
$res ? $res->{posts} // () : $res;
}
method getSuggestedFeeds(%args) {
my $res = $self->_at_for('app.bsky.feed.getSuggestedFeeds')->get( 'app.bsky.feed.getSuggestedFeeds' => \%args );
$res ? $res->{feeds} // () : $res;
}
method describeFeedGenerator() { $self->_at_for('app.bsky.feed.describeFeedGenerator')->get('app.bsky.feed.describeFeedGenerator') }
method getFeedGenerator($generator) {
$self->_at_for('app.bsky.feed.getFeedGenerator')->get( 'app.bsky.feed.getFeedGenerator' => { feed => $generator } );
}
method getFeedGenerators(%args) {
my $res = $self->_at_for('app.bsky.feed.getFeedGenerators')->get( 'app.bsky.feed.getFeedGenerators' => \%args );
$res ? $res->{feeds} // () : $res;
}
method getActorFeeds(%args) {
my $res = $self->_at_for('app.bsky.feed.getActorFeeds')->get( 'app.bsky.feed.getActorFeeds' => \%args );
$res ? $res->{feeds} // () : $res;
}
method getRepostedBy(%args) {
my $res = $self->_at_for('app.bsky.feed.getRepostedBy')->get( 'app.bsky.feed.getRepostedBy' => \%args );
$res ? $res->{repostedBy} // () : $res;
}
method repost( $uri, $cid //= () ) {
if ( !defined $cid ) {
my $post = $self->_at_for('app.bsky.feed.getPosts')->get( 'app.bsky.feed.getPosts' => { uris => [$uri] } );
$post || $post->throw;
$cid = $post->{posts}[0]{cid};
}
$self->at->create_record( 'app.bsky.feed.repost', { subject => { uri => $uri, cid => $cid }, createdAt => $self->at->_now->to_string } );
}
method deleteRepost($url) {
$url = At::Protocol::URI->new($url) unless builtin::blessed $url;
if ( $url->collection eq 'app.bsky.feed.post' ) {
my $post = $self->getPost($url);
$url = $post->{viewer}{repost} // return;
}
$self->at->delete_record( 'app.bsky.feed.repost', $url->rkey );
}
method uploadBlob( $data, %opts ) { $self->at->upload_blob( $data, $opts{mime_type} // () ) }
method createPost(%args) {
# TODO:
# - recordWithMedia embed
#
my %post = ( # these are the required fields which every post must include
'$type' => 'app.bsky.feed.post',
text => $args{text} // '',
createdAt => $args{timestamp} // $self->at->_now->to_string # trailing "Z" is preferred over "+00:00"
);
# indicate included languages (optional)
$post{langs} = [ ( ( builtin::reftype( $args{lang} ) // '' ) eq 'ARRAY' ) ? @{ $args{lang} } : $args{lang} ] if defined $args{lang};
# parse out mentions and URLs as "facets"
if ( length $post{text} > 0 ) {
my @facets = $self->parse_facets( $post{text} );
$post{facets} = \@facets if @facets;
}
# additional tags (up to 8)
$post{tags} = [ ( builtin::reftype( $args{tags} ) // '' ) eq 'ARRAY' ? @{ $args{tags} } : $args{tags} ] if defined $args{tags};
# metadata tags on an atproto record, published by the author within the record (up to 10)
$post{labels} = {
'$type' => 'com.atproto.label.defs#selfLabels',
values => [
map { { '$type' => 'com.atproto.label.defs#selfLabel', val => $_ } }
( ( builtin::reftype( $args{labels} ) // '' ) eq 'ARRAY' ? @{ $args{labels} } : $args{labels} )
]
}
if defined $args{labels};
#~ com.atproto.label.defs#selfLabels
# if this is a reply, get references to the parent and root
$post{reply} = $self->getReplyRefs( $args{reply_to} ) if defined $args{reply_to};
# embeds
if ( defined $args{embed} ) {
if ( defined $args{embed}{images} ) {
$post{embed} = $self->uploadImages( @{ $args{embed}{images} } );
}
elsif ( defined $args{embed}{video} ) {
$post{embed} = $self->uploadVideo( $args{embed}{video} );
}
elsif ( defined $args{embed}{url} ) {
$post{embed} = $self->fetch_embed_url_card( $args{embed}{url} );
}
elsif ( defined $args{embed}{ref} ) {
$post{embed} = $self->getEmbedRef( $args{embed}{ref} );
}
}
my $res = $self->at->create_record( 'app.bsky.feed.post', \%post );
# If reply_gate is requested, create a threadgate record
if ( $res && $res->{uri} && $args{reply_gate} ) {
my $post_uri = At::Protocol::URI->new( $res->{uri} );
my @allow;
if ( ref $args{reply_gate} eq 'ARRAY' ) {
for my $type ( @{ $args{reply_gate} } ) {
if ( $type eq 'mention' ) { push @allow, { '$type' => 'app.bsky.feed.threadgate#mentionRule' }; }
elsif ( $type eq 'following' ) { push @allow, { '$type' => 'app.bsky.feed.threadgate#followingRule' }; }
elsif ( $type eq 'list' ) { push @allow, { '$type' => 'app.bsky.feed.threadgate#listRule', list => $args{reply_gate_list} }; }
}
}
$self->at->create_record( 'app.bsky.feed.threadgate',
{ post => $post_uri->as_string, allow => \@allow, createdAt => $self->at->_now->to_string, },
$post_uri->rkey ); # Must match post rkey
}
# If post_gate is requested, create a postgate record
if ( $res && $res->{uri} && $args{post_gate} ) {
my $post_uri = At::Protocol::URI->new( $res->{uri} );
my @embedding_rules;
if ( ref $args{post_gate} eq 'ARRAY' ) {
for my $rule ( @{ $args{post_gate} } ) {
if ( $rule eq 'disable' ) {
push @embedding_rules, { '$type' => 'app.bsky.feed.postgate#disableRule' };
}
}
}
$self->at->create_record( 'app.bsky.feed.postgate',
{ post => $post_uri->as_string, embeddingRules => \@embedding_rules, createdAt => $self->at->_now->to_string, },
$post_uri->rkey );
}
return $res;
}
method deletePost($at_uri) {
$at_uri = At::Protocol::URI->new($at_uri) unless builtin::blessed $at_uri;
$self->at->delete_record( 'app.bsky.feed.post', $at_uri->rkey );
# Automatically try to delete gates too
$self->at->delete_record( 'app.bsky.feed.threadgate', $at_uri->rkey );
$self->at->delete_record( 'app.bsky.feed.postgate', $at_uri->rkey );
}
method like( $uri, $cid //= () ) {
if ( !defined $cid ) {
my $post = $self->_at_for('app.bsky.feed.getPosts')->get( 'app.bsky.feed.getPosts' => { uris => [$uri] } );
$post || $post->throw;
$cid = $post->{posts}[0]{cid};
}
$self->at->create_record(
lib/Bluesky.pm view on Meta::CPAN
# tweaked to disallow some training punctuation
push @spans, { start => $-[1], url => $1, end => $+[1] }
while $text
=~ /(?:\A|\W)(https?:\/\/(www\.)?[-a-zA-Z0-9\@:%._\+~#=]{1,256}\.[a-zA-Z0-9()]{1,6}\b([-a-zA-Z0-9\(\)\@:%_\+.~#?&\/\/=]*[-a-zA-Z0-9@%_\+~#\/\/=])?)/g;
@spans;
}
method parse_tags($text) {
my @spans;
push @spans, { start => $-[1], tag => $2, end => $+[1] } while $text =~ /(?:\A|\W)(#+(\w{1, 640}))/g;
@spans;
}
method parse_facets($text) {
my @facets;
for my $m ( $self->parse_mentions($text) ) {
my $res = $self->at->get( 'com.atproto.identity.resolveHandle', { handle => $m->{handle} } );
# if handle cannot be resolved, just skip it. Bluesky will display it as plain text
$res || next;
push @facets,
{
index => { byteStart => $m->{start}, byteEnd => $m->{end} },
features => [ { '$type' => 'app.bsky.richtext.facet#mention', did => $res->{did} } ]
};
}
for my $m ( $self->parse_urls($text) ) {
push @facets,
{
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;
( run in 2.383 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )