以下はすべて同じ。ファイル名が違うだけ


#!/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__