out template

II/DB.pm

@@ -34,8 +34,7 @@ sub check_hash {
         my ($base_hash) = @h;
         if ( $hash eq $base_hash ) {
             return 1;
-        }
+        } else {
-        else {
             return 0;
         }
     }
@@ -84,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};
@@ -339,9 +348,9 @@ sub do_search {
     my ( $self, $query ) = @_;
     my $dbh = $self->{_dbh};
 
-    my $q = "select from_user, to_user, subg, time, echo, post, hash 
+    my $q = "select from_user, to_user, subg, time, echo, post, hash
-        from messages where subg 
+        from messages where subg
-        like '\%$query\%' COLLATE NOCASE 
+        like '\%$query\%' COLLATE NOCASE
         order by time";
 
     print "SQL: " . $q . "\n";

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

@@ -194,7 +194,7 @@ sub pre {
     $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;
+    # $post =~ s/.+? \@(\w+)(.?.+)/<a href="\/u?user=$1">$1<\/a>$2/g;
 
     # Not are regexp parsing
     my $pre = 0;
@@ -218,6 +218,7 @@ sub pre {
         $txt =~ s/<font.+>(>.+)<\/font>/$1/g if $pre == 1;
     }
     close $fh;
+    $txt =~ s/\n/<br>/g;
 
     return $txt;
 }

README.md

@@ -19,7 +19,7 @@ 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
 

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
@@ -30,9 +30,6 @@ use II::Render;
 use II::DB;
 use II::Enc;
 
-# Debug
-use Data::Dumper;
-
 my $c      = II::Config->new();
 my $config = $c->load();
 
@@ -75,8 +72,7 @@ my $get = sub {
             my $GET = II::Get->new($config);
             $msgs   .= $GET->get_echo();
         }
-    }
+    } else {
-    else {
         my $GET = II::Get->new($config);
         $msgs   .= $GET->get_echo();
     }
@@ -209,6 +205,20 @@ my $search = sub {
     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;
@@ -219,10 +229,11 @@ builder {
     mount '/u'      => $user;
     mount '/me'     => $me;
     mount '/tree'   => $tree;
-    mount '/get'    => $get;
+    mount '/get/'   => $get;
     mount '/send'   => $send;
     mount '/enc'    => $enc;
     mount '/out'    => $out;
     mount '/push'   => $push;
     mount '/new'    => $new;
+		mount '/del'    => $del;
 };

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>