From 15e6994d74f117d646f9718d0a1053f25b7d8359 Mon Sep 17 00:00:00 2001 From: "Difrex(Denis Zheleztsov)" Date: Wed, 11 Jun 2014 15:55:00 +0400 Subject: [PATCH] Working version with push support --- II/Config.pm | 36 +++++++ II/DB.pm | 258 +++++++++++++++++++++++++++++++++++++++++++++++++++ II/Enc.pm | 65 +++++++++++++ II/Get.pm | 108 +++++++++++++++++++++ II/Render.pm | 204 ++++++++++++++++++++++++++++++++++++++++ II/Send.pm | 41 ++++++++ II/T.pm | 169 +++++++++++++++++++++++++++++++++ config.ini | 7 ++ ii.sql | Bin 0 -> 1793024 bytes iiplc.app | 157 +++++++++++++++++++++++++++++++ run.sh | 7 ++ t/foot.html | 2 + t/head.html | 112 ++++++++++++++++++++++ t/index.html | 1 + t/new.html | 12 +++ t/out.html | 16 ++++ t/post.html | 16 ++++ t/send.html | 24 +++++ t/tree.html | 9 ++ 19 files changed, 1244 insertions(+) create mode 100644 II/Config.pm create mode 100644 II/DB.pm create mode 100644 II/Enc.pm create mode 100644 II/Get.pm create mode 100644 II/Render.pm create mode 100644 II/Send.pm create mode 100644 II/T.pm create mode 100644 config.ini create mode 100644 ii.sql create mode 100644 iiplc.app create mode 100755 run.sh create mode 100644 t/foot.html create mode 100644 t/head.html create mode 100644 t/index.html create mode 100644 t/new.html create mode 100644 t/out.html create mode 100644 t/post.html create mode 100644 t/send.html create mode 100644 t/tree.html diff --git a/II/Config.pm b/II/Config.pm new file mode 100644 index 0000000..6d734af --- /dev/null +++ b/II/Config.pm @@ -0,0 +1,36 @@ +package II::Config; + +use Config::Tiny; + +sub new { + my $class = shift; + + my $c = Config::Tiny->new(); + $c = Config::Tiny->read('config.ini'); + + my $self = { _config => $c, }; + + bless $self, $class; + return $self; +} + +sub load { + my ($self) = @_; + my $config = $self->{_config}; + + my $key = $config->{auth}->{key}; + my $nick = $config->{auth}->{nick}; + my $host = $config->{node}->{host}; + my @echoareas = split /,/, $config->{node}->{echoareas}; + + $c = { + nick => $nick, + key => $key, + host => $host, + echoareas => [@echoareas], + }; + + return $c; +} + +1; diff --git a/II/DB.pm b/II/DB.pm new file mode 100644 index 0000000..e44d628 --- /dev/null +++ b/II/DB.pm @@ -0,0 +1,258 @@ +package II::DB; + +use SQL::Abstract; +use DBI; + +use Data::Dumper; + +sub new { + my $class = shift; + + my $dbh = DBI->connect( "dbi:SQLite:dbname=ii.sql", "", "" ); + my $sql = SQL::Abstract->new(); + + my $self = { + _dbh => $dbh, + _sql => $sql, + }; + + bless $self, $class; + return $self; +} + +sub write_out { + my ( $self, %data ) = @_; + my $dbh = $self->{_dbh}; + my $sql = $self->{_sql}; + + my ( $stmt, @bind ) = $sql->insert( 'output', \%data ); + + my $sth = $dbh->prepare($stmt); + $sth->execute(@bind); + + print "Message writed to DB!\n"; +} + +sub update_out { + my ($self, $hash) = @_; + my $dbh = $self->{_dbh}; + + my $q = "update output set send=1 where hash='$hash'"; + my $sth = $dbh->prepare($q); + $sth->execute(); +} + +sub write { + my ( $self, %data ) = @_; + my $dbh = $self->{_dbh}; + my $sql = $self->{_sql}; + + my ( $stmt, @bind ) = $sql->insert( 'messages', \%data ); + + my $sth = $dbh->prepare($stmt); + $sth->execute(@bind); + + print "Message writed to DB!\n"; +} + +sub select_out { + my ($self) = @_; + my $dbh = $self->{_dbh}; + + my $q + = "select from_user, to_user, subg, time, echo, post, hash, base64 from output where send=0"; + + my $sth = $dbh->prepare($q); + $sth->execute(); + + my @posts; + while ( my @hash = $sth->fetchrow_array() ) { + my ( $from, $to, $subg, $time, $echo, $post, $h, $base64 ) = @hash; + my $data = { + from => "$from", + to => "$to", + subg => "$subg", + time => $time, + echo => "$echo", + post => "$post", + hash => $h, + base64 => $base64, + }; + push( @posts, $data ); + } + + return @posts; +} + +sub select_index { + my ( $self, $limit ) = @_; + my $dbh = $self->{_dbh}; + + my $q = "select hash from messages order by time desc limit $limit"; + + my $sth = $dbh->prepare($q); + $sth->execute(); + + my @hashes; + while ( my @hash = $sth->fetchrow_array() ) { + my ($h) = @hash; + push( @hashes, $h ); + } + + return @hashes; +} + +sub select_subg { + my ( $self, $echo ) = @_; + +} + +sub from_me { + my ( $self, $config ) = @_; + my $dbh = $self->{_dbh}; + my $nick = $config->{nick}; + + # print Dumper($config); + # print "NICK: $nick\n"; + + my $q + = "select from_user, to_user, subg, time, echo, post, hash from messages where from_user='$nick'"; + + my $sth = $dbh->prepare($q); + $sth->execute(); + + my @posts; + while ( my @hash = $sth->fetchrow_array() ) { + my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash; + my $data = { + from => "$from", + to => "$to", + subg => "$subg", + time => $time, + echo => "$echo", + post => "$post", + hash => $h, + }; + push( @posts, $data ); + } + + return @posts; +} + +sub thread { + my ( $self, $subg, $echo ) = @_; + my $dbh = $self->{_dbh}; + + my $q + = "select from_user, to_user, subg, time, echo, post, hash from messages where echo='$echo' and subg like '%$subg%' order by time"; + + my $sth = $dbh->prepare($q); + $sth->execute(); + + my @posts; + while ( my @hash = $sth->fetchrow_array() ) { + my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash; + my $data = { + from => "$from", + to => "$to", + subg => "$subg", + time => $time, + echo => "$echo", + post => "$post", + hash => $h, + }; + push( @posts, $data ); + } + + return @posts; +} + +sub echoes { + my ( $self, $echo ) = @_; + my $dbh = $self->{_dbh}; + + my $q + = "select from_user, to_user, subg, time, echo, post, hash from messages where echo='$echo' order by time desc"; + + my $sth = $dbh->prepare($q); + $sth->execute(); + + my @posts; + while ( my @hash = $sth->fetchrow_array() ) { + my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash; + my $data = { + from => "$from", + to => "$to", + subg => "$subg", + time => $time, + echo => "$echo", + post => "$post", + h => $h, + }; + push( @posts, $data ); + } + + return @posts; +} + +sub to_me { + my ( $self, $config ) = @_; + my $dbh = $self->{_dbh}; + my $nick = $config->{nick}; + + # print Dumper($config); + # print "NICK: $nick\n"; + + my $q + = "select from_user, to_user, subg, time, echo, post, hash from messages where to_user='$nick'"; + + my $sth = $dbh->prepare($q); + $sth->execute(); + + my @posts; + while ( my @hash = $sth->fetchrow_array() ) { + my ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash; + my $data = { + from => "$from", + to => "$to", + subg => "$subg", + time => $time, + echo => "$echo", + post => "$post", + hash => "$h", + }; + push( @posts, $data ); + } + + return @posts; +} + +sub select_new { + my ( $self, $msg ) = @_; + my $dbh = $self->{_dbh}; + + my $q + = "select from_user, to_user, subg, time, echo, post, hash from messages where hash='$msg'"; + + my $sth = $dbh->prepare($q); + $sth->execute(); + my ( $from, $to, $subg, $time, $echo, $post ); + + while ( my @hash = $sth->fetchrow_array() ) { + ( $from, $to, $subg, $time, $echo, $post, $h ) = @hash; + } + + my $data = { + from => "$from", + to => "$to", + subg => "$subg", + time => $time, + echo => "$echo", + post => "$post", + hash => "$h", + }; + + return $data; +} + +1; diff --git a/II/Enc.pm b/II/Enc.pm new file mode 100644 index 0000000..a6484f9 --- /dev/null +++ b/II/Enc.pm @@ -0,0 +1,65 @@ +package II::Enc; + +use II::DB; +use MIME::Base64; + +sub new { + my $class = shift; + + my $db = II::DB->new(); + + my $self = { + _config => shift, + _data => shift, + _db => $db, + }; + + bless $self, $class; + return $self; +} + +sub encode { + my ($self) = @_; + my $config = $self->{_config}; + my $data = $self->{_data}; + my $db = $self->{_db}; + my $hash = II::Enc->new_hash(); + + # Make base64 message + my $message = $data->{echo}."\n"; + $message .= $data->{to}."\n"; + $message .= $data->{subg}."\n\n"; + $message .= '@repto:'.$data->{hash}."\n" if defined($data->{hash}); + $message .= $data->{post}; + + my $encoded = `echo "$message" | base64`; + $encoded =~ s/\//_/g; + $encoded =~ s/\+/-/g; + + # Make data + my %out = ( + hash => $hash, + time => $data->{time}, + echo => $data->{echo}, + from_user => $data->{from}, + to_user => $data->{to}, + subg => $data->{subg}, + post => $data->{post}, + base64 => $encoded, + send => 0, + ); + + $db->write_out(%out); + + return 0; +} + +sub new_hash { + my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9 ); + my $string; + $string .= $chars[ rand @chars ] for 1 .. 21; + + return $string; +} + +1; diff --git a/II/Get.pm b/II/Get.pm new file mode 100644 index 0000000..c619b45 --- /dev/null +++ b/II/Get.pm @@ -0,0 +1,108 @@ +package II::Get; +use LWP::Simple; + +use II::DB; + +use Data::Dumper; + +sub new { + my $class = shift; + + my $self = { _config => shift, }; + + bless $self, $class; + return $self; +} + +sub get_echo { + my ($self) = @_; + my $config = $self->{_config}; + my $echoareas = $config->{echoareas}; + my $host = $config->{host}; + + my $db = II::DB->new(); + + my $echo_url = 'e/'; + my $msg_url = 'm/'; + + my $msgs; + foreach my $echo (@$echoareas) { + # my @content = get( "$host" . "$echo_url" . "$echo" ); + my @content = `curl $host$echo_url$echo`; + + # if ( is_success( getprint( "$host" . "$echo_url" . "$echo" ) ) ) { + + # Write echoes file + open my $echo_fh, ">", "./echo/$echo" + or die "Cannot open file: $!\n"; + print $echo_fh @content; + close $echo_fh; + + # Get messages + open my $echo_fh, "<", "./echo/$echo" + or die "Cannot open file: $!\n"; + while (<$echo_fh>) { + chomp($_); + if ( !( -e "./msg/$_" ) ) { + $msgs .= $_ . "\n"; + # @w_cmd = ( 'wget', '-O', + # "./msg/$_", "$host" . "$msg_url" . "$_" ); + `curl $host$msg_url$_ > ./msg/$_`; + # system(@w_cmd) == 0 or die "Cannot download file: $!\n"; + } + } + close $echo_fh; + + # } + } + + my $new_messages + = "

Новые сообщения

\n"; + if ( defined($msgs) ) { + my @msg_list = split /\n/, $msgs; + while (<@msg_list>) { + my $mes_hash = $_; + open my $m, "<", "./msg/$mes_hash" + or die "Cannot open message: $!\n"; + + my @mes; + while (<$m>) { + push( @mes, $_ ); + } + close $m; + + my $count = 7; + my $post; + while ( $count < @mes ) { + $post .= $mes[$count]; + $count++; + } + + chomp( $mes[2] ); + chomp( $mes[1] ); + chomp( $mes[3] ); + chomp( $mes[5] ); + chomp( $mes[6] ); + + # Make data + my %data = ( + hash => $mes_hash, + time => $mes[2], + echo => $mes[1], + from_user => $mes[3], + to_user => $mes[5], + subg => $mes[6], + post => "$post", + read => 0, + ); + + # Write message to DB + $db->write(%data); + + # $new_messages .= "$post

"; + } + } + return $msgs; +} + +1; diff --git a/II/Render.pm b/II/Render.pm new file mode 100644 index 0000000..9bb2c62 --- /dev/null +++ b/II/Render.pm @@ -0,0 +1,204 @@ +package II::Render; + +use II::DB; +use II::T; + +use Data::Dumper; + +sub new { + my $class = shift; + + my $db = II::DB->new(); + my $t = II::T->new(); + + my $self = { + _db => $db, + _template => $t, + }; + + bless $self, $class; + return $self; +} + +sub thread { + my ( $self, $subg, $echo ) = @_; + my $db = $self->{_db}; + my $t = $self->{_template}; + + my @post = $db->thread( $subg, $echo ); + + # Render header + my $render = $t->head("ii :: $echo"); + my $count = 0; + while ( $count < @post ) { + $render .= $t->post( @post[$count] ); + $count++; + } + $render .= $t->foot(); + + return $render; + +} + +sub out { + my ($self) = @_; + my $db = $self->{_db}; + my $t = $self->{_template}; + + my @post = $db->select_out(); + + # Render header + my $render + = $t->head('ii :: неотправленные сообщения'); + + my $count = 0; + while ( $count < @post ) { + + # Render post + $render .= $t->out( @post[$count] ); + + $count++; + } + $render .= $t->foot(); +} + +sub echo_mes { + my ( $self, $echo ) = @_; + my $db = $self->{_db}; + my $t = $self->{_template}; + + my @post = $db->echoes($echo); + + # Render header + my $render = $t->head("ii :: $echo"); + $render .= "Новое сообщение"; + + my $count = 0; + while ( $count < @post ) { + + # Render post + if ( !( @post[$count]->{subg} =~ /Re.+/ ) ) { + $render .= $t->tree( @post[$count] ); + } + + $count++; + } + $render .= $t->foot(); + + return $render; + +} + +sub to_me { + my ( $self, $config ) = @_; + my $db = $self->{_db}; + my $t = $self->{_template}; + + my @post = $db->to_me($config); + my @post_from_me = $db->from_me($config); + + # Render header + my $render = $t->head('ii :: Моя переписка'); + + my $count = 0; + while ( $count < @post ) { + + # Render post + $render .= $t->post( @post[$count] ); + + $count++; + } + $render .= $t->foot(); + + return $render; +} + +sub tree { + my ( $self, $config ) = @_; + my $db = $self->{_db}; +} + +# Render index page +sub index { + my ( $self, $config ) = @_; + my $db = $self->{_db}; + my $echoareas = $config->{echoareas}; + my $t = $self->{_template}; + + my @hashes = $db->select_index(50); + + # Render header + my $render = $t->head('ii :: Лента'); + $render .= $t->index($echoareas); + + while (<@hashes>) { + my $message = $_; + my $data = $db->select_new($message); + + # Render post + $render .= $t->post($data); + } + $render .= $t->foot(); + + return $render; +} + +# Render new message form +sub send_new { + my ( $self, $echo ) = @_; + my $t = $self->{_template}; + + my $render = $t->head("ii :: Новое сообщение"); + + $render .= $t->new_mes($echo); + $render .= $t->foot(); + + return $render; +} + +# Render send form +sub send { + my ( $self, $hash ) = @_; + my $db = $self->{_db}; + my $t = $self->{_template}; + + my $render = $t->head("ii :: Ответ на $hash"); + + # Render post + my $data = $db->select_new($hash); + + $render .= $t->send($data); + $render .= $t->foot(); + + return $render; +} + +# Render new messages +sub new_mes { + my ( $self, $msgs ) = @_; + my $db = $self->{_db}; + my $t = $self->{_template}; + + my $render = $t->head('ii :: Новые сообщения'); + + # Render posts + if ( defined($msgs) ) { + my @msgs_list = split /\n/, $msgs; + while (<@msgs_list>) { + my $message = $_; + my $data = $db->select_new($message); + + # Render post + $render .= $t->post($data); + } + } + + # else { + # $render .= "

Новых сообщений нет

"; + # } + $render .= $t->foot(); + + return $render; +} + +1; diff --git a/II/Send.pm b/II/Send.pm new file mode 100644 index 0000000..4e4319c --- /dev/null +++ b/II/Send.pm @@ -0,0 +1,41 @@ +package II::Send; + +use HTTP::Request::Common qw(POST); +use LWP::UserAgent; +use II::DB; +use Data::Dumper; + +sub new { + my $class = shift; + + my $self = { + _config => shift, + _echo => shift, + _base64 => shift, + }; + + bless $self, $class; + return $self; +} + +sub send { + my ($self, $hash) = @_; + my $config = $self->{_config}; + my $echo = $self->{_echo}; + my $base64 = $self->{_base64}; + + # Push message to server + my $host = $config->{host}; + my $auth = $config->{key}; + $host .= "u/point"; + my $ua = LWP::UserAgent->new(); + my $response = $ua->post( $host, { 'pauth' => $auth, 'tmsg' => $base64 } ); + print Dumper($response); + + my $db = II::DB->new(); + if ($response->{_rc} == 200) { + $db->update_out($hash); + } +} + +1; diff --git a/II/T.pm b/II/T.pm new file mode 100644 index 0000000..5fb2100 --- /dev/null +++ b/II/T.pm @@ -0,0 +1,169 @@ +package II::T; + +use HTML::Template; +use Data::Dumper; + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + return $self; +} + +sub head { + my ( $self, $title ) = @_; + my $t = HTML::Template->new( filename => 't/head.html' ); + + $t->param( TITLE => $title ); + + return $t->output; +} + +sub index { + my ( $self, $echoareas ) = @_; + my $i = HTML::Template->new( filename => 't/index.html' ); + + my $index = '
'; + while (<@$echoareas>) { + $i->param( ECHO => $_ ); + $index .= $i->output(); + } + $index .= '
'; + + return $index; +} + +sub tree { + my ( $self, $data ) = @_; + + my $p = HTML::Template->new( filename => 't/tree.html' ); + + my $time = localtime( $data->{time} ); + + # my $post = II::T->pre( $data->{post} ); + my $link = $data->{subg}; + $link =~ s/\s/%20/g; + + $p->param( SUBG => "$data->{subg}" ); + $p->param( LINK => $link ); + $p->param( TIME => "$time" ); + $p->param( FROM => $data->{from} ); + + # $p->param( TO => $data->{to} ); + # $p->param( POST => $post ); + $p->param( ECHO => $data->{echo} ); + + return $p->output(); +} + +sub out { + my ( $self, $data ) = @_; + + my $p = HTML::Template->new( filename => 't/out.html' ); + + my $post = II::T->pre( $data->{post} ); + + $p->param( SUBG => $data->{subg} ); + $p->param( TIME => "$time" ); + $p->param( FROM => $data->{from} ); + $p->param( TO => $data->{to} ); + $p->param( POST => $post ); + $p->param( ECHO => $data->{echo} ); + $p->param( BASE64 => $data->{base64} ); + $p->param( HASH => $data->{hash} ); + + return $p->output(); +} + +sub post { + my ( $self, $data ) = @_; + + my $p = HTML::Template->new( filename => 't/post.html' ); + + my $time = localtime( $data->{time} ); + + my $post = II::T->pre( $data->{post} ); + + $p->param( SUBG => $data->{subg} ); + $p->param( TIME => "$time" ); + $p->param( FROM => $data->{from} ); + $p->param( TO => $data->{to} ); + $p->param( POST => $post ); + $p->param( ECHO => $data->{echo} ); + $p->param( HASH => $data->{hash} ); + + return $p->output(); +} + +sub new_mes { + my ($self, $echo) = @_; + + my $n = HTML::Template->new(filename => 't/new.html'); + $n->param(ECHO => $echo); + + return $n->output(); +} + +sub send { + my ( $self, $data ) = @_; + + my $p = HTML::Template->new( filename => 't/send.html' ); + + my $time = localtime( $data->{time} ); + + my $post = II::T->pre( $data->{post} ); + + $data->{subg} =~ s/Re:(.+)/$1/g; + + $p->param( SUBG => $data->{subg} ); + $p->param( TIME => "$time" ); + $p->param( FROM => $data->{from} ); + $p->param( TO => $data->{to} ); + $p->param( POST => $post ); + $p->param( ECHO => $data->{echo} ); + $p->param( HASH => $data->{hash} ); + + return $p->output(); +} + +sub pre { + my ( $self, $post ) = @_; + + $post =~ s//>/g; + $post =~ s/>(.+)/>$1<\/font>
/g; + $post =~ s/^$/
\n/g; + $post =~ s/(.?)\n/$1
\n/g; + $post + =~ s/(https?:\/\/.+\.(jpg|png|gif))/<\/a>/g; + + # Not are regexp parsing + my $pre = 0; + my $txt; + open my $fh, '<', \$post or die $!; + while (<$fh>) { + my $line = $_; + if ( ( $line =~ /^====/ ) and ( $pre == 0 ) ) { + $txt .= $_; + $line =~ s/====/
/g;
+            $pre = 1;
+        }
+        elsif ( ( $line =~ /^====/ ) and ( $pre == 1 ) ) {
+            $line =~ s/====/<\/pre>\n====/g;
+            $pre = 0;
+        }
+        $txt .= $line;
+    }
+    close $fh;
+    return $txt;
+}
+
+sub foot {
+    my ($self) = @_;
+
+    my $f = HTML::Template->new( filename => 't/foot.html' );
+
+    return $f->output();
+}
+
+1;
diff --git a/config.ini b/config.ini
new file mode 100644
index 0000000..34a050c
--- /dev/null
+++ b/config.ini
@@ -0,0 +1,7 @@
+[auth]
+key = you_auth_key
+nick = you_nick
+
+[node]
+host 		= http://your_ii_node.ii
+echoareas 	= im.100
diff --git a/ii.sql b/ii.sql
new file mode 100644
index 0000000000000000000000000000000000000000..2453b766f4fdc4316c2bdb38b7b1732b535fdd64
GIT binary patch
literal 1793024
zcmeI!Ww52yp`hX2fTI#uhI@}6Gh&ai2k*bj_z_DDh7X1e8LU2H
z#9%P}O@qON@6?6$=3p?GvWC|`$B=*i@V}q?8;g7}e2QUn4TcTg9}InC$a_uy`f>bW
z!zY??=9!0{xX$=pcHM8x*h9u2c*yvFyiT~!nwyUrIeOHH(IeN`aMXzT{&94^5%bTt
z_wMtJSa0Leqt+R<`G`$7UvHz4n{PW}gHhX#7`f%>P1f7EyEYoN@#qm7Z&F)sxZ%Ph
z<{PuyUSsDQvDL`U*Iakx=JPMT%mN+T$!Tqo~>u2+G2TBp>>by6K)C)Nq|sXDff
zt7GcuI;xJWBkJ%vtPZV1YJ82WgX^F=u*TK_wSVnb`_|sISM6E*)E>2a?N+9lfu9mH(YnfWAmaHXe@mj1Ftwn0#TBzo#1#5wt
zzvioXYwnt-=BzntM17(@UbEHgHEYdMGu8ApW6e<0)wDHDOcx7wUa8mW)q1_&s5k3N_2qiI-l})%tM!%oTF-3|AV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7{vQbp{bCD$
zI2a6hv7WD|>$!Tio~fs*Ylb{oPt@b}Sbd=$tw-vCdbl2{2kZX&eBE33)!lVZ-Bowi
z?R7`pR=3tI^||_N&oXoK&2??vR5#WQb$wk|*VNT@Rb5$E)a7+)T~?RW#dT3#SQpg!
zb#9$kXV*D(R(+;EU1!$mby}TKr`9QTa-CEs*70>heX5SDW9x`IrjD+o>c~304y!|J
zd>v8;*SI>U4y>`YU+r7_)ZVpM?OA)&nA*K|t6gj7+NE}??Q6%{p*~sL);6_uZB<*=
z=-RF}sx4~s+N?IMO={!Xur{dmYW-Tf)~!*sPOVjI)*3akR~tJW&DQmtGo
z)(W*;EnmylGPQIqRZG?qwRkO7i`F8wa4l2|)&ezu%~$i*JT-UCRdd!HHKIOIAFtU5
zgW(_Tf3}*nX0BOkrkb&)uNi9Eny#j)scWkGSWQ_|)Z{f;O&+Cu%v-)ZMq<&mKsvp)5>ihLU
zyfQQkeWl*1x9hF?a=lpw0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAVA>%lEAPp^oKtj42JAK7z}-~o~|dV<3k^>$Li5~q#mvZ>!Es}?yt|+eRXf$
zRrl20b!XjCx7V$8OMR|BTQ}EDbz|L7*VlD*WnEj>)YWxWT~U|UC3RU{S{K(vbzxml
z=hu04Zk=6c)tU8~`gEOMr_~vCYMoLi)yZ{YolwWuarLP>wvMTz>!>=ij;O=x@S3L%
ztwU;jjjMy}p!&%1z#3Zz)PA*Z?NfW#UbScKQDbVi+P!wIU25mrsdlXGYlqsdwyjUr
z*0oJ-Ra@5R+Pt=?&1&P?v^J^@Ym?fb*01$y-CC#Cu2HpCtyyc-$XdNtt5s{2TDexL
z6>EiBzLu+HYnfWQma4^T$y%Zot3?Nc!3)ic)WWq;El>;Ad^K;)UGvvmHD}FHBkB|N
z@tVD6t66L2nx$r{8Eb}`zNV{bYnqz6rm89HV>LxhUX#_NHE~T+6V-$@K@G2AHME9Q
zk3HmX_1F4K{ki^Bf2=>$@9M)Y`skY9)^F<9^{e`2^_~y;dHte(TtBU!)Q{?i^@I9;
zeNgY$_v*X#o%(ittKO?`*1PqM`g(n>zEWSUck1nWtG--s)|cvydc9t)*XosexnAmd
z4FUuR5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfWZGFf#IKT;SUFcVUN_q^-w)n57hnD`C<3fy>(CBU3b-;bw}M^x7Dq6OMR|B
zTQ}EDbwgcW*VVOkOgYPEj;tf<@H(sxtwU;jjjMy}pgOR|)&aGD
z?N|HOKDBr4ReRPRHKum2-D;QGxpt~uYscE5wy*8#leKMaQ(MYo%JTmapY%g<7_jsikYF
zTC$d?#cQ!zv=*s_YoS`O7O44a-kPuGskv*8nzQDr5%r0hy=JRfYnGb1W~>=%`kJn0
zs%dMQnyRL(kJS`4^-Y7$`fdHDeqFz+U-X`QbnfTXdo%Q>^^^K>{iuFeKdA55`}IM6ufAK~sc+Y}
z>b?4Ay<6X?uhrM&x|KeW~84*X#LutzNBH>g9T=UaS}Dxq7Oet!LV_
zL4W`O0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZ
zfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PJ_}1wI@MhJSA`
znBexht!}Mb>T~tky18zu8|#L;zOJil>e{-huB@x;in_cmt4r&Wy0|W?3+sY9uTHPi
z>ijyl&aSiS%=%27QK!}^b#k3lC)Npde0{2pt7Ge!I=YUkPuDqhWF1k5*I{*N9a7_K
zTpe5o)qyp(4ygTW-`cPCsl98j8dH1L9<_VzR=d_NwNvd}JJt@heQj5ttZi$X+Pb!?
zEo*dbQJdFhwP|fq8`p-lQEgD`*Lt;Xty62)s9LMmtTk$6tzN6ushQY+PRwPLMM
z%h$5COf6kY)Z(>dEmn)xBDGL0Tnp9$HGj=l^VU2ySIu2>)*LmWK2aa9*=x3%wPvZA
zYsQ+Xrmv-HhMKOXt*L98nyRL(kJS`|!LS>fC$GtB(wd|uu8I1L{;he!nxKZ)uo_xJ
zYS8(=)?exm_2>GqeqX<<-_&pGSM}@qQ~j}iSwE{^)KBXt_2c?c{jh#e->(nq=k?v5
z@uPF!sc+YN_04*>zFOa?uh-Y=EA>vjU2oNw>r3@Uy;-lI?O7Jy;La{oxn{2oNAZfB*pk1PBlyK!5-N0t5&U
zAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C7
z2oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N
z0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+
z009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBly
zK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF
z5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk
z1PBlyK!5-N0t5&UAV7cs0RjXF5FkK+009C72oNAZfB*pk1PBlyK!5-N0t5&UAV7cs
z0RsOLf#Ex}%!h-)@cZiCx~J~0yXwxmqi(NT>$dt_-BO>eo9m{!v2LjA>$%2O*&Z=|j>^iePGZ+l}c=KuX={mj6s8j2dI=N1&
z6YGRJzCKmQ)vtv^J|vYNOh?HmnV5{aUxyskLiV
ztygQ+nzcr)UL$L@TD4ZGm20J1u~w+%Yq?ssmdW+)=A~Vti)V
zO;(fEBsFnOUK7?tH9-xlp*5ri)yuHI)nDqb_2>Fi{h>ar-`5}OclF!)P5rulS-+~E
z*U#z~_0#%E{kVQG7!3XBnjhBp>w|i~zE|I^Z`XI~TlHRjv)=8VbDF&bee9fQQgy;t9=Z`XI~yY;<#zdoq%*AME4_2c@{U@-inb3dt{*3ata
z^^5vt{i=Rlzp3BW@9OvU(Yk-AKh~e>&-Iu3YyE97n6O8ia7YcUVKuxas7_2cQB7Qv
z)TA|8OSu32iii`L?`L@ilM*HX1iEnCag3blN#SS!`awMwm8tJUf?veu|IYpohp
zYu7rpZmn1A*9NswZCD%ECbem8R-4xrHM+K}t!nFZC^Xojx4S7PO6jZlsdIetJCYuI;+mEbL!%{q%N(?>WaFmF0ZTWn!2_ws_W{?y1s6x8|$XJ
zxjt97)U9<}-ClRpoppEJRrl1r_4&HL9;gTFp?bK!P>$Q5lzEp44m+P&1yWXk$>WunyeWuQ>^XmM%U|new();
+my $config = $c->load();
+
+my $GET    = II::Get->new($config);
+my $render = II::Render->new();
+
+my $echo = sub {
+    my $env = shift;
+
+    my $req = Plack::Request->new($env);
+
+    my $query = $req->param('echo');
+
+    my $echo_messages = $render->echo_mes($query);
+
+    return [ 200, [ 'Content-type' => 'text/html' ], ["$echo_messages"], ];
+};
+
+my $thread = sub {
+    my $env = shift;
+
+    my $req = Plack::Request->new($env);
+
+    my $subg = $req->param('subg');
+    my $echo = $req->param('echo');
+
+    my $thread = $render->thread( $subg, $echo );
+
+    return [ 200, [ 'Content-type' => 'text/html' ], ["$thread"], ];
+};
+
+my $get = sub {
+    my $msgs    = $GET->get_echo();
+    my $new_mes = $render->new_mes($msgs);
+    return [ 200, [ 'Content-type' => 'text/html' ], ["$new_mes"], ];
+};
+
+my $root = sub {
+    my $index = $render->index($config);
+    return [ 200, [ 'Content-type' => 'text/html' ], [$index], ];
+};
+
+my $me = sub {
+    my $messages = $render->to_me($config);
+    return [ 200, [ 'Content-type' => 'text/html' ], [$messages], ];
+};
+
+my $tree = sub {
+    my $subges = $render->tree($config);
+    return [ 200, [ 'Content-type' => 'text/html' ], ['Дерево'], ];
+};
+
+my $new = sub {
+    my $env = shift;
+
+    my $req  = Plack::Request->new($env);
+    my $echo = $req->param('echo');
+
+    my $send = $render->send_new($echo);
+    return [ 200, [ 'Content-type' => 'text/html' ], [$send], ];
+};
+
+my $send = sub {
+    my $env = shift;
+
+    my $req  = Plack::Request->new($env);
+    my $hash = $req->param('hash');
+    my $send = $render->send($hash);
+
+    return [ 200, [ 'Content-type' => 'text/html' ], [$send], ];
+};
+
+my $enc = sub {
+    my $env = shift;
+
+    my $req = Plack::Request->new($env);
+
+    # Get parameters
+    my $echo = $req->param('echo');
+    my $to   = $req->param('to');
+    my $post = $req->param('post');
+    my $subg = $req->param('subg');
+    my $hash = $req->param('hash');
+    my $time = time();
+
+    print Dumper($config);
+    my $data = {
+        echo => $echo,
+        to   => $to,
+        from => $config->{nick},
+        subg => $subg,
+        post => $post,
+        time => $time,
+        hash => $hash,
+    };
+
+    my $enc = II::Enc->new( $config, $data );
+    $enc->encode() == 0 or die "$!\n";
+
+    return [ 302, [ 'Location' => '/out' ], [], ];
+};
+
+my $out = sub {
+    my $out = $render->out();
+
+    return [ 200, [ 'Content-type' => 'text/html' ], [$out], ];
+};
+
+# Push message to server
+my $push = sub {
+    my $env = shift;
+
+    my $req = Plack::Request->new($env);
+
+    my $echo   = $req->param('echo');
+    my $base64 = $req->param('base64');
+    my $hash   = $req->param('hash');
+
+    my $s = II::Send->new( $config, $echo, $base64 );
+    $s->send($hash);
+
+    my $db = II::DB->new();
+    $db->update_out($hash);
+
+    return [ 302, [ 'Location' => "/e?echo=$echo" ], [], ];
+};
+
+builder {
+    mount '/'     => $root;
+    mount '/e'    => $echo;
+    mount '/s'    => $thread;
+    mount '/me'   => $me;
+    mount '/tree' => $tree;
+    mount '/get/' => $get;
+    mount '/send' => $send;
+    mount '/enc'  => $enc;
+    mount '/out'  => $out;
+    mount '/push' => $push;
+    mount '/new'  => $new;
+};
diff --git a/run.sh b/run.sh
new file mode 100755
index 0000000..0a3677c
--- /dev/null
+++ b/run.sh
@@ -0,0 +1,7 @@
+#!/bin/bash
+
+# Debug server
+plackup iiplc.app
+
+# Production
+# starman -l 127.0.0.1:5000 run.pl whatever
diff --git a/t/foot.html b/t/foot.html
new file mode 100644
index 0000000..691287b
--- /dev/null
+++ b/t/foot.html
@@ -0,0 +1,2 @@
+
+
\ No newline at end of file
diff --git a/t/head.html b/t/head.html
new file mode 100644
index 0000000..bc4472a
--- /dev/null
+++ b/t/head.html
@@ -0,0 +1,112 @@
+
+
+    
+    	<TMPL_VAR NAME=TITLE>
+    	
+    
+    
+    
+
+

+

+ Получить новые сообщения или + почитать свою переписку. А еще + можно вернуться в ленту. +

+
+ diff --git a/t/index.html b/t/index.html new file mode 100644 index 0000000..17fac2b --- /dev/null +++ b/t/index.html @@ -0,0 +1 @@ +>
\ No newline at end of file diff --git a/t/new.html b/t/new.html new file mode 100644 index 0000000..8f7dcd2 --- /dev/null +++ b/t/new.html @@ -0,0 +1,12 @@ +
+
+

+ Тема: + +
+
+ +
+
+
diff --git a/t/out.html b/t/out.html new file mode 100644 index 0000000..82a51e2 --- /dev/null +++ b/t/out.html @@ -0,0 +1,16 @@ +
+

+
+
+ From:
+ To: in +
+
+

+ +

+
+ +
\ No newline at end of file diff --git a/t/post.html b/t/post.html new file mode 100644 index 0000000..9117a76 --- /dev/null +++ b/t/post.html @@ -0,0 +1,16 @@ +
+

+
+
+ From:
+ To: in +
+
+

+ +

+
+ +
\ No newline at end of file diff --git a/t/send.html b/t/send.html new file mode 100644 index 0000000..f1899fd --- /dev/null +++ b/t/send.html @@ -0,0 +1,24 @@ +
+

+
+
+ From:
+ To: in +
+
+

+ +

+
+
+

+ + + +
+
+ +
+
+
diff --git a/t/tree.html b/t/tree.html new file mode 100644 index 0000000..d76632c --- /dev/null +++ b/t/tree.html @@ -0,0 +1,9 @@ +
+   + &echo=> by + + > + + + +
\ No newline at end of file