view release on metacpan or  search on metacpan

lib/Aion/Annotation.pm  view on Meta::CPAN

# Аннотации: annotation_name.pkg.sub_or_has_name => [[line, annotation_desc]...]
has ann => (is => 'ro', isa => HashRef[HashRef[HashRef[ArrayRef[Tuple[Int, Str]]]]], default => sub {
	my $self = shift;
	my %ann;
	return \%ann if $self->force;

	return \%ann if !-d(my $ini = $self->ini);

	while(<$ini/*.ann>) {
		my $path = $_;
		my $annotation_name = path()->{name};
		open my $f, "<:utf8", $_ or do { warn "$_ not opened: $!"; next };
		while(<$f>) {
			warn "$path corrupt on line $.!" unless /^([\w:]+)#(\w*),(\d+)=(.*)$/;
			push @{$ann{$annotation_name}{$1}{$2}}, [$3, $4];
		}
		close $f;
	}

	\%ann
});

# Путь к файлу с комментариями
has remark_path => (is => 'ro', isa => Str, default => sub { shift->ini . "/remarks.ini" });

# Комментарии: pkg.sub_or_has_name => [[line, remark]...]
has remark => (is => 'ro', isa => HashRef[HashRef[Tuple[Int, ArrayRef[Str]]]], default => sub {
	my ($self) = @_;
	my %remark;
	return \%remark if $self->force;

	my $remark_path = $self->remark_path;
	return \%remark if !-e $remark_path;

	open my $f, "<:utf8", $remark_path or do { warn "$remark_path not opened: $!"; return \%remark };
	while(<$f>) {
		warn "$remark_path corrupt on line $.!" unless /^([\w:]+)#(\w*),(\d+)=(.*)$/;
		$remark{$1}{$2} = [$3, [map { s/\\(.)/$1/gr } split /\\n/, $4]];
	}
	close $f;

	\%remark
});

# Путь к файлу с временем последнего доступа к модулям
has modules_mtime_path => (is => 'ro', isa => Str, default => CACHE . "/modules.mtime.ini");

# Время последнего доступа к модулям: pkg => unixtime
has modules_mtime => (is => 'ro', isa => HashRef[Int], default => sub {
	my ($self) = @_;

	my %mtime;
	return \%mtime if $self->force;

	my $mtime_path = $self->modules_mtime_path;
	return \%mtime if !-e $mtime_path;

	open my $f, "<:utf8", $mtime_path or do { warn "$mtime_path not opened: $!"; return 0 };
	while(<$f>) {
		warn "$mtime_path corrupt on line $.!" unless /^(?<module>[\w:]+)=(?<year>\d{4})-(?<mon>\d{2})-(?<mday>\d{2}) (?<hour>\d{2}):(?<min>\d{2}):(?<sec>\d{2})$/;
		$mtime{$+{module}} = timelocal($+{sec}, $+{min}, $+{hour}, $+{mday}, $+{mon} - 1, $+{year});
	}
	close $f;

	\%mtime
});

# Сканирует модули и сохраняет аннотации
#@run aion:scan „Scan modules and save annotations”
sub scan {
	my ($self) = @_;

	my @libs = @{$self->lib};
	s/\/$// for @libs;

	my $modules_mtime = $self->modules_mtime;
	my $ann = $self->ann;
	my $remark = $self->remark;
	my %exists;

	for my $lib (@libs) {
		my $iter = find $lib, "*.pm", "-f";
		while(<$iter>) {
			my $pkg = to_pkg(substr $_, 1 + length $lib);
			$exists{$pkg} = 1;
			my $mtime = int mtime;
			next if !$self->force && exists $modules_mtime->{$pkg} && $modules_mtime->{$pkg} == $mtime;
			$modules_mtime->{$pkg} = $mtime;

			delete $_->{$pkg} for values %$ann;
			delete $remark->{$pkg};

			open my $f, "<:utf8", $_ or do { warn "$_ not opened: $!"; next };
			my @ann; my @rem;
			my $save_annotation = sub {
				my ($name, $pkg1) = @_;
				$pkg1 //= $pkg;
				push @{$ann->{$_->[0]}{$pkg1}{$name}}, $_->[1] for @ann;
				$remark->{$pkg1}{$name} = [$., [@rem]] if @rem;
				@ann = @rem = ();
			};
			while(<$f>) {
				last if /^(__END__|__DATA__)\s*$/;
				push @ann, [$1, [$., $2]] if /^#\@(\w+)\s+(.*?)\s*$/;
				push @rem, $1 if /^#\s(.*?)\s*$/;
				$save_annotation->() if /^\s*$/;
				$save_annotation->($2, $1) if /^sub\s+(?:([\w:]+)::)?(\w+)/;
				$save_annotation->($+{s}) if /^has \s+ (?: (?<s>\w+) | '(?<s>(\\'|[^'])*)' | "(?<s>(\\"|[^"])*)" )/x;
			}
			$save_annotation->();
			close $f;
		}
	}

	# Удаляем пакеты в аннотациях, которых уже нет в проекте
	for my $annotation_name (keys %$ann) {
		my $pkgs = $ann->{$annotation_name};
		for my $pkg (keys %$pkgs) {
			 delete $pkgs->{$pkg} if !exists $exists{$pkg};
		}
	}