以下はすべて同じ。ファイル名が違うだけ
#!/usr/local/bin/perl
use strict;
use utf8;
use Encode;
use vars qw($SCRIPT);
($SCRIPT = $0) =~ s!.+/([^/]+$)!$1!;
my $ap = actpub->new({});
if( $SCRIPT =~ m!webfinger! ){
$ap->webfinger();
}
elsif( $SCRIPT =~ m!person! ){
$ap->person();
}
elsif( $SCRIPT =~ m!nodeinfo21! ){
$ap->nodeinfo21();
}
elsif( $SCRIPT =~ m!nodeinfo! ){
$ap->nodeinfo();
}
else{
$ap->host_meta();
}
exit;
package actpub;
use strict;
sub new{
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $args = shift;
my ( $obj ) = bless {
cwd=>'/bookshelf/',
'host-meta'=>'.well-known/host-meta.xml',
'webfinger'=>'.well-known/webfinger.json',
'person'=>'.well-known/person.json',
'nodeinfo'=>'.well-known/nodeinfo.json',
'nodeinfo2.1'=>'.well-known/nodeinfo21.json',
%$args,
@_
}, $class;
return $obj;
}
sub DESTROY{
my $self = shift;
exit;
}
#
sub nodeinfo{
my $self = shift;
my $args = shift;
open(IN, $self->{cwd} . $self->{'nodeinfo'}) || return;
my @buf = <IN>;
close(IN);
my $ret_str = join('', @buf); $ret_str =~ s!\r?\n!!g;
printf qq{Content-Type: application/json\n\n};
printf qq{%s}, $ret_str;
}
sub nodeinfo21{
my $self = shift;
my $args = shift;
open(IN, $self->{cwd} . $self->{'nodeinfo2.1'}) || return;
my @buf = <IN>;
close(IN);
my $ret_str = join('', @buf); $ret_str =~ s!\r?\n!!g;
printf qq{Content-Type: application/json\n\n};
printf qq{%s}, $ret_str;
}
sub host_meta{
my $self = shift;
my $args = shift;
open(IN, $self->{cwd} . $self->{'host-meta'}) || return;
my @buf = <IN>;
close(IN);
my $ret_str = join('', @buf); $ret_str =~ s!\r?\n!!g;
printf qq{Content-Type: application/xrd+xml charset=utf-8\n\n};
printf qq{%s}, $ret_str;
}
sub webfinger{
my $self = shift;
my $args = shift;
open(IN, $self->{cwd} . $self->{'webfinger'}) || return;
my @buf = <IN>;
close(IN);
my $ret_str = join('', @buf); $ret_str =~ s!\r?\n!!g;
printf qq{Content-Type: application/activity+json; charset=utf-8\n\n};
printf qq{%s}, $ret_str;
}
sub person{
my $self = shift;
my $args = shift;
open(IN, $self->{cwd} . $self->{'person'}) || return;
my @buf = <IN>;
close(IN);
my $ret_str = join('', @buf); $ret_str =~ s!\r?\n!!g;
printf qq{Content-Type: application/activity+json; charset=utf-8\n\n};
printf qq{%s}, $ret_str;
}
1;
__END__