out template

II/Config.pm

@@ -15,15 +15,16 @@ sub new {
 sub load {
     my ($self) = @_;
     my $file = $self->{_file};
-    
+
     my $tiny = Config::Tiny->new();
     $config = $tiny->read($file);
-    
+
     my $key       = $config->{auth}->{key};
     my $nick      = $config->{auth}->{nick};
     my $host      = $config->{node}->{host};
     my @echoareas = split /,/, $config->{node}->{echoareas};
     my $name      = $config->{node}->{name};
+    my $notify    = $config->{notify}->{enabled};
 
     $c = {
         nick      => $nick,
@@ -31,6 +32,7 @@ sub load {
         host      => $host,
         echoareas => [@echoareas],
         name      => $name,
+        notify    => $notify,
     };
 
     return $c;
@@ -40,7 +42,7 @@ sub load {
 sub reload {
     my ($self) = @_;
 
-    my $c = II::Config->new();
+    my $c      = II::Config->new();
     my $config = $c->load();
 
     return $config;

II/DB.pm

@@ -2,6 +2,7 @@ package II::DB;
 
 use SQL::Abstract;
 use DBI;
+use utf8;
 
 use Data::Dumper;
 
@@ -20,6 +21,7 @@ sub new {
     return $self;
 }
 
+# Check message hash
 sub check_hash {
     my ( $self, $hash, $echo ) = @_;
     my $dbh = $self->{_dbh};
@@ -32,13 +34,13 @@ sub check_hash {
         my ($base_hash) = @h;
         if ( $hash eq $base_hash ) {
             return 1;
-        }
-        else {
+        } else {
             return 0;
         }
     }
 }
 
+# Begin transaction
 sub begin {
     my ($self) = @_;
     my $dbh = $self->{_dbh};
@@ -47,6 +49,7 @@ sub begin {
     $dbh->do('BEGIN');
 }
 
+# Commit transaction
 sub commit {
     my ($self) = @_;
     my $dbh = $self->{_dbh};
@@ -80,6 +83,16 @@ sub write_out {
     print "Message writed to DB!\n";
 }
 
+sub del_out {
+		my ( $self, $hash ) = @_;
+		my $dbh = $self->{_dbh};
+
+		my $q = "delete from output where hash='$hash' and send=0";
+		my $sth = $dbh->prepare($q);
+		$sth->execute();
+		$sth->finish();
+}
+
 sub update_out {
     my ( $self, $hash ) = @_;
     my $dbh = $self->{_dbh};
@@ -262,7 +275,7 @@ sub echoes {
             time => $time,
             echo => "$echo",
             post => "$post",
-            h    => $h,
+            hash => $h,
         };
         push( @posts, $data );
     }
@@ -279,7 +292,7 @@ sub to_me {
     # print "NICK: $nick\n";
 
     my $q
-        = "select from_user, to_user, subg, time, echo, post, hash from messages where to_user='$nick'";
+        = "select from_user, to_user, subg, time, echo, post, hash from messages where to_user='$nick' order by time desc";
 
     my $sth = $dbh->prepare($q);
     $sth->execute();
@@ -330,4 +343,36 @@ sub select_new {
     return $data;
 }
 
+# Search
+sub do_search {
+    my ( $self, $query ) = @_;
+    my $dbh = $self->{_dbh};
+
+    my $q = "select from_user, to_user, subg, time, echo, post, hash
+        from messages where subg
+        like '\%$query\%' COLLATE NOCASE
+        order by time";
+
+    print "SQL: " . $q . "\n";
+    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;
+}
+
 1;

II/Get.pm

@@ -145,6 +145,12 @@ sub get_echo {
         # Commit transaction
         $db->commit();
         print localtime() . ": messages writed to DB!\n";
+
+        # Notify 
+        my @notify_cmd = ('notify-send', 'Сеть ii', 'Есть новые сообщения');
+        if ($notify == 1) {
+            system(@notify_cmd) == 0 or warn "Cannot send notify: $!\n";
+        }
     }
     return $msgs;
 }

II/Render.pm

@@ -8,9 +8,9 @@ use Data::Dumper;
 sub new {
     my $class = shift;
 
-    my $db = II::DB->new();
-    my $t  = II::T->new();
-    my $c  = II::Config->new();
+    my $db     = II::DB->new();
+    my $t      = II::T->new();
+    my $c      = II::Config->new();
     my $config = $c->load();
 
     my $self = {
@@ -25,14 +25,14 @@ sub new {
 
 sub thread {
     my ( $self, $subg, $echo ) = @_;
-    my $db = $self->{_db};
-    my $t  = $self->{_template};
+    my $db     = $self->{_db};
+    my $t      = $self->{_template};
     my $config = $self->{_config};
 
     my @post = $db->thread( $subg, $echo );
 
     # Render header
-    my $render = $t->head("ii ". $config->{name} ." :: $echo");
+    my $render = $t->head( "ii " . $config->{name} . " :: $echo" );
     my $count  = 0;
     while ( $count < @post ) {
         $render .= $t->post( @post[$count] );
@@ -54,7 +54,9 @@ sub out {
 
     # Render header
     my $render
-        = $t->head('ii '. $config->{name} .' :: неотправленные сообщения');
+        = $t->head( 'ii '
+            . $config->{name}
+            . ' :: неотправленные сообщения' );
 
     my $count = 0;
     while ( $count < @post ) {
@@ -69,14 +71,14 @@ sub out {
 
 sub echo_mes {
     my ( $self, $echo, $view ) = @_;
-    my $db = $self->{_db};
-    my $t  = $self->{_template};
+    my $db     = $self->{_db};
+    my $t      = $self->{_template};
     my $config = $self->{_config};
 
     my @post = $db->echoes($echo);
 
     # Render header
-    my $render = $t->head("ii ". $config->{name} ." :: $echo");
+    my $render = $t->head( "ii " . $config->{name} . " :: $echo" );
     $render .= $t->echo($echo);
 
     my $count = 0;
@@ -91,11 +93,23 @@ sub echo_mes {
             $count++;
         }
     }
-    else {
+    elsif ( $view eq 'all' ) {
         while ( $count < @post ) {
+
+            # Render post
+            if ( !( @post[$count]->{subg} =~ /Re.+/ ) ) {
+                $render .= $t->post( @post[$count] );
+            }
+
+            $count++;
+        }
+    }
+    else {
+        while ( ( $count < @post ) and ( $count < 50 ) ) {
             $render .= $t->post( @post[$count] );
             $count++;
         }
+        $render .= $t->all($echo);
     }
     $render .= $t->foot();
 
@@ -105,15 +119,16 @@ sub echo_mes {
 
 sub to_me {
     my ( $self, $config ) = @_;
-    my $db = $self->{_db};
-    my $t  = $self->{_template};
+    my $db     = $self->{_db};
+    my $t      = $self->{_template};
     my $config = $self->{_config};
 
     my @post         = $db->to_me($config);
     my @post_from_me = $db->from_me($config);
 
     # Render header
-    my $render = $t->head('ii '. $config->{name} .' :: Моя переписка');
+    my $render = $t->head(
+        'ii ' . $config->{name} . ' :: Моя переписка' );
 
     my $count = 0;
     while ( $count < @post ) {
@@ -143,7 +158,7 @@ sub index {
     my @hashes = $db->select_index(50);
 
     # Render header
-    my $render = $t->head('ii '. $config->{name} .' :: Лента');
+    my $render = $t->head( 'ii ' . $config->{name} . ' :: Лента' );
     $render .= $t->index($echoareas);
 
     while (<@hashes>) {
@@ -161,13 +176,15 @@ sub index {
 # Messages from user
 sub user {
     my ( $self, $user ) = @_;
-    my $db = $self->{_db};
-    my $t  = $self->{_template};
+    my $db     = $self->{_db};
+    my $t      = $self->{_template};
     my $config = $self->{_config};
 
     # Render header
     my $render
-        = $t->head("ii ". $config->{name} ." :: Сообщения пользователя $user");
+        = $t->head( "ii "
+            . $config->{name}
+            . " :: Сообщения пользователя $user" );
 
     my @post = $db->select_user($user);
 
@@ -185,10 +202,11 @@ sub user {
 # Render new message form
 sub send_new {
     my ( $self, $echo ) = @_;
-    my $t = $self->{_template};
+    my $t      = $self->{_template};
     my $config = $self->{_config};
 
-    my $render = $t->head("ii ". $config->{name} ." :: Новое сообщение");
+    my $render = $t->head(
+        "ii " . $config->{name} . " :: Новое сообщение" );
 
     $render .= $t->new_mes($echo);
     $render .= $t->foot();
@@ -199,11 +217,12 @@ sub send_new {
 # Render send form
 sub send {
     my ( $self, $hash ) = @_;
-    my $db = $self->{_db};
-    my $t  = $self->{_template};
+    my $db     = $self->{_db};
+    my $t      = $self->{_template};
     my $config = $self->{_config};
 
-    my $render = $t->head("ii". $config->{name} ." :: Ответ на $hash");
+    my $render
+        = $t->head( "ii" . $config->{name} . " :: Ответ на $hash" );
 
     # Render post
     my $data = $db->select_new($hash);
@@ -217,11 +236,12 @@ sub send {
 # Render new messages
 sub new_mes {
     my ( $self, $msgs ) = @_;
-    my $db = $self->{_db};
-    my $t  = $self->{_template};
+    my $db     = $self->{_db};
+    my $t      = $self->{_template};
     my $config = $self->{_config};
 
-    my $render = $t->head('ii '. $config->{name} .' :: Новые сообщения');
+    my $render = $t->head(
+        'ii ' . $config->{name} . ' :: Новые сообщения' );
 
     # Render posts
     if ( defined($msgs) ) {
@@ -243,4 +263,26 @@ sub new_mes {
     return $render;
 }
 
+# Search results
+sub search {
+    my ( $self, @post ) = @_;
+    my $t = $self->{_template};
+
+    # Render header
+    my $render
+        = $t->head(
+        "ii " . $config->{name} . " :: Результаты поиска" );
+
+    my $count = 0;
+    while ( $count < @post ) {
+
+        # Render post
+        $render .= $t->post( @post[$count] );
+        $count++;
+    }
+    $render .= $t->foot();
+
+    return $render;
+}
+
 1;

II/Send.pm

@@ -31,7 +31,7 @@ sub send {
     my $host = $config->{host};
     my $auth = $config->{key};
     $host .= "u/point";
-    my $ua = LWP::UserAgent->new();
+    my $ua = LWP::UserAgent->new(agent => 'Mozilla/5.0 (X11; Linux x86_64; rv:35.0) Gecko/20100101 Firefox/35.0');
     my $response
         = $ua->post( $host, { 'pauth' => $auth, 'tmsg' => $base64 } );
 

II/T.pm

@@ -1,6 +1,8 @@
 package II::T;
 
 use HTML::Template;
+use HTML::FromText ();
+use Encode;
 use Data::Dumper;
 
 sub new {
@@ -147,7 +149,7 @@ sub send {
 
 # Preparsing before input to SQL
 sub in_pre {
-    my ($self, $post) = @_;
+    my ( $self, $post ) = @_;
 
     $post =~ s/'/\\'/g;
     $post =~ s/"/\\"/g;
@@ -162,23 +164,38 @@ sub in_pre {
 sub pre {
     my ( $self, $post ) = @_;
 
-    $post =~ s/</&lt;/g;
-    $post =~ s/>/&gt;/g;
+    my $t2h = HTML::FromText->new(
+        {   paras     => 1,
+            bullets   => 1,
+            lines     => 1,
+            blockcode => 1,
+            tables    => 0,
+            numbers   => 0,
+            urls      => 0,
+            email     => 1,
+            bold      => 1,
+            underline => 1,
+        }
+    );
+
+    $post = $t2h->parse( decode_utf8($post) );
     $post =~ s/&gt;(.+)/<font color='green'>>$1<\/font>/g;
     $post =~ s/--/&mdash;/g;
-    $post =~ s/.?\*(.+)\*.?/&nbsp<b>$1<\/b>&nbsp/g;
-    
-    # Images
-    $post =~ s/\[img (.+)\]/<a href="$1"><img src="$1" width="15%" height="15%" \/><\/a>/g;
-    
-    # ii uri
-    $post =~ s/ii:\/\/(.{20})/<a href="\/send?hash=$1">$1<\/a>/g;
-    # $post =~ s/ii:\/\/(.+\.\d+)/<a href="\/e?echo=$1&view=thread">$1<\/a>/g;
 
-    $post =~ s/^$/<br>\n/g;
-    $post =~ s/(.?)\n/$1<br>\n/g;
-    $post =~ s/\*(.+)/<li>$1<\/li>\n/g;
-    
+    # Lists
+    $post =~ s/\*(.+)/<li>$1<\/li>/g;
+
+    # Images
+    $post
+        =~ s/\[img (.+)\]/<a href="$1"><img src="$1" width="15%" height="15%" \/><\/a>/g;
+
+    # ii uri
+    $post =~ s/ii:\/\/(\w+(\.)?\w+\.\d{2,4})/<a href="\/e?echo=$1&view=thread">$1<\/a>/g;
+    $post =~ s/ii:\/\/(\w{20})/<a href="\/send?hash=$1">$1<\/a>/g;
+
+    # Users
+    # $post =~ s/.+? \@(\w+)(.?.+)/<a href="\/u?user=$1">$1<\/a>$2/g;
+
     # Not are regexp parsing
     my $pre = 0;
     my $txt;
@@ -186,7 +203,7 @@ sub pre {
     while (<$fh>) {
         my $line = $_;
         if ( ( $line =~ /^====/ ) and ( $pre == 0 ) ) {
-            # $txt .= $_;
+
             $line =~ s/====/<pre class="pre">/g;
             $pre = 1;
         }
@@ -195,12 +212,27 @@ sub pre {
             $pre = 0;
         }
         $txt .= $line;
+        $txt =~ s/<br \/>//g if $pre == 1;
+        $txt =~ s/<li>//g if $pre == 1;
+        $txt =~ s/<\/li>//g if $pre == 1;
+        $txt =~ s/<font.+>(>.+)<\/font>/$1/g if $pre == 1;
     }
     close $fh;
-    
+    $txt =~ s/\n/<br>/g;
+
     return $txt;
 }
 
+# All messages footer
+sub all {
+    my ( $self, $echo ) = @_;
+
+    my $a = HTML::Template->new( filename => 't/all.html' );
+    $a->param( ECHO => $echo );
+
+    return $a->output();
+}
+
 # Footer
 sub foot {
     my ($self) = @_;

README.md

@@ -19,13 +19,9 @@ Install packages.
 On Debian based systems:
 	
 	apt-get install libplack-perl libhtml-template-perl libsql-abstract-perl \
-	libdbd-sqlite3-perl libconfig-tiny-perl
+	libdbd-sqlite3-perl libconfig-tiny-perl libhtml-fromtext-perl
 
 ## Run
 
 	cd /path/to/iiplc
 	./run.sh
-
-## TODO
-
-* Check link before send

iiplc.app

@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# Copyright © 2014 Difrex <difrex.punk@gmail.com>
+# Copyright © 2014-2015 Difrex <difrex.punk@gmail.com>
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation, either version 3 of the License, or
@@ -19,6 +19,7 @@ use warnings;
 use Plack::Builder;
 use Plack::Request;
 use Plack::Response;
+
 # Static files
 use Plack::App::File;
 
@@ -29,13 +30,9 @@ use II::Render;
 use II::DB;
 use II::Enc;
 
-# Debug
-use Data::Dumper;
-
 my $c      = II::Config->new();
 my $config = $c->load();
 
-my $GET    = II::Get->new($config);
 my $render = II::Render->new();
 
 my $echo = sub {
@@ -64,8 +61,21 @@ my $thread = sub {
     return [ 200, [ 'Content-type' => 'text/html' ], ["$thread"], ];
 };
 
+# Get new messages
 my $get = sub {
-    my $msgs    = $GET->get_echo();
+    $config = $c->reload();
+    my $msgs;
+    if ( $config->{host} =~ m/.+\,.+/ ) {
+        my @hosts = split( /,/, $config->{host} );
+        foreach my $host (@hosts) {
+            $config->{host} = $host;
+            my $GET = II::Get->new($config);
+            $msgs   .= $GET->get_echo();
+        }
+    } else {
+        my $GET = II::Get->new($config);
+        $msgs   .= $GET->get_echo();
+    }
     my $new_mes = $render->new_mes($msgs);
     return [ 200, [ 'Content-type' => 'text/html' ], ["$new_mes"], ];
 };
@@ -155,6 +165,10 @@ my $push = sub {
     my $hash   = $req->param('hash');
 
     $config = $c->reload();
+    if ( $config->{host} =~ m/.+\,.+/ ) {
+        my @hosts = split( /,/, $config->{host} );
+        $config->{host} = $hosts[0];
+    }
     my $s = II::Send->new( $config, $echo, $base64 );
     $s->send($hash);
 
@@ -175,19 +189,51 @@ my $user = sub {
     return [ 200, [ 'Content-type' => 'text/html' ], [$mes_from], ];
 };
 
+# Search
+########
+my $search = sub {
+    my $env = shift;
+
+    my $req   = Plack::Request->new($env);
+    my $query = $req->param('q');
+
+    my $db     = II::DB->new();
+    my @post = $db->do_search($query);
+
+    my $result = $render->search(@post);
+
+    return [ 200, [ 'Content-type' => 'text/html' ], [$result], ];
+};
+
+# Delete out message
+####################
+my $del = sub {
+		my $env = shift;
+
+		my $req = Plack::Request->new($env);
+		my $hash = $req->param('hash');
+
+		my $db = II::DB->new();
+		$db->del_out($hash);
+
+		return [301, ['Location' => '/out'], [], ];
+};
+
 # Mountpoints
 builder {
-    mount "/static" => Plack::App::File->new(root => './s/')->to_app;
-    mount '/'     => $root;
-    mount '/e'    => $echo;
-    mount '/s'    => $thread;
-    mount '/u'    => $user;
-    mount '/me'   => $me;
-    mount '/tree' => $tree;
-    mount '/get/' => $get;
-    mount '/send' => $send;
-    mount '/enc'  => $enc;
-    mount '/out'  => $out;
-    mount '/push' => $push;
-    mount '/new'  => $new;
+    mount "/static" => Plack::App::File->new( root => './s/' )->to_app;
+    mount "/search" => $search;
+    mount '/'       => $root;
+    mount '/e'      => $echo;
+    mount '/s'      => $thread;
+    mount '/u'      => $user;
+    mount '/me'     => $me;
+    mount '/tree'   => $tree;
+    mount '/get/'   => $get;
+    mount '/send'   => $send;
+    mount '/enc'    => $enc;
+    mount '/out'    => $out;
+    mount '/push'   => $push;
+    mount '/new'    => $new;
+		mount '/del'    => $del;
 };

run.sh

@@ -2,6 +2,7 @@
 
 # Debug server
 screen -S ii plackup iiplc.app
+# plackup iiplc.app
 
 # Production
 # starman -l 127.0.0.1:5000 run.pl whatever

s/css/default.css

@@ -39,6 +39,15 @@ padding-bottom: 0.15em;
   padding-left: 5pt;
   padding-top: 5pt;
 }
+.msg_hash {
+  float: right;
+  margin-right: 1.5em;
+  margin-top: 2em;
+  color: #222;
+  opacity: 0.4;
+  font-family: monospace;
+  font-size: 8pt;
+}
 .subg a {
   color: #222;
 }
@@ -148,4 +157,35 @@ margin-bottom: 0%;
   border-color: #666;
   background-color: #C9C9C9;
   margin-right: 5%;
+}
+.all_link {
+  display: block;
+  border-style: solid;
+  border-width: 1px;
+  border-color: #999;
+  border-radius: 5px;
+  background-color: #C9C9C9;
+  box-shadow: 0 0 5px rgba(0, 0, 0, 0.7);
+  text-align: center;
+  text-decoration: underline;
+  font-size: 12pt;
+  color: #222;
+  width: 8em;
+  padding: 0.2em;
+  margin-left: 45%;
+  margin-right: 55%;
+}
+/* Search */
+.search {
+  position: fixed;
+  top: 2em;
+  left: 0.5em;
+  opacity: 0.4;
+  transition-duration: 0.5s;
+  -webkit-transition-duration: 0.5s;
+}
+.search:hover {
+  opacity: 1;
+  transition-duration: 0.5s;
+  -webkit-transition-duration: 0.5s;
 }

t/all.html

@@ -0,0 +1,3 @@
+<a class='all_link' href="e?echo=<TMPL_VAR NAME=ECHO>&view=all">
+		Все сообщения
+</a>

t/head.html

@@ -15,4 +15,10 @@
     <b>[</b> <a href="/out">неотправленные сообщения</a> <b>]</b>&nbsp
   </p>
 </div>
+<div class='search'>
+  <form action='/search' method='POST'>
+    <input type='text' name='q'><br>
+    <input type='submit' value='Искать'>
+  </form>
+</div>
 <!-- <hr> -->

t/out.html

@@ -12,5 +12,6 @@
 	</div>
 	<div class=answer>
 		<a href="/push?echo=<TMPL_VAR NAME=ECHO>&base64=<TMPL_VAR NAME=BASE64>&hash=<TMPL_VAR NAME=HASH>">Отправить</a>
+		<a href="/del?hash=<TMPL_VAR NAME=HASH>">Удалить</a>
 	</div>
-</div>
+</div>

t/post.html

@@ -1,4 +1,7 @@
 <div class=post>
+	<div class='msg_hash'>
+		MsgID: <TMPL_VAR NAME=HASH>
+	</div>
 	<a style="text-decoration:none;" href="/s?subg=<TMPL_VAR NAME=CUT>&echo=<TMPL_VAR NAME=ECHO>"><h2><TMPL_VAR NAME=SUBG></h2></a>
 	<div class=mail>
 		<i><TMPL_VAR NAME=TIME></i><br>
@@ -13,4 +16,4 @@
 	<div class=answer>
 		<a href="/send?hash=<TMPL_VAR NAME=HASH>">Ответить на сообщение</a>
 	</div>
-</div>
+</div>