/gen.db

## gen.db
message
{
     id = 1
     date = 09-04-2012 15:29:41 +03:00
     user = Medved
     message = My memory would not cherish less; -\n
}
message
{
     id = 2
     date = 09-04-2012 15:29:41 +03:00
     user = sergejzr
     message = I dare not hope my love is great;\n
}
message
{
     id = 3
     date = 09-04-2012 15:29:41 +03:00
     user = Rodman
     message = Within my heart they still shall dwell;\n
}
message
{
     id = 4
     date = 09-04-2012 15:29:41 +03:00
     user = cardinal
     message = And they shall cheer and comfort me.\n
}
message
{
     id = 5
     date = 09-04-2012 15:29:41 +03:00
     user = JackYF
     message = My feeble faith still clings to Thee,\n
}
message
{
     id = 6
     date = 09-04-2012 15:29:41 +03:00
     user = cardinal
     message = The future fills me with dismay;\n
}
message
{
     id = 7
     date = 09-04-2012 15:29:41 +03:00
     user = JackYF
     message = I had not dreamed a living face\n
}
message
{
     id = 8
     date = 09-04-2012 15:29:41 +03:00
     user = Rodman
     message = The hope with which I cannot part.\n
}
message
{
     id = 9
     date = 09-04-2012 15:29:41 +03:00
     user = Alexeis
     message = And they shall cheer and comfort me.\n
}
message
{
     id = 9
     date = 09-04-2012 15:30:15 +03:00
     user = root
     message = Привет, как дела? как погода в Минске? ак Перл?\n
}
message
{
     id = 10
     date = 09-04-2012 15:30:39 +03:00
     user = freelancer
     message = Я перловик, пишите на аддр. mail@mail.ru или звоните +754 55 434 33334\n
}

## gendb.pl
#!/usr/bin/perl
use strict;
use warnings;

####################################################################################################

my @users	= qw/MAKCim Earnest JackYF Rodman cardinal Sardar Medved Alexeis Snowy sergejzr Akella/;
my @strings = <DATA>;

####################################################################################################

open FH, '>gen.db' or die $!;
for(my $i = 1; $i < ($ARGV[0] || 2**32); $i++)
{
	my $user	= $users[int(rand $#users)];
	my $msg		= $strings[int(rand $#strings)];
	my $date	= `date '+%d-%m-%Y %H:%M:%S %:z'`; chomp $date;
	my $format	= <<EOF;
message
{
     id = #id#
     date = #date#
     user = #user#
     message = #message#
}
EOF

	$msg =~ s/\n/\\n/g;

	$format =~ s/#id#/$i/;
	$format =~ s/#date#/$date/;
	$format =~ s/#user#/$user/;
	$format =~ s/#message#/$msg/;

	print FH $format;
}
close FH;

__DATA__
Farewell to thee! but not farewell
To all my fondest thoughts of thee:
Within my heart they still shall dwell;
And they shall cheer and comfort me.
O, beautiful, and full of grace!
If thou hadst never met mine eye,
I had not dreamed a living face
Could fancied charms so far outvie.
If I may ne'er behold again
That form and face so dear to me,
Nor hear thy voice, still would I fain
Preserve, for aye, their memory.
That voice, the magic of whose tone
Can wake an echo in my breast,
Creating feelings that, alone,
Can make my tranced spirit blest.
That laughing eye, whose sunny beam
My memory would not cherish less; -
And oh, that smile! whose joyous gleam
Nor mortal language can express.
Adieu, but let me cherish, still,
The hope with which I cannot part.
Contempt may wound, and coldness chill,
But still it lingers in my heart.
And who can tell but Heaven, at last,
May answer all my thousand prayers,
And bid the future pay the past
With joy for anguish, smiles for tears?
'My God! O let me call Thee mine!
Weak wretched sinner though I be,
My trembling soul would fain be Thine,
My feeble faith still clings to Thee,
My feeble faith still clings to Thee.
Not only for the past I grieve,
The future fills me with dismay;
Unless Thou hasten to relieve,
I know my heart will fall away,
I know my heart will fall away.
I cannot say my faith is strong,
I dare not hope my love is great;
But strength and love to Thee belong,
O, do not leave me desolate!
O, do not leave me desolate!
I know I owe my all to Thee,
O, take this heart I cannot give.
Do Thou my Strength my Saviour be;
And make me to Thy glory live!
And make me to Thy glory live!

## manager.pl
#!/usr/bin/perl

use strict;
use warnings;

use File::Copy;
use Getopt::Std;
use Encode "encode";
use encoding 'utf8', STDOUT => 'utf8';

use constant DBFILE => 'gen.db';

### SUBROUTINE'S ###################################################################################
#
sub help
{
	print <<EOF;

 HELP:
 add   : Добавить запись
 del   : Удалить запись по id
         del 17,18,20-79,2
 show  : Показать сообщениня: пользователя либо все (ост. с большими файлами)
         show username|all
 ulist : Вывести список пользователей
 regex : Показать сообщения в соответствии с регеспом
         regex \+375\\s\\w+

 exit  : Выход

EOF
}
# создать запись
sub create_entry
{
	my $msg_body	= <<EOF;
message
{
     id = #id#
     date = #date#
     user = #user#
     message = #msg_body#
}
EOF
	chomp(my $date	= `date '+%d-%m-%Y %H:%M:%S %:z'`);

	my ( $user, $message );

	for(;;)
	{
		unless($user)
		{
			print "Пользователь: ";
			chomp($user = <STDIN>);
		}
		unless($message)
		{
			print "Сообщение (!q окончить): " if !$message;
      while(my $in = <STDIN>)
      {
        last if $in =~ /!q/;
        $message .= $in;
      }
		}
		last if $user && $message;
	}

	$message  =~ s/\n/\\n/g;
	$msg_body =~ s/#id#/$ENV{__LAST_ENTRY}/;
	$msg_body =~ s/#date#/$date/;
	$msg_body =~ s/#user#/$user/;
	$msg_body =~ s/#msg_body#/$message/;

	return $msg_body;
}
# выдать id послед. записи
sub get_lastid
{
	my $ref = shift;
  my $pos = ( sort {$a <=> $b} keys %$ref )[-1] || 0;
	return $pos;
}
# вывод записей
sub show
{
	my ( $w, $ref ) = @_;
  my $exist;
	foreach my $count ( sort {$a <=> $b} keys %$ref )
	{
		my $block = get_entries( DBFILE, @{$$ref{$count}} );
    next if !$$block{message};
		$$block{message} =~ s/\\n/\n/g;

		if(!defined $w || $w eq 'all')
		{
			printf("\n[%d] \@%s %s\n    %s\n", $$block{id}, $$block{user}, $$block{date}, $$block{message});
      $exist++;
		}
		elsif($$block{user} eq $w)
		{
			printf("\n[%d] \@%s %s\n    %s\n", $$block{id}, $$block{user}, $$block{date}, $$block{message});
      $exist++;
		}
	}
  print "[-] Нет записей для выбранного пользователя\n" unless $exist;
}
# поместить в хеш позиции кажDого блока
sub get_block_pos
{
	my ( $fname, $ref ) = @_;
	# счетчики
	my %c; @c{qw/open close str block/} = (0,0,0,1);
	# читаем
	open FH, $fname or die $!;
	while(<FH>)
	{
		my $cur_pos = tell(FH);
		# считаем строки
		$c{str}		+= 1;
		# определим скобки
		$c{open}	= $cur_pos-9 if /^{/;
		$c{close}	= $cur_pos if /^}/;
		# запомним блок
		if($c{open} && $c{close})
		{
			$$ref{ $c{block} } = [$c{open}, $c{close}];
			$c{open} = $c{close} = '';
			$c{block} += 1
		}
	}
	close FH;
}
# получить содержание блока
sub get_entries
{
	my ( $fname, $spos, $epos ) = @_;
	my %block;

	open FH, $fname or die $!;
	seek FH, $spos, 0;
	read FH, my $buf, $epos-$spos;
	close FH;

	foreach my $str (split/\n/,$buf)
	{
		$str =~ s/^\s+//;
		$block{$1} = $2 if $str =~ /(.*?)\s=\s(.*)/;
	}

	#$ENV{__ULIST} = %block;

	return \%block;
}
# вывод сообщений по регеспу
sub msg_by_regex
{
	my ( $ref, $regex ) = @_;

	foreach my $count ( sort { $a <=> $b } keys %$ref )
	{
		my $block = get_entries( DBFILE, @{$$ref{$count}} );

		if($$block{message} =~ /$regex/)
		{
			$$block{message} =~ s/\\n/\n/g;
			printf("[%d] \@%s %s\n    %s\n", $$block{id}, $$block{user}, $$block{date}, $$block{message});
		}
	}
}
# получить список имен
sub show_user_list
{
	my ( $ref, %users ) = shift;
	foreach my $count ( keys %$ref )
	{
		my $block = get_entries( DBFILE, @{$$ref{$count}} );
		print "$$block{user}\n" unless $users{ $$block{user} };
		$users{ $$block{user} } = 1;
	}
}
# удалить запись(и)
sub del
{
	my ( $id, $fname, $ref ) = @_;
	my @tmp = split /\,/, $id;

	for(my $i = 0; $i < @tmp; $i++)
	{
		if($tmp[$i] =~ /(\d+)-(\d+)/)
		{
			for($1..$2)
			{
				next unless exists($$ref{$_});
				delete $$ref{$_};
			}
		}
		else
		{
			next unless exists($$ref{$tmp[$i]});
			delete $$ref{$tmp[$i]};
		}
	}

	open RH, '<', $fname or die $!;
	open WH, '>', "$fname.t" or die $!;
	foreach my $count ( sort {$a <=> $b} keys %$ref )
	{
		seek RH, $$ref{$count}[0]-1, 0;
		sysread RH, my $buf, ($$ref{$count}[1]-$$ref{$count}[0]+1);
		syswrite WH, $buf;
	}
	close RH;
	close WH;
	move("$fname.t", $fname);
}
### MAIN ###########################################################################################

main:
{
  $|++;
  my %block_pos;
  die "Ошибка записи файла\nСгенерируйте файл.бд скриптом gendb.pl\n" unless -w DBFILE;
  # --- #
  print "[~] Определение блоков...\n";
	get_block_pos(DBFILE, \%block_pos);
	print "[+] Определение блоков завершено.\n";
	# обновить позицию
	$ENV{__LAST_ENTRY} = get_lastid( \%block_pos );
  #
  help(); print "[root#] ";
  #
  while(my $in = <STDIN>)
  {
    # разделям аругменты
    chomp $in; $in ||= '0';
    my @cmd = split /\s+/, $in;
    # обрабатываем аргументы :)
		if($cmd[0] eq 'show')
		{
			show($cmd[1], \%block_pos);
		}
		elsif($cmd[0] eq 'regex')
		{
			msg_by_regex(\%block_pos, $cmd[1]);
		}
		elsif($cmd[0] eq 'ulist')
		{
			show_user_list(\%block_pos);
		}
		elsif($cmd[0] eq 'add')
		{
			my $new_entry = create_entry();
			open WF, '>>:encoding(utf8)', DBFILE or die $!;
			seek WF, $block_pos{$ENV{__LAST_ENTRY}}[1], 0;
			print WF $new_entry;
			close WF;
			# обновить послед. позицию (кодируем в utf что бы получить нужную позицию)
      my ( $tmp_p1, $tmp_p2 ) = ($block_pos{$ENV{__LAST_ENTRY}}[1], length(encode('utf8', $new_entry)) );
      $tmp_p2 += $tmp_p1;
      $ENV{__LAST_ENTRY} += 1;

			$block_pos{$ENV{__LAST_ENTRY}} = [$tmp_p1, $tmp_p2];
		}
		elsif($cmd[0] eq 'del')
		{
			del($cmd[1], DBFILE, \%block_pos);
      # обновить позицию
      $ENV{__LAST_ENTRY} = get_lastid( \%block_pos );
		}
    elsif($cmd[0] eq 'exit')
    {
      last;
    }
    else
    {
      help();
    }
    # вывод банера
    print "[root#] ";
  }
}

# ~e0f~ #
	message
	{
	id = 1
	date = 09-04-2012 15:29:41 +03:00
	user = Medved
	message = My memory would not cherish less; -\n
	}
	message
	{
	id = 2
	date = 09-04-2012 15:29:41 +03:00
	user = sergejzr
	message = I dare not hope my love is great;\n
	}
	message
	{
	id = 3
	date = 09-04-2012 15:29:41 +03:00
	user = Rodman
	message = Within my heart they still shall dwell;\n
	}
	message
	{
	id = 4
	date = 09-04-2012 15:29:41 +03:00
	user = cardinal
	message = And they shall cheer and comfort me.\n
	}
	message
	{
	id = 5
	date = 09-04-2012 15:29:41 +03:00
	user = JackYF
	message = My feeble faith still clings to Thee,\n
	}
	message
	{
	id = 6
	date = 09-04-2012 15:29:41 +03:00
	user = cardinal
	message = The future fills me with dismay;\n
	}
	message
	{
	id = 7
	date = 09-04-2012 15:29:41 +03:00
	user = JackYF
	message = I had not dreamed a living face\n
	}
	message
	{
	id = 8
	date = 09-04-2012 15:29:41 +03:00
	user = Rodman
	message = The hope with which I cannot part.\n
	}
	message
	{
	id = 9
	date = 09-04-2012 15:29:41 +03:00
	user = Alexeis
	message = And they shall cheer and comfort me.\n
	}
	message
	{
	id = 9
	date = 09-04-2012 15:30:15 +03:00
	user = root
	message = Привет, как дела? как погода в Минске? ак Перл?\n
	}
	message
	{
	id = 10
	date = 09-04-2012 15:30:39 +03:00
	user = freelancer
	message = Я перловик, пишите на аддр. mail@mail.ru или звоните +754 55 434 33334\n
	}
	#!/usr/bin/perl
	use strict;
	use warnings;

	####################################################################################################

	my @users = qw/MAKCim Earnest JackYF Rodman cardinal Sardar Medved Alexeis Snowy sergejzr Akella/;
	my @strings = <DATA>;

	####################################################################################################

	open FH, '>gen.db' or die $!;
	for(my $i = 1; $i < ($ARGV[0] \|\| 2**32); $i++)
	{
	my $user = $users[int(rand $#users)];
	my $msg = $strings[int(rand $#strings)];
	my $date = `date '+%d-%m-%Y %H:%M:%S %:z'`; chomp $date;
	my $format = <<EOF;
	message
	{
	id = #id#
	date = #date#
	user = #user#
	message = #message#
	}
	EOF

	$msg =~ s/\n/\\n/g;

	$format =~ s/#id#/$i/;
	$format =~ s/#date#/$date/;
	$format =~ s/#user#/$user/;
	$format =~ s/#message#/$msg/;

	print FH $format;
	}
	close FH;

	__DATA__
	Farewell to thee! but not farewell
	To all my fondest thoughts of thee:
	Within my heart they still shall dwell;
	And they shall cheer and comfort me.
	O, beautiful, and full of grace!
	If thou hadst never met mine eye,
	I had not dreamed a living face
	Could fancied charms so far outvie.
	If I may ne'er behold again
	That form and face so dear to me,
	Nor hear thy voice, still would I fain
	Preserve, for aye, their memory.
	That voice, the magic of whose tone
	Can wake an echo in my breast,
	Creating feelings that, alone,
	Can make my tranced spirit blest.
	That laughing eye, whose sunny beam
	My memory would not cherish less; -
	And oh, that smile! whose joyous gleam
	Nor mortal language can express.
	Adieu, but let me cherish, still,
	The hope with which I cannot part.
	Contempt may wound, and coldness chill,
	But still it lingers in my heart.
	And who can tell but Heaven, at last,
	May answer all my thousand prayers,
	And bid the future pay the past
	With joy for anguish, smiles for tears?
	'My God! O let me call Thee mine!
	Weak wretched sinner though I be,
	My trembling soul would fain be Thine,
	My feeble faith still clings to Thee,
	My feeble faith still clings to Thee.
	Not only for the past I grieve,
	The future fills me with dismay;
	Unless Thou hasten to relieve,
	I know my heart will fall away,
	I know my heart will fall away.
	I cannot say my faith is strong,
	I dare not hope my love is great;
	But strength and love to Thee belong,
	O, do not leave me desolate!
	O, do not leave me desolate!
	I know I owe my all to Thee,
	O, take this heart I cannot give.
	Do Thou my Strength my Saviour be;
	And make me to Thy glory live!
	And make me to Thy glory live!