Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

run perl tidy

  • Loading branch information...
commit a0b2394a1ecbd63188e8b4a7e4f343cf895a6f84 1 parent 000f0bc
@formorer authored
View
21 client.pl
@@ -1,30 +1,31 @@
#!/usr/bin/perl -w
use Frontier::Client;
-use strict;
+use strict;
my $server_url = 'http://paste.debian.net/server.pl';
-my $server = Frontier::Client->new(url => $server_url);
+my $server = Frontier::Client->new( url => $server_url );
# Call the remote server and get our result.
-my $result = $server->call('paste.addShortURL', "http://www.spiegel.de/");
+my $result = $server->call( 'paste.addShortURL', "http://www.spiegel.de/" );
my $statusmessage = $result->{'statusmessage'};
-my $hash = $result->{'hash'};
-my $new_url = $result->{'url'};
-my $rc = $result->{'rc'};
+my $hash = $result->{'hash'};
+my $new_url = $result->{'url'};
+my $rc = $result->{'rc'};
print "$rc - $statusmessage - $hash - $new_url\n";
-$result = $server->call('paste.resolveShortURL', $hash);
+$result = $server->call( 'paste.resolveShortURL', $hash );
$statusmessage = $result->{'statusmessage'};
-$hash = $result->{'hash'};
-my $url = $result->{'url'};
+$hash = $result->{'hash'};
+my $url = $result->{'url'};
$rc = $result->{'rc'};
print "$rc - $statusmessage - $hash - $url\n";
-$result = $server->call('paste.ShortURLClicks', '7g2R5v');
+$result = $server->call( 'paste.ShortURLClicks', '7g2R5v' );
$statusmessage = $result->{'statusmessage'};
my $count = $result->{'count'};
$rc = $result->{'rc'};
print "$rc - $count - $url\n";
+# vim: syntax=perl sw=4 ts=4 noet shiftround
View
658 lib/Paste.pm
@@ -16,19 +16,18 @@
package Paste;
-use strict;
-use warnings;
-use Exporter;
+use strict;
+use warnings;
+use Exporter;
use Config::IniFiles;
-use DBI;
-use Encode;
-use Digest::SHA1 qw(sha1_hex);
+use DBI;
+use Encode;
+use Digest::SHA1 qw(sha1_hex);
use Digest::HMAC_SHA1 qw(hmac_sha1_hex);
use RPC::XML;
use RPC::XML::Client;
-
-use Carp;
+use Carp;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@@ -36,53 +35,56 @@ use vars qw(@ISA @EXPORT);
@EXPORT = qw ();
sub new {
- my $invocant = shift;
- my $class = ref($invocant) || $invocant;
- my $config_file = shift || '';
- croak ("Need a configfile ($config_file)") unless -f $config_file;
- my $config = Config::IniFiles->new( -file => $config_file );
-
- unless ($config) {
- my $error = "$!\n";
- $error .= join("\n", @Config::IniFiles::errors);
- croak "Could not load configfile '$config_file': $error";
- }
-
- my $dbname = $config->val('database', 'dbname') || carp "Databasename not specified in config";
- my $dbuser = $config->val('database', 'dbuser') || carp "Databaseuser not specified in config";
- my $dbpass = $config->val('database', 'dbpassword') || '';
- my $base_url = $config->val('www', 'base_url') || carp "base_url not specified in config";
-
- my $dbh =
- DBI->connect("dbi:Pg:dbname=$dbname", $dbuser, $dbpass,
- { RaiseError => 0, PrintError => 0}) or
- croak "Could not connect to DB: " . $DBI::errstr;
-
- my $self = {
- config => $config,
- dbname => $dbname,
- dbuser => $dbuser,
- dbpass => $dbpass,
- dbh => $dbh,
- @_,
- };
-
- bless ($self, $class);
- return $self;
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my $config_file = shift || '';
+ croak("Need a configfile ($config_file)") unless -f $config_file;
+ my $config = Config::IniFiles->new( -file => $config_file );
+
+ unless ($config) {
+ my $error = "$!\n";
+ $error .= join( "\n", @Config::IniFiles::errors );
+ croak "Could not load configfile '$config_file': $error";
+ }
+
+ my $dbname = $config->val( 'database', 'dbname' )
+ || carp "Databasename not specified in config";
+ my $dbuser = $config->val( 'database', 'dbuser' )
+ || carp "Databaseuser not specified in config";
+ my $dbpass = $config->val( 'database', 'dbpassword' ) || '';
+ my $base_url = $config->val( 'www', 'base_url' )
+ || carp "base_url not specified in config";
+
+ my $dbh =
+ DBI->connect( "dbi:Pg:dbname=$dbname", $dbuser, $dbpass,
+ { RaiseError => 0, PrintError => 0 } )
+ or croak "Could not connect to DB: " . $DBI::errstr;
+
+ my $self = {
+ config => $config,
+ dbname => $dbname,
+ dbuser => $dbuser,
+ dbpass => $dbpass,
+ dbh => $dbh,
+ @_,
+ };
+
+ bless( $self, $class );
+ return $self;
}
sub get_config_key () {
- my ($self, $section, $key) = @_;
- if ($self->{config}->val($section, $key)) {
- return $self->{config}->val($section, $key);
- } else {
- return undef;
- }
+ my ( $self, $section, $key ) = @_;
+ if ( $self->{config}->val( $section, $key ) ) {
+ return $self->{config}->val( $section, $key );
+ } else {
+ return undef;
+ }
}
sub error {
- my $self = shift;
- return $self->{error};
+ my $self = shift;
+ return $self->{error};
}
=pod
@@ -122,115 +124,123 @@ SHA1 of the sessionid which will be used to identify a special user. (optional)
=cut
sub add_paste ($$$$;$$) {
- my ($self, $code, $name, $expire, $lang, $sessionid, $hidden) = @_;
- my $dbh = $self->{dbh};
- $name = $name || 'anonymous';
- $sessionid = $sessionid || '';
- $hidden = $hidden || 'f';
-
- warn $hidden;
- if ($name !~ /^[^;,'"<>]{1,10}$/i) {
- $self->{error} = "Invalid format for name (no special chars, max 10 chars)";
- return 0;
- }
-
- if ($expire !~ /^(-1|[0-9]+)/) {
- $self->{error} = "Expire must be an integer or -1";
- return 0;
- }
-
- if ($sessionid && $sessionid !~ /^[0-9a-f]{40}$/i ) {
- $self->{error} = "Sessionid does not look like a sha1 hex";
- return 0;
- }
- if ($expire > 604800) {
- $self->{error} = 'Expiration time can not be longer than 604800 seconds (7 days)';
- return 0;
- }
-
- my $code_size = length($code);
-
- if ($code_size > 91080) {
- $self->{error} = 'Length of code is not allowed to exceed 90kb';
- return 0;
- }
-
-
- my $newlines = 0;
- my $pos = 0;
- while (1) {
- $pos = index($code, "\n", $pos);
- last if($pos < 0);
- $newlines++;
- $pos++;
- }
-
- if ($newlines <= 1) {
- $self->{error} = 'Thanks to some spammers you need to provide at least 3 or two linebreaks';
- return 0;
- }
-
- my $sth = $dbh->prepare("INSERT INTO paste(poster,posted,code,lang_id,expires,sha1, sessionid, hidden) VALUES(?,now(),?,?,?,?,?,?)");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
-
-
- #replace \r\n with \n
- $code =~ s/\r\n/\n/g;
-
- #we create some kind of digest here. This will be used for "administrative work". Everyone who has this digest can delete the entry.
- #in the future the first 8 or so chars will be used as an accesskeys for "hidden" entrys.
- my $digest = hmac_sha1_hex($code, sha1_hex(time().rand()));
-
- $sth->execute($name,$code,$lang,$expire,$digest,$sessionid,$hidden);
-
- if ($dbh->errstr) {
+ my ( $self, $code, $name, $expire, $lang, $sessionid, $hidden ) = @_;
+ my $dbh = $self->{dbh};
+ $name = $name || 'anonymous';
+ $sessionid = $sessionid || '';
+ $hidden = $hidden || 'f';
+
+ warn $hidden;
+ if ( $name !~ /^[^;,'"<>]{1,10}$/i ) {
+ $self->{error} =
+ "Invalid format for name (no special chars, max 10 chars)";
+ return 0;
+ }
+
+ if ( $expire !~ /^(-1|[0-9]+)/ ) {
+ $self->{error} = "Expire must be an integer or -1";
+ return 0;
+ }
+
+ if ( $sessionid && $sessionid !~ /^[0-9a-f]{40}$/i ) {
+ $self->{error} = "Sessionid does not look like a sha1 hex";
+ return 0;
+ }
+ if ( $expire > 604800 ) {
+ $self->{error} =
+ 'Expiration time can not be longer than 604800 seconds (7 days)';
+ return 0;
+ }
+
+ my $code_size = length($code);
+
+ if ( $code_size > 91080 ) {
+ $self->{error} = 'Length of code is not allowed to exceed 90kb';
+ return 0;
+ }
+
+ my $newlines = 0;
+ my $pos = 0;
+ while (1) {
+ $pos = index( $code, "\n", $pos );
+ last if ( $pos < 0 );
+ $newlines++;
+ $pos++;
+ }
+
+ if ( $newlines <= 1 ) {
+ $self->{error} =
+ 'Thanks to some spammers you need to provide at least 3 or two linebreaks';
+ return 0;
+ }
+
+ my $sth = $dbh->prepare(
+ "INSERT INTO paste(poster,posted,code,lang_id,expires,sha1, sessionid, hidden) VALUES(?,now(),?,?,?,?,?,?)"
+ );
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ #replace \r\n with \n
+ $code =~ s/\r\n/\n/g;
+
+#we create some kind of digest here. This will be used for "administrative work". Everyone who has this digest can delete the entry.
+#in the future the first 8 or so chars will be used as an accesskeys for "hidden" entrys.
+ my $digest = hmac_sha1_hex( $code, sha1_hex( time() . rand() ) );
+
+ $sth->execute( $name, $code, $lang, $expire, $digest, $sessionid,
+ $hidden );
+
+ if ( $dbh->errstr ) {
$self->{error} = "Could not insert paste into db: " . $dbh->errstr;
return 0;
}
-
-
- #We need to get the id from our database so that the caller is able to
- #generate the proper URLs
- my $id;
-
- if ($hidden eq 'f') {
- $sth = $dbh->prepare("SELECT id from paste where sha1 = ?");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
- $sth->execute($digest);
- if ($dbh->errstr) {
- $self->{error} = "Could not retrieve your entry from the paste database: "
- . $dbh->errstr;
- return 0;
- }
- while ( my @row = $sth->fetchrow_array ) {
- $id = $row[0];
- }
- } else {
- $sth = $dbh->prepare("SELECT substring(sha1 FROM 1 FOR 8) AS id from paste where sha1 = ?");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
- $sth->execute($digest);
- if ($dbh->errstr) {
- $self->{error} = "Could not retrieve your entry from the paste database: "
- . $dbh->errstr;
- return 0;
- }
- while ( my @row = $sth->fetchrow_array ) {
- $id = $row[0];
- }
- }
-
- return $id, $digest;
-
+
+ #We need to get the id from our database so that the caller is able to
+ #generate the proper URLs
+ my $id;
+
+ if ( $hidden eq 'f' ) {
+ $sth = $dbh->prepare("SELECT id from paste where sha1 = ?");
+ if ( $dbh->errstr ) {
+ $self->{error} =
+ "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+ $sth->execute($digest);
+ if ( $dbh->errstr ) {
+ $self->{error} =
+ "Could not retrieve your entry from the paste database: "
+ . $dbh->errstr;
+ return 0;
+ }
+ while ( my @row = $sth->fetchrow_array ) {
+ $id = $row[0];
+ }
+ } else {
+ $sth = $dbh->prepare(
+ "SELECT substring(sha1 FROM 1 FOR 8) AS id from paste where sha1 = ?"
+ );
+ if ( $dbh->errstr ) {
+ $self->{error} =
+ "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+ $sth->execute($digest);
+ if ( $dbh->errstr ) {
+ $self->{error} =
+ "Could not retrieve your entry from the paste database: "
+ . $dbh->errstr;
+ return 0;
+ }
+ while ( my @row = $sth->fetchrow_array ) {
+ $id = $row[0];
+ }
+ }
+
+ return $id, $digest;
+
}
=pod
@@ -262,52 +272,55 @@ The ID of the paste entry where the comment belongs to.
=cut
sub add_comment ($$$) {
- my ($self, $comment, $name, $paste_id) = @_;
- my $dbh = $self->{dbh};
- $name = $name || 'anonymous';
-
- if ($name !~ /^[^;,'"]{1,30}/i) {
- $self->{error} = "Invalid format for name (no special chars, max 30 chars)";
- return 0;
- }
-
- #id must be an integer
- if ($paste_id !~ /^[0-9]+$/) {
- $self->{error} = "Invalid id format (must be an integer)";
- }
-
- my $paste_id_ref = $dbh->selectall_arrayref("SELECT id FROM paste WHERE id = '$paste_id'");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
- if (! @{$paste_id_ref}) {
- $self->{error} = "No entry with id '$paste_id' found";
- return 0;
- }
-
- my $sth = $dbh->prepare("INSERT INTO comments(name,text,paste_id,date) VALUES(?,?,?,now())");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
- #replace \r\n with \n
- $comment =~ s/\r\n/\n/g;
-
- #even if it already should be valid UTF-8 encoding again won't harm.
- #Postgresql is a little bit picky about clean UTF-8
- #$comment = encode_utf8($comment);
-
- $sth->execute($name,$comment,$paste_id);
-
- if ($dbh->errstr) {
+ my ( $self, $comment, $name, $paste_id ) = @_;
+ my $dbh = $self->{dbh};
+ $name = $name || 'anonymous';
+
+ if ( $name !~ /^[^;,'"]{1,30}/i ) {
+ $self->{error} =
+ "Invalid format for name (no special chars, max 30 chars)";
+ return 0;
+ }
+
+ #id must be an integer
+ if ( $paste_id !~ /^[0-9]+$/ ) {
+ $self->{error} = "Invalid id format (must be an integer)";
+ }
+
+ my $paste_id_ref = $dbh->selectall_arrayref(
+ "SELECT id FROM paste WHERE id = '$paste_id'");
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ if ( !@{$paste_id_ref} ) {
+ $self->{error} = "No entry with id '$paste_id' found";
+ return 0;
+ }
+
+ my $sth = $dbh->prepare(
+ "INSERT INTO comments(name,text,paste_id,date) VALUES(?,?,?,now())");
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ #replace \r\n with \n
+ $comment =~ s/\r\n/\n/g;
+
+ #even if it already should be valid UTF-8 encoding again won't harm.
+ #Postgresql is a little bit picky about clean UTF-8
+ #$comment = encode_utf8($comment);
+
+ $sth->execute( $name, $comment, $paste_id );
+
+ if ( $dbh->errstr ) {
$self->{error} = "Could not insert comment into db: " . $dbh->errstr;
return 0;
}
-
- return 1;;
+
+ return 1;
}
=pod
@@ -330,35 +343,35 @@ The digest of the entry you want to delete
=cut
-
sub delete_paste ($) {
- my ($self, $sha1) = @_;
- my $dbh = $self->{dbh};
-
- if ($sha1 !~ /^[0-9a-f]{40}$/i ) {
- $self->{error} = "Digest does not look like a sha1 hex";
- return 0;
- }
- my $deleted_id_ref = $dbh->selectall_arrayref("SELECT id from paste where sha1 = '$sha1'");
-
- if (! @{$deleted_id_ref}) {
- $self->{error} = "No entry with digest '$sha1' found";
- return 0;
- }
- my $id = @{@{$deleted_id_ref}[0]}[0];
- my $sth = $dbh->prepare("DELETE from paste where sha1 = ?");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
- $sth->execute($sha1);
-
- if ($dbh->errstr) {
+ my ( $self, $sha1 ) = @_;
+ my $dbh = $self->{dbh};
+
+ if ( $sha1 !~ /^[0-9a-f]{40}$/i ) {
+ $self->{error} = "Digest does not look like a sha1 hex";
+ return 0;
+ }
+ my $deleted_id_ref =
+ $dbh->selectall_arrayref("SELECT id from paste where sha1 = '$sha1'");
+
+ if ( !@{$deleted_id_ref} ) {
+ $self->{error} = "No entry with digest '$sha1' found";
+ return 0;
+ }
+ my $id = @{ @{$deleted_id_ref}[0] }[0];
+ my $sth = $dbh->prepare("DELETE from paste where sha1 = ?");
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ $sth->execute($sha1);
+
+ if ( $dbh->errstr ) {
$self->{error} = "Could not delete paste from db: " . $dbh->errstr;
return 0;
}
- return $id;
+ return $id;
}
=pod
@@ -381,35 +394,35 @@ The id of the comment you want to delete
=cut
-
sub delete_comment ($) {
- my ($self, $id) = @_;
- my $dbh = $self->{dbh};
-
- if ($id !~ /^[0-9]+$/i ) {
- $self->{error} = "ID does not look like an integer";
- return 0;
- }
- my $deleted_comment_ref = $dbh->selectall_arrayref("SELECT id from comments where id = '$id'");
-
- if (! @{$deleted_comment_ref}) {
- $self->{error} = "No entry with id '$id' found";
- return 0;
- }
- $id = @{@{$deleted_comment_ref}[0]}[0];
- my $sth = $dbh->prepare("DELETE from comments where id = ?");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
- $sth->execute($id);
-
- if ($dbh->errstr) {
+ my ( $self, $id ) = @_;
+ my $dbh = $self->{dbh};
+
+ if ( $id !~ /^[0-9]+$/i ) {
+ $self->{error} = "ID does not look like an integer";
+ return 0;
+ }
+ my $deleted_comment_ref =
+ $dbh->selectall_arrayref("SELECT id from comments where id = '$id'");
+
+ if ( !@{$deleted_comment_ref} ) {
+ $self->{error} = "No entry with id '$id' found";
+ return 0;
+ }
+ $id = @{ @{$deleted_comment_ref}[0] }[0];
+ my $sth = $dbh->prepare("DELETE from comments where id = ?");
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ $sth->execute($id);
+
+ if ( $dbh->errstr ) {
$self->{error} = "Could not delete comment from db: " . $dbh->errstr;
return 0;
}
- return $id;
+ return $id;
}
=pod
@@ -434,26 +447,28 @@ The id of the entry you want to retreive
=cut
sub get_paste ($) {
- my ($self, $id) = @_;
- my $dbh = $self->{dbh};
-
- my $sth = $dbh->prepare("SELECT id, poster, to_char(posted, 'YYYY-MM-DD HH24:MI:SS') as posted, code, lang_id, expires, sha1, sessionid from paste where id = ? and hidden is FALSE");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
- $sth->execute($id);
- if ($dbh->errstr){
- $self->{error} = "Could not get paste from db: " . $dbh->errstr;
- return 0;
- }
- my $hash_ref = $sth->fetchrow_hashref;
- if (defined($hash_ref->{code})) {
- return $hash_ref;
- } else {
- return undef;
- }
+ my ( $self, $id ) = @_;
+ my $dbh = $self->{dbh};
+
+ my $sth = $dbh->prepare(
+ "SELECT id, poster, to_char(posted, 'YYYY-MM-DD HH24:MI:SS') as posted, code, lang_id, expires, sha1, sessionid from paste where id = ? and hidden is FALSE"
+ );
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ $sth->execute($id);
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not get paste from db: " . $dbh->errstr;
+ return 0;
+ }
+ my $hash_ref = $sth->fetchrow_hashref;
+ if ( defined( $hash_ref->{code} ) ) {
+ return $hash_ref;
+ } else {
+ return undef;
+ }
}
=pod
@@ -477,76 +492,81 @@ The id of the entry you want to retreive
=cut
sub get_hidden_paste ($) {
- my ($self, $id) = @_;
- my $dbh = $self->{dbh};
-
- my $sth = $dbh->prepare("SELECT id, poster, to_char(posted, 'YYYY-MM-DD HH24:MI:SS') as posted, code, lang_id, expires, sha1, sessionid from paste where substring(sha1 FROM 1 FOR 8) = ?");
- if ($dbh->errstr) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
- $sth->execute($id);
- if ($dbh->errstr){
- $self->{error} = "Could not get paste from db: " . $dbh->errstr;
- return 0;
- }
- my $hash_ref = $sth->fetchrow_hashref;
- if (defined($hash_ref->{code})) {
- return $hash_ref;
- } else {
- return undef;
- }
+ my ( $self, $id ) = @_;
+ my $dbh = $self->{dbh};
+
+ my $sth = $dbh->prepare(
+ "SELECT id, poster, to_char(posted, 'YYYY-MM-DD HH24:MI:SS') as posted, code, lang_id, expires, sha1, sessionid from paste where substring(sha1 FROM 1 FOR 8) = ?"
+ );
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ $sth->execute($id);
+ if ( $dbh->errstr ) {
+ $self->{error} = "Could not get paste from db: " . $dbh->errstr;
+ return 0;
+ }
+ my $hash_ref = $sth->fetchrow_hashref;
+ if ( defined( $hash_ref->{code} ) ) {
+ return $hash_ref;
+ } else {
+ return undef;
+ }
}
sub get_langs () {
- my ($self, $id) = @_;
- my $dbh = $self->{dbh};
- my $ary_ref = $dbh->selectall_arrayref("SELECT * from lang", { Slice => {} });
- if ($dbh->errstr) {
- $self->{error} = "Could not get languages vom database: " . $dbh->errstr;
- return 0;
- }
- return $ary_ref;
+ my ( $self, $id ) = @_;
+ my $dbh = $self->{dbh};
+ my $ary_ref =
+ $dbh->selectall_arrayref( "SELECT * from lang", { Slice => {} } );
+ if ( $dbh->errstr ) {
+ $self->{error} =
+ "Could not get languages vom database: " . $dbh->errstr;
+ return 0;
+ }
+ return $ary_ref;
}
sub get_lang ($) {
- my ($self, $lang) = @_;
- my $dbh = $self->{dbh};
+ my ( $self, $lang ) = @_;
+ my $dbh = $self->{dbh};
- my $lang_id_ref = $dbh->selectall_arrayref("SELECT lang_id from lang where \"desc\" = '$lang'");
+ my $lang_id_ref = $dbh->selectall_arrayref(
+ "SELECT lang_id from lang where \"desc\" = '$lang'");
- if ($dbh->errstr) {
+ if ( $dbh->errstr ) {
$self->{error} = "Could not execute db statement: " . $dbh->errstr;
return 0;
}
-
- if (! @{$lang_id_ref}) {
+
+ if ( !@{$lang_id_ref} ) {
$self->{error} = "Language $lang not found";
return 0;
}
- my $id = @{@{$lang_id_ref}[0]}[0];
- return $id;
+ my $id = @{ @{$lang_id_ref}[0] }[0];
+ return $id;
}
sub check_ip ($) {
- my $ip = shift;
- my $rbl = Net::RBLClient->new(
- max_time => 0.5,
- lists => [ 'dnsbl.njabl.org',
- 'no-more-funn.moensted.dk',
- 'spammers.v6net.org',
- 'proxies.monkeys.com'
- ],
-
- );
- $rbl->lookup($ip);
- my @listed_by = $rbl->listed_by;
-
- return 1 if @listed_by;
- return 0;
+ my $ip = shift;
+ my $rbl = Net::RBLClient->new(
+ max_time => 0.5,
+ lists => [
+ 'dnsbl.njabl.org', 'no-more-funn.moensted.dk',
+ 'spammers.v6net.org', 'proxies.monkeys.com'
+ ],
+
+ );
+ $rbl->lookup($ip);
+ my @listed_by = $rbl->listed_by;
+
+ return 1 if @listed_by;
+ return 0;
}
1;
# vim: syntax=perl sw=4 ts=4 noet shiftround
+# vim: syntax=perl sw=4 ts=4 noet shiftround
View
98 lib/Paste/Template/Plugin/Highlight.pm
@@ -1,4 +1,4 @@
-#Perl Template toolkit pluginText::VimColor
+#Perl Template toolkit pluginText::VimColor
#Copyright (C) 2007 Alexander Wirt <formorer@debian.org>
#
#This program is free software: you can redistribute it and/or modify
@@ -446,78 +446,92 @@ my @langs = qw (
);
push @langs, "Plain";
+
sub init {
my $self = shift;
- $self->{ _DYNAMIC } = 1;
+ $self->{_DYNAMIC} = 1;
# first arg can specify filter name
- $self->install_filter($self->{ _ARGS }->[0] || 'highlight');
+ $self->install_filter( $self->{_ARGS}->[0] || 'highlight' );
return $self;
}
sub filter {
- my ($self, $text, $args, $config) = @_;
+ my ( $self, $text, $args, $config ) = @_;
#merge our caller and init configs
$config = $self->merge_config($config);
+
#then for arguments
$args = $self->merge_args($args);
- if ( ! grep { lc($_) eq lc(@{$args}[0]) } @langs ) {
- die Template::Exception->new( highlight => "@$args[0] is not supported" );
+ if ( !grep { lc($_) eq lc( @{$args}[0] ) } @langs ) {
+ die Template::Exception->new(
+ highlight => "@$args[0] is not supported" );
}
my $digest = sha1_hex($text);
- my $lines = %$config->{'linenumbers'} || 0;
+ my $lines = %$config->{'linenumbers'} || 0;
- if (%$config->{'cache'}) {
- die Template::Exception->new( highlight => "cache_dir not found") unless -d %$config->{'cache_dir'};
+ if ( %$config->{'cache'} ) {
+ die Template::Exception->new( highlight => "cache_dir not found" )
+ unless -d %$config->{'cache_dir'};
- if (-f %$config->{'cache_dir'} . "/$digest-$lines") {
- open (my $fh, '<', %$config->{'cache_dir'} . "/$digest-$lines") or die Template::Exception->new( highlight => "Could not opencache file: $!");
- $text = join("", <$fh>);
- close ($fh);
- return $text;
- }
+ if ( -f %$config->{'cache_dir'} . "/$digest-$lines" ) {
+ open( my $fh, '<', %$config->{'cache_dir'} . "/$digest-$lines" )
+ or die Template::Exception->new(
+ highlight => "Could not opencache file: $!" );
+ $text = join( "", <$fh> );
+ close($fh);
+ return $text;
+ }
}
use Encode qw(from_to);
- my $f = from_to($text, "utf-8", "iso8859-15");
+ my $f = from_to( $text, "utf-8", "iso8859-15" );
- my $fh = tempfile(UNLINK => 1);
- print $fh "$text";
+ my $fh = tempfile( UNLINK => 1 );
+ print $fh "$text";
my $syntax = Text::VimColor->new(
- string => "$text",
- filename => $fh,
- filetype => @$args[0],
+ string => "$text",
+ filename => $fh,
+ filetype => @$args[0],
);
- close ($fh);
- if (exists %$config->{'linenumbers'} && %$config->{'linenumbers'} == 1) {
- $text = "<ol style='list-style-type:decimal' class='synline'>\n";
- foreach my $line (split(/\n/, $syntax->html)) {
- $line = ' ' if $line eq '';
- $text .= "<li class='synline'><pre>$line</pre></li>";
- }
- $text .= "</ol>";
+ close($fh);
+ if ( exists %$config->{'linenumbers'} && %$config->{'linenumbers'} == 1 )
+ {
+ $text = "<ol style='list-style-type:decimal' class='synline'>\n";
+ foreach my $line ( split( /\n/, $syntax->html ) ) {
+ $line = ' ' if $line eq '';
+ $text .= "<li class='synline'><pre>$line</pre></li>";
+ }
+ $text .= "</ol>";
} else {
- $text = "<ol style='list-style-type:none' class='synline'>\n";
- foreach my $line (split(/\n/, $syntax->html)) {
- $line = ' ' if $line eq '';
- $text .= "<li class='synline'><pre>$line</pre></li>";
- }
- $text .= "</ol>";
+ $text = "<ol style='list-style-type:none' class='synline'>\n";
+ foreach my $line ( split( /\n/, $syntax->html ) ) {
+ $line = ' ' if $line eq '';
+ $text .= "<li class='synline'><pre>$line</pre></li>";
+ }
+ $text .= "</ol>";
+ }
+ $f = from_to( $text, "iso8859-15", "utf-8" );
+
+ if ( %$config->{'cache'}
+ && -d %$config->{'cache_dir'}
+ && -w %$config->{'cache_dir'} )
+ {
+ open( my $fh, '>', %$config->{'cache_dir'} . "/$digest-$lines" )
+ or die Template::Exception->new(
+ highlight => "Could not opencache file: $!" );
+ print $fh $text;
+ close($fh);
}
- $f = from_to($text, "iso8859-15", "utf-8");
-
- if (%$config->{'cache'} && -d %$config->{'cache_dir'} && -w %$config->{'cache_dir'}) {
- open (my $fh, '>', %$config->{'cache_dir'} . "/$digest-$lines") or die Template::Exception->new( highlight => "Could not opencache file: $!");
- print $fh $text;
- close($fh);
- }
return $text;
}
1;
+
+# vim: syntax=perl sw=4 ts=4 noet shiftround
View
103 lib/Paste/Template/Plugin/HighlightPygments.pm
@@ -1,4 +1,4 @@
-#Perl Template toolkit pluginText::VimColor
+#Perl Template toolkit pluginText::VimColor
#Copyright (C) 2007 Alexander Wirt <formorer@debian.org>
#
#This program is free software: you can redistribute it and/or modify
@@ -23,83 +23,100 @@ use File::Temp qw (tempfile );
use strict;
-my @langs;
+my @langs;
-open (my $fh, '<', 'langs') or die Template::Exception->new( highlight => "Could not open languagefile: $!");
-while (my $l = <$fh>) {
- chomp($l);
- push @langs, $l;
+open( my $fh, '<', 'langs' )
+ or die Template::Exception->new(
+ highlight => "Could not open languagefile: $!" );
+while ( my $l = <$fh> ) {
+ chomp($l);
+ push @langs, $l;
}
sub init {
my $self = shift;
- $self->{ _DYNAMIC } = 1;
+ $self->{_DYNAMIC} = 1;
# first arg can specify filter name
- $self->install_filter($self->{ _ARGS }->[0] || 'highlight');
+ $self->install_filter( $self->{_ARGS}->[0] || 'highlight' );
return $self;
}
sub filter {
- my ($self, $text, $args, $config) = @_;
+ my ( $self, $text, $args, $config ) = @_;
#merge our caller and init configs
$config = $self->merge_config($config);
+
#then for arguments
$args = $self->merge_args($args);
- if ( ! grep { lc($_) eq lc(@{$args}[0]) } @langs ) {
- die Template::Exception->new( highlight => "@$args[0] is not supported" );
+ if ( !grep { lc($_) eq lc( @{$args}[0] ) } @langs ) {
+ die Template::Exception->new(
+ highlight => "@$args[0] is not supported" );
}
my $digest = sha1_hex($text);
- my $lines = %$config->{'linenumbers'} || 0;
-
- if (%$config->{'cache'}) {
- die Template::Exception->new( highlight => "cache_dir not found") unless -d %$config->{'cache_dir'};
-
- if (-f %$config->{'cache_dir'} . "/$digest-$lines") {
- open (my $fh, '<', %$config->{'cache_dir'} . "/$digest-$lines") or die Template::Exception->new( highlight => "Could not open cache file: $!");
- $text = join("", <$fh>);
- close ($fh);
- return $text;
- }
+ my $lines = %$config->{'linenumbers'} || 0;
+
+ if ( %$config->{'cache'} ) {
+ die Template::Exception->new( highlight => "cache_dir not found" )
+ unless -d %$config->{'cache_dir'};
+
+ if ( -f %$config->{'cache_dir'} . "/$digest-$lines" ) {
+ open( my $fh, '<', %$config->{'cache_dir'} . "/$digest-$lines" )
+ or die Template::Exception->new(
+ highlight => "Could not open cache file: $!" );
+ $text = join( "", <$fh> );
+ close($fh);
+ return $text;
+ }
}
- #print $fh "$text";
+ #print $fh "$text";
- my $lang = @$args[0];
- $lang = ( $lang eq 'Plain') ? 'text' : $lang;
+ my $lang = @$args[0];
+ $lang = ( $lang eq 'Plain' ) ? 'text' : $lang;
use IPC::Run3;
- my $out;
- my $stderr;
-
- my $pygment = '/usr/bin/pygmentize -f html -l "' . $lang . '" -O style=default,classprefix=pygment';
- if (exists %$config->{'linenumbers'} && %$config->{'linenumbers'} == 1) {
- $pygment .= ',linenos=1';
+ my $out;
+ my $stderr;
+
+ my $pygment =
+ '/usr/bin/pygmentize -f html -l "'
+ . $lang
+ . '" -O style=default,classprefix=pygment';
+ if ( exists %$config->{'linenumbers'} && %$config->{'linenumbers'} == 1 )
+ {
+ $pygment .= ',linenos=1';
}
- if (exists %$config->{'style'}) {
- $pygment .= ',style=' . %$config->{'style'};
+ if ( exists %$config->{'style'} ) {
+ $pygment .= ',style=' . %$config->{'style'};
}
- run3 ($pygment, \$text, \$out, \$stderr);
-
+ run3( $pygment, \$text, \$out, \$stderr );
if ($stderr) {
- die Template::Exception->new( highlight => "pymentize error: $out");
+ die Template::Exception->new( highlight => "pymentize error: $out" );
}
- my $text = $out;
-
- if (%$config->{'cache'} && -d %$config->{'cache_dir'} && -w %$config->{'cache_dir'}) {
- open (my $fh, '>', %$config->{'cache_dir'} . "/$digest-$lines") or die Template::Exception->new( highlight => "Could not opencache file: $!");
- print $fh $text;
- close($fh);
- }
+ my $text = $out;
+
+ if ( %$config->{'cache'}
+ && -d %$config->{'cache_dir'}
+ && -w %$config->{'cache_dir'} )
+ {
+ open( my $fh, '>', %$config->{'cache_dir'} . "/$digest-$lines" )
+ or die Template::Exception->new(
+ highlight => "Could not opencache file: $!" );
+ print $fh $text;
+ close($fh);
+ }
return $text;
}
1;
+
+# vim: syntax=perl sw=4 ts=4 noet shiftround
View
250 lib/ShortURL.pm
@@ -16,69 +16,72 @@
package ShortURL;
-use strict;
-use warnings;
-use Exporter;
+use strict;
+use warnings;
+use Exporter;
use Config::IniFiles;
-use DBI;
+use DBI;
use Digest::JHash qw(jhash);
use Encode::Base58;
-
-use Carp;
+use Carp;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw ();
+
sub new {
- my $invocant = shift;
- my $class = ref($invocant) || $invocant;
- my $config_file = shift || '';
- croak ("Need a configfile") unless -f $config_file;
- my $config = Config::IniFiles->new( -file => $config_file );
-
- unless ($config) {
- my $error = "$!\n";
- $error .= join("\n", @Config::IniFiles::errors);
- croak "Could not load configfile '$config_file': $error";
- }
-
- my $dbname = $config->val('database', 'dbname') || carp "Databasename not specified in config";
- my $dbuser = $config->val('database', 'dbuser') || carp "Databaseuser not specified in config";
- my $dbpass = $config->val('database', 'dbpassword') || '';
- my $base_url = $config->val('www', 'base_url') || carp "base_url not specified in config";
-
- my $dbh =
- DBI->connect("dbi:Pg:dbname=$dbname", $dbuser, $dbpass,
- { RaiseError => 0, PrintError => 0}) or
- croak "Could not connect to DB: " . $DBI::errstr;
-
- my $self = {
- config => $config,
- dbname => $dbname,
- dbuser => $dbuser,
- dbpass => $dbpass,
- dbh => $dbh,
- @_,
- };
-
- bless ($self, $class);
- return $self;
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my $config_file = shift || '';
+ croak("Need a configfile") unless -f $config_file;
+ my $config = Config::IniFiles->new( -file => $config_file );
+
+ unless ($config) {
+ my $error = "$!\n";
+ $error .= join( "\n", @Config::IniFiles::errors );
+ croak "Could not load configfile '$config_file': $error";
+ }
+
+ my $dbname = $config->val( 'database', 'dbname' )
+ || carp "Databasename not specified in config";
+ my $dbuser = $config->val( 'database', 'dbuser' )
+ || carp "Databaseuser not specified in config";
+ my $dbpass = $config->val( 'database', 'dbpassword' ) || '';
+ my $base_url = $config->val( 'www', 'base_url' )
+ || carp "base_url not specified in config";
+
+ my $dbh =
+ DBI->connect( "dbi:Pg:dbname=$dbname", $dbuser, $dbpass,
+ { RaiseError => 0, PrintError => 0 } )
+ or croak "Could not connect to DB: " . $DBI::errstr;
+
+ my $self = {
+ config => $config,
+ dbname => $dbname,
+ dbuser => $dbuser,
+ dbpass => $dbpass,
+ dbh => $dbh,
+ @_,
+ };
+
+ bless( $self, $class );
+ return $self;
}
sub get_config_key () {
- my ($self, $section, $key) = @_;
- if ($self->{config}->val($section, $key)) {
- return $self->{config}->val($section, $key);
- } else {
- return undef;
- }
+ my ( $self, $section, $key ) = @_;
+ if ( $self->{config}->val( $section, $key ) ) {
+ return $self->{config}->val( $section, $key );
+ } else {
+ return undef;
+ }
}
sub error {
- my $self = shift;
- return $self->{error};
+ my $self = shift;
+ return $self->{error};
}
=pod
@@ -102,102 +105,109 @@ A http or https url
=cut
sub add_url ($$) {
- my ($self, $url) = @_;
- my $dbh = $self->{dbh};
-
- #simple sanity check TODO improve
- if ($url !~ /^https?/) {
- $self->{'error'} = "Does not look like an URL",
- return 0;
- } elsif ($url =~ /https?:\/\/frm\.li/) {
- $self->{'error'} = "Please don't do recursive URLs";
- return 0;
- } elsif ($url =~ /https?:\/\/paste\.debian\.net/) {
- $self->{'error'} = "Please don't do recursive URLs";
- return 0;
- }
-
- my $hash = encode_base58(Digest::JHash::jhash("$url" . time()));
-
- my $sth = $dbh->prepare("INSERT INTO shorturl (url, hash) VALUES (?,?)");
-
- if ($dbh->err) {
- $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
- return 0;
- }
-
- my $collision = 1;
- while ($collision == 1) {
- $sth->execute($url, $hash);
- if ($dbh->err) {
- if ($dbh->errstr =~ /constraint "shorturl_hash_key"/) {
- $hash = time();
- next;
- } else {
- $self->error = $dbh->errstr;
- return 0;
- }
- }
- $collision = 0;
- }
- #if we are here everything worked
- return $hash;
+ my ( $self, $url ) = @_;
+ my $dbh = $self->{dbh};
+
+ #simple sanity check TODO improve
+ if ( $url !~ /^https?/ ) {
+ $self->{'error'} = "Does not look like an URL", return 0;
+ } elsif ( $url =~ /https?:\/\/frm\.li/ ) {
+ $self->{'error'} = "Please don't do recursive URLs";
+ return 0;
+ } elsif ( $url =~ /https?:\/\/paste\.debian\.net/ ) {
+ $self->{'error'} = "Please don't do recursive URLs";
+ return 0;
+ }
+
+ my $hash = encode_base58( Digest::JHash::jhash( "$url" . time() ) );
+
+ my $sth = $dbh->prepare("INSERT INTO shorturl (url, hash) VALUES (?,?)");
+
+ if ( $dbh->err ) {
+ $self->{error} = "Could not prepare db statement: " . $dbh->errstr;
+ return 0;
+ }
+
+ my $collision = 1;
+ while ( $collision == 1 ) {
+ $sth->execute( $url, $hash );
+ if ( $dbh->err ) {
+ if ( $dbh->errstr =~ /constraint "shorturl_hash_key"/ ) {
+ $hash = time();
+ next;
+ } else {
+ $self->error = $dbh->errstr;
+ return 0;
+ }
+ }
+ $collision = 0;
+ }
+
+ #if we are here everything worked
+ return $hash;
}
sub update_counter ($$) {
- my ($self, $hash) = @_;
- my $dbh = $self->{dbh};
+ my ( $self, $hash ) = @_;
+ my $dbh = $self->{dbh};
- my $rc = $dbh->do('UPDATE shorturl SET clicks = clicks +1 where hash = ?;', undef, $hash);
+ my $rc =
+ $dbh->do( 'UPDATE shorturl SET clicks = clicks +1 where hash = ?;',
+ undef, $hash );
}
sub get_counter ($$) {
- my ($self, $hash) = @_;
- my $dbh = $self->{dbh};
+ my ( $self, $hash ) = @_;
+ my $dbh = $self->{dbh};
- if ($hash =~ /^https?:\/\/frm\.li\/(.*)/) {
- $hash = $1;
- }
+ if ( $hash =~ /^https?:\/\/frm\.li\/(.*)/ ) {
+ $hash = $1;
+ }
- my $count = $dbh->selectall_arrayref("SELECT clicks from shorturl where hash = ?", undef, $hash);
+ my $count = $dbh->selectall_arrayref(
+ "SELECT clicks from shorturl where hash = ?",
+ undef, $hash );
- if ($dbh->err) {
- $self->{error} = "Could not create db statement: " . $dbh->errstr;
- return 0;
- }
+ if ( $dbh->err ) {
+ $self->{error} = "Could not create db statement: " . $dbh->errstr;
+ return 0;
+ }
- if (! @{$count}) {
- $self->{error} = "Hash '$hash' not found in database.";
- return 1;
- }
+ if ( !@{$count} ) {
+ $self->{error} = "Hash '$hash' not found in database.";
+ return 1;
+ }
- return @{@{$count}[0]}[0];
+ return @{ @{$count}[0] }[0];
}
sub get_url ($$) {
- my ($self, $hash) = @_;
- my $dbh = $self->{dbh};
+ my ( $self, $hash ) = @_;
+ my $dbh = $self->{dbh};
- if ($hash =~ /^https?:\/\/frm\.li\/(.*)/) {
- $hash = $1;
- }
+ if ( $hash =~ /^https?:\/\/frm\.li\/(.*)/ ) {
+ $hash = $1;
+ }
- my $url_ref = $dbh->selectall_arrayref("SELECT url from shorturl where hash = ?", undef, $hash);
+ my $url_ref =
+ $dbh->selectall_arrayref( "SELECT url from shorturl where hash = ?",
+ undef, $hash );
- if ($dbh->err) {
- $self->{error} = "Could not create db statement: " . $dbh->errstr;
- return 0;
- }
+ if ( $dbh->err ) {
+ $self->{error} = "Could not create db statement: " . $dbh->errstr;
+ return 0;
+ }
- if (! @{$url_ref}) {
- $self->{error} = "Hash '$hash' not found in database.";
- return 0;
- }
+ if ( !@{$url_ref} ) {
+ $self->{error} = "Hash '$hash' not found in database.";
+ return 0;
+ }
- return @{@{$url_ref}[0]}[0];
+ return @{ @{$url_ref}[0] }[0];
}
1;
# vim: syntax=perl sw=4 ts=4 noet shiftround
+# vim: syntax=perl sw=4 ts=4 noet shiftround
View
729 paste.pl
@@ -16,14 +16,13 @@
#You should have received a copy of the GNU Affero General Public License
#along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-use strict;
+use strict;
use lib 'lib/';
use warnings;
use CGI qw(:standard);
use Template;
use POSIX;
-use CGI::Carp qw(fatalsToBrowser);
+use CGI::Carp qw(fatalsToBrowser);
use CGI::Cookie;
use Digest::SHA1 qw (sha1_hex);
use Paste;
@@ -31,390 +30,434 @@
use subs qw(error);
+my $template = Template->new(
+ { INCLUDE_PATH => 'templates',
+ PLUGIN_BASE => 'Paste::Template::Plugin',
+ }
+);
-my $template = Template->new ( { INCLUDE_PATH => 'templates', PLUGIN_BASE => 'Paste::Template::Plugin', } );
-
-
-my $config_file = 'paste.conf';
+my $config_file = 'paste.conf';
my $paste;
-eval {
- $paste = new Paste($config_file);
-};
-error("Fatal Error", $@) if $@;
+eval { $paste = new Paste($config_file); };
+error( "Fatal Error", $@ ) if $@;
-my $shorturl;
+my $shorturl;
-eval {
- $shorturl = new ShortURL($config_file);
-};
-error("Fatal Error", $@) if $@;
+eval { $shorturl = new ShortURL($config_file); };
+error( "Fatal Error", $@ ) if $@;
-my $dbname = $paste->get_config_key('database', 'dbname') || die "Databasename not specified";
-my $dbuser = $paste->get_config_key('database', 'dbuser') || die "Databaseuser not specified";
-my $dbpass = $paste->get_config_key('database', 'dbpassword') || '';
-#config
-my $base_url = $paste->get_config_key('www', 'base_url');
-my $short_base = $paste->get_config_key('shorturl', 'base_url');
+my $dbname = $paste->get_config_key( 'database', 'dbname' )
+ || die "Databasename not specified";
+my $dbuser = $paste->get_config_key( 'database', 'dbuser' )
+ || die "Databaseuser not specified";
+my $dbpass = $paste->get_config_key( 'database', 'dbpassword' ) || '';
+#config
+my $base_url = $paste->get_config_key( 'www', 'base_url' );
+my $short_base = $paste->get_config_key( 'shorturl', 'base_url' );
my $cgi = new CGI();
-
-if ($cgi->param("plain")) {
- print_plain($cgi);
-} elsif ($cgi->param("plainh")) {
- print_plain($cgi,1);
-} elsif ($cgi->param("download")) {
- print_download($cgi);
-} elsif ($cgi->param("downloadh")) {
- print_download($cgi,1);
-} elsif ($cgi->param("show")) {
- print_show($cgi);
-} elsif ($cgi->param("hidden")) {
- print_show($cgi,1);
-} elsif ($cgi->param("delete")){
- print_delete($cgi);
-} elsif ($cgi->param("comment")) {
- print_add_comment($cgi);
-} elsif ($cgi->param("show_template")) {
- print_template($cgi);
-} elsif ($cgi->param("shorturl")) {
- print_shorturl($cgi);
-} elsif ($cgi->param("addurl")) {
- add_shorturl($cgi);
+if ( $cgi->param("plain") ) {
+ print_plain($cgi);
+} elsif ( $cgi->param("plainh") ) {
+ print_plain( $cgi, 1 );
+} elsif ( $cgi->param("download") ) {
+ print_download($cgi);
+} elsif ( $cgi->param("downloadh") ) {
+ print_download( $cgi, 1 );
+} elsif ( $cgi->param("show") ) {
+ print_show($cgi);
+} elsif ( $cgi->param("hidden") ) {
+ print_show( $cgi, 1 );
+} elsif ( $cgi->param("delete") ) {
+ print_delete($cgi);
+} elsif ( $cgi->param("comment") ) {
+ print_add_comment($cgi);
+} elsif ( $cgi->param("show_template") ) {
+ print_template($cgi);
+} elsif ( $cgi->param("shorturl") ) {
+ print_shorturl($cgi);
+} elsif ( $cgi->param("addurl") ) {
+ add_shorturl($cgi);
} else {
- print_paste($cgi);
+ print_paste($cgi);
}
exit;
sub add_shorturl {
- my ($cgi) = @_;
- my $url = $cgi->param("addurl");
-
- my $hash = $shorturl->add_url($url);
- if ($shorturl->error) {
- error("Could not add url", "Could not add url $url: " . $shorturl->error() );
- }
- print_header();
- $template->process('shorturl_info', { "dbname" => "dbi:Pg:dbname=$dbname",
- "dbuser" => $dbuser,
- "dbpass" => $dbpass,
- "base_url" => $base_url,
- "short_base" => $short_base,
- "hash" => $hash,
- "cgi" => $cgi
- }
- ) or die $template->error() . "\n";
+ my ($cgi) = @_;
+ my $url = $cgi->param("addurl");
+
+ my $hash = $shorturl->add_url($url);
+ if ( $shorturl->error ) {
+ error( "Could not add url",
+ "Could not add url $url: " . $shorturl->error() );
+ }
+ print_header();
+ $template->process(
+ 'shorturl_info',
+ { "dbname" => "dbi:Pg:dbname=$dbname",
+ "dbuser" => $dbuser,
+ "dbpass" => $dbpass,
+ "base_url" => $base_url,
+ "short_base" => $short_base,
+ "hash" => $hash,
+ "cgi" => $cgi
+ }
+ ) or die $template->error() . "\n";
}
sub print_shorturl {
- my ($cgi) = @_;
- my $hash = $cgi->param("shorturl");
- my $url = $shorturl->get_url($hash);
- if ($shorturl->error) {
- print header('text/plain', '500 Internal Server Error');
- print "Something went wrong: \n";
- print $shorturl->error;
- } elsif ($url) {
- $shorturl->update_counter($hash);
- print $cgi->redirect($url);
- } else {
- print header('text/plain', '404 Not Found');
- print "Move along, nothing to see here...\n";
- }
+ my ($cgi) = @_;
+ my $hash = $cgi->param("shorturl");
+ my $url = $shorturl->get_url($hash);
+ if ( $shorturl->error ) {
+ print header( 'text/plain', '500 Internal Server Error' );
+ print "Something went wrong: \n";
+ print $shorturl->error;
+ } elsif ($url) {
+ $shorturl->update_counter($hash);
+ print $cgi->redirect($url);
+ } else {
+ print header( 'text/plain', '404 Not Found' );
+ print "Move along, nothing to see here...\n";
+ }
}
+
sub print_plain {
- my ($cgi,$hidden) = (@_);
- my $id = '';
- if ($cgi->param("plain")) {
- $id = $cgi->param("plain");
- #sanitizing
- $id =~ s/[^0-9]+//g;
- } elsif ($cgi->param("plainh")) {
- $id = lc($cgi->param("plainh"));
- $id =~ s/[^0-9a-f]+//g;
- }
- if (! $hidden) {
- $paste = $paste->get_paste($id);
- } else {
- $paste = $paste->get_hidden_paste($id);
- }
- if (! $paste) {
- error("Entry not found", "Your requested paste entry '$id' could not be found");
- }
- print "Content-type: text/plain\r\n\r\n";
- print $paste->{code};
+ my ( $cgi, $hidden ) = (@_);
+ my $id = '';
+ if ( $cgi->param("plain") ) {
+ $id = $cgi->param("plain");
+
+ #sanitizing
+ $id =~ s/[^0-9]+//g;
+ } elsif ( $cgi->param("plainh") ) {
+ $id = lc( $cgi->param("plainh") );
+ $id =~ s/[^0-9a-f]+//g;
+ }
+ if ( !$hidden ) {
+ $paste = $paste->get_paste($id);
+ } else {
+ $paste = $paste->get_hidden_paste($id);
+ }
+ if ( !$paste ) {
+ error( "Entry not found",
+ "Your requested paste entry '$id' could not be found" );
+ }
+ print "Content-type: text/plain\r\n\r\n";
+ print $paste->{code};
}
sub print_download {
- my ($cgi,$hidden) = (@_);
- my $id = '';
- if ($cgi->param("download")) {
- $id = $cgi->param("download");
- #sanitizing
- $id =~ s/[^0-9]+//g;
- } elsif ($cgi->param("downloadh")) {
- $id = lc($cgi->param("downloadh"));
- $id =~ s/[^0-9a-f]//g;
- } else {
- print_paste($cgi);
- }
-
- if (! $hidden) {
- $paste = $paste->get_paste($id);
-
- } else {
- $paste = $paste->get_hidden_paste($id);
- }
-
- if (! $paste) {
- error("Entry not found", "Your requested paste entry '$id' could not be found");
+ my ( $cgi, $hidden ) = (@_);
+ my $id = '';
+ if ( $cgi->param("download") ) {
+ $id = $cgi->param("download");
+
+ #sanitizing
+ $id =~ s/[^0-9]+//g;
+ } elsif ( $cgi->param("downloadh") ) {
+ $id = lc( $cgi->param("downloadh") );
+ $id =~ s/[^0-9a-f]//g;
+ } else {
+ print_paste($cgi);
+ }
+
+ if ( !$hidden ) {
+ $paste = $paste->get_paste($id);
+
+ } else {
+ $paste = $paste->get_hidden_paste($id);
+ }
+
+ if ( !$paste ) {
+ error( "Entry not found",
+ "Your requested paste entry '$id' could not be found" );
}
- print "Content-type: text/plain\n";
- print "Content-Transfer-Encoding: text\n";
- print "Content-Disposition: attachment; filename=paste_$id\n";
- print "\r\n";
- print $paste->{code};
+ print "Content-type: text/plain\n";
+ print "Content-Transfer-Encoding: text\n";
+ print "Content-Disposition: attachment; filename=paste_$id\n";
+ print "\r\n";
+ print $paste->{code};
}
sub print_delete {
- my ($cgi) = (@_);
- my $digest = '';
- if ($cgi->param("delete")) {
- $digest = $cgi->param("delete");
- } else {
- print_paste($cgi);
- }
-
- my $id = $paste->delete_paste($digest);
- if (! $paste->error) {
- print_header();
- $template->process('show_message', { "dbname" => "dbi:Pg:dbname=$dbname",
- "dbuser" => $dbuser,
- "dbpass" => $dbpass,
- "title" => "Entry $id deleted",
- "message" => "The entry with the id $id has been deleted.",
- "round" => sub { return floor(@_); },
- "base_url" => $base_url,
- }
- ) or die $template->error() . "\n";
- } else {
- error("Entry could not be deleted", $paste->error);
- }
-}
+ my ($cgi) = (@_);
+ my $digest = '';
+ if ( $cgi->param("delete") ) {
+ $digest = $cgi->param("delete");
+ } else {
+ print_paste($cgi);
+ }
+ my $id = $paste->delete_paste($digest);
+ if ( !$paste->error ) {
+ print_header();
+ $template->process(
+ 'show_message',
+ { "dbname" => "dbi:Pg:dbname=$dbname",
+ "dbuser" => $dbuser,
+ "dbpass" => $dbpass,
+ "title" => "Entry $id deleted",
+ "message" => "The entry with the id $id has been deleted.",
+ "round" => sub { return floor(@_); },
+ "base_url" => $base_url,
+ }
+ ) or die $template->error() . "\n";
+ } else {
+ error( "Entry could not be deleted", $paste->error );
+ }
+}
sub print_add_comment {
- my ($cgi) = (@_);
-
- my $error;
- my $comment = $cgi->param("comment") or $error = "Please add a comment";
- my $paste_id = $cgi->param("paste_id") or $error = "No Paste id found";
- my $name = $cgi->param("poster") || "anonymous";
-
- if ($error) {
- error ("Could not add comment: <br>\n". $error);
- }
-
- my $digest;
-
- $paste->add_comment($comment, $name, $paste_id);
- if (! $paste->error) {
- print_header();
- $template->process('show', { "dbname" => "dbi:Pg:dbname=$dbname",
- "dbuser" => $dbuser,
- "dbpass" => $dbpass,
- "show" => $paste_id,
- "status" => "Your comment has been added to paste entry $paste_id.",
- "round" => sub { return floor(@_); },
- "base_url" => $base_url,
- }
- ) or die $template->error() . "\n";
- } else {
- error("Comment could not be added", $paste->error);
- }
+ my ($cgi) = (@_);
+
+ my $error;
+ my $comment = $cgi->param("comment") or $error = "Please add a comment";
+ my $paste_id = $cgi->param("paste_id") or $error = "No Paste id found";
+ my $name = $cgi->param("poster") || "anonymous";
+
+ if ($error) {
+ error( "Could not add comment: <br>\n" . $error );
+ }
+
+ my $digest;
+
+ $paste->add_comment( $comment, $name, $paste_id );
+ if ( !$paste->error ) {
+ print_header();
+ $template->process(
+ 'show',
+ { "dbname" => "dbi:Pg:dbname=$dbname",
+ "dbuser" => $dbuser,
+ "dbpass" => $dbpass,
+ "show" => $paste_id,
+ "status" =>
+ "Your comment has been added to paste entry $paste_id.",
+ "round" => sub { return floor(@_); },
+ "base_url" => $base_url,
+ }
+ ) or die $template->error() . "\n";
+ } else {
+ error( "Comment could not be added", $paste->error );
+ }
}
sub print_template {
- my ($cgi,$status) = (@_);
- my $tmpl;
- my @templates = qw(about clients shorturl_info shorturl_add);
-
- if ($cgi->param("show_template")) {
- $tmpl = $cgi->param("show_template");
- if (! grep /^$tmpl$/, @templates)
- {
- error("Page not found", "Page not found");
- }
- }
- print_header();
- $template->process($tmpl, { "dbname" => "dbi:Pg:dbname=$dbname",
- "dbuser" => $dbuser,
- "dbpass" => $dbpass,
- "base_url" => $base_url,
- "short_base" => $short_base,
- "round" => sub { return floor(@_); },
- "cgi" => $cgi
- }
- ) or die $template->error() . "\n";
+ my ( $cgi, $status ) = (@_);
+ my $tmpl;
+ my @templates = qw(about clients shorturl_info shorturl_add);
+
+ if ( $cgi->param("show_template") ) {
+ $tmpl = $cgi->param("show_template");
+ if ( !grep /^$tmpl$/, @templates ) {
+ error( "Page not found", "Page not found" );
+ }
+ }
+ print_header();
+ $template->process(
+ $tmpl,
+ { "dbname" => "dbi:Pg:dbname=$dbname",
+ "dbuser" => $dbuser,
+ "dbpass" => $dbpass,
+ "base_url" => $base_url,
+ "short_base" => $short_base,
+ "round" => sub { return floor(@_); },
+ "cgi" => $cgi
+ }
+ ) or die $template->error() . "\n";
}
-
sub print_show {
- my ($cgi,$hidden) = (@_);
- my $id = '';
- my $status;
- my $lines = 1;
- if ($cgi->param("show")) {
- $id = $cgi->param("show");
- #sanitizing
- $id =~ s/[^0-9]+//g;
- } elsif ($cgi->param("hidden")) {
- $id = lc($cgi->param("hidden"));
- $id =~ s/[^0-9a-f]//g;
- }
- if (defined($cgi->param("lines"))) {
- $lines = $cgi->param("lines");
- }
- print_header();
- my $tmpl_name = $hidden ? "hidden" : "show";
-
- $template->process($tmpl_name, { "dbname" => "dbi:Pg:dbname=$dbname",
- "dbuser" => $dbuser,
- "dbpass" => $dbpass,
- "show" => $id,
- "status" => $status,
- "lines" => $lines,
- "round" => sub { return floor(@_); },
- "base_url" => $base_url,
- }
- ) or die $template->error() . "\n";
+ my ( $cgi, $hidden ) = (@_);
+ my $id = '';
+ my $status;
+ my $lines = 1;
+ if ( $cgi->param("show") ) {
+ $id = $cgi->param("show");
+
+ #sanitizing
+ $id =~ s/[^0-9]+//g;
+ } elsif ( $cgi->param("hidden") ) {
+ $id = lc( $cgi->param("hidden") );
+ $id =~ s/[^0-9a-f]//g;
+ }
+ if ( defined( $cgi->param("lines") ) ) {
+ $lines = $cgi->param("lines");
+ }
+ print_header();
+ my $tmpl_name = $hidden ? "hidden" : "show";
+
+ $template->process(
+ $tmpl_name,
+ { "dbname" => "dbi:Pg:dbname=$dbname",
+ "dbuser" => $dbuser,
+ "dbpass" => $dbpass,
+ "show" => $id,
+ "status" => $status,
+ "lines" => $lines,
+ "round" => sub { return floor(@_); },
+ "base_url" => $base_url,
+ }
+ ) or die $template->error() . "\n";
}
sub print_paste {
- my ($cgi,$status) = (@_);
- my $code;
- if ($cgi->param("upload")) {
- my $filename = $cgi->upload("upload");
- while (<$filename>) {
- $code .= $_;
- }
- } elsif ($cgi->param("code")) {
- $code = $cgi->param("code");
- }
-
- my $statusmessage;
-
- my $hidden;
-
- if ($cgi->param("private")) {
- $hidden = 't';
- } else {
- $hidden = 'f';
- }
-
- my $pnew;
- if ($cgi->param("pnew")) {
- $pnew = $cgi->param("pnew");
- #sanitizing
- $pnew =~ s/[^0-9]//g;
- }
-
- if ($code) {
- #okay we have a new entry
- #no name? ok
- my $name;
- if (! $cgi->param("poster")) {
- $name = "anonymous";
- } else {
- $name = $cgi->param("poster");
- }
-
- my $session_id = $cgi->param('session_id') || sha1_hex (rand() . time());
-
- my ($id, $digest) = $paste->add_paste($code,$name,$cgi->param("expire"),$cgi->param("lang"), $session_id, $hidden);
- if ($paste->error) {
- $statusmessage .= "Could not add your entry to the paste database:<br><br>\n";
- $statusmessage .= "<b>" . $paste->error . "</b><br>\n";
- } else {
- if ($cgi->param("remember")) {
- my $cookie_lang = new CGI::Cookie(-name=>'paste_lang',
- -value=> $cgi->param("lang"),
- -expires=> '+2M',
- );
- my $cookie_expire = new CGI::Cookie(-name=>'paste_expire',
- -value=> $cgi->param("expire"),
- -expires=> '+2M',
- );
- my $cookie_name = new CGI::Cookie(-name=>'paste_name',
- -value=> $name,
- -expires=> '+2M',
- );
- my $session = new CGI::Cookie(-name=>'session_id',
- -expires=> '+1M',
- -value=> $session_id,
- );
- my %header;
- warn "oben $hidden";
- if ($hidden eq 'f') {
- %header = (-cookie=>[$cookie_lang, $cookie_expire, $cookie_name, $session], -location => "$id/");
- } else {
- %header = (-cookie=>[$cookie_lang, $cookie_expire, $cookie_name, $session], -location => "hidden/$id/");
- }
- print_header(\%header);
- } else {
- my $session = new CGI::Cookie(-name=>'session_id',
- -expires=> '+1M',
- -value=> $session_id,
- );
- my %header;
-
- warn "unten $hidden";
- if ($hidden eq 'f') {
- %header = (-cookie=>[$session], -location=>"$id/");
- } else {
-
- %header = (-cookie=>[$session], -location=>"hidden/$id/");
- }
- print_header(\%header);
- }
- return;
- }
- }
- print_header();
- my $as_hidden = $cgi->param("as_hidden") ? 1 : 0 ;
- $template->process('paste', { "dbname" => "dbi:Pg:dbname=$dbname",
- "dbuser" => $dbuser,
- "dbpass" => $dbpass,
- "status" => $statusmessage,
- "pnew" => $pnew,
- "base_url" => $base_url,
- "as_hidden" => $as_hidden,
- "round" => sub { return floor(@_); },
- }
- ) or die $template->error() . "\n";
-
-}
+ my ( $cgi, $status ) = (@_);
+ my $code;
+ if ( $cgi->param("upload") ) {
+ my $filename = $cgi->upload("upload");
+ while (<$filename>) {
+ $code .= $_;
+ }
+ } elsif ( $cgi->param("code") ) {
+ $code = $cgi->param("code");
+ }
+
+ my $statusmessage;
+
+ my $hidden;
+
+ if ( $cgi->param("private") ) {
+ $hidden = 't';
+ } else {
+ $hidden = 'f';
+ }
+
+ my $pnew;
+ if ( $cgi->param("pnew") ) {
+ $pnew = $cgi->param("pnew");
+
+ #sanitizing
+ $pnew =~ s/[^0-9]//g;
+ }
+
+ if ($code) {
+
+ #okay we have a new entry
+ #no name? ok
+ my $name;
+ if ( !$cgi->param("poster") ) {
+ $name = "anonymous";
+ } else {
+ $name = $cgi->param("poster");
+ }
+
+ my $session_id = $cgi->param('session_id')
+ || sha1_hex( rand() . time() );
+
+ my ( $id, $digest ) =
+ $paste->add_paste( $code, $name, $cgi->param("expire"),
+ $cgi->param("lang"), $session_id, $hidden );
+ if ( $paste->error ) {
+ $statusmessage
+ .= "Could not add your entry to the paste database:<br><br>\n";
+ $statusmessage .= "<b>" . $paste->error . "</b><br>\n";
+ } else {
+ if ( $cgi->param("remember") ) {
+ my $cookie_lang = new CGI::Cookie(
+ -name => 'paste_lang',
+ -value => $cgi->param("lang"),
+ -expires => '+2M',
+ );
+ my $cookie_expire = new CGI::Cookie(
+ -name => 'paste_expire',
+ -value => $cgi->param("expire"),
+ -expires => '+2M',
+ );
+ my $cookie_name = new CGI::Cookie(
+ -name => 'paste_name',
+ -value => $name,
+ -expires => '+2M',
+ );
+ my $session = new CGI::Cookie(
+ -name => 'session_id',
+ -expires => '+1M',
+ -value => $session_id,
+ );
+ my %header;
+ warn "oben $hidden";
+ if ( $hidden eq 'f' ) {
+ %header = (
+ -cookie => [
+ $cookie_lang, $cookie_expire,
+ $cookie_name, $session
+ ],
+ -location => "$id/"
+ );
+ } else {
+ %header = (
+ -cookie => [
+ $cookie_lang, $cookie_expire,
+ $cookie_name, $session
+ ],
+ -location => "hidden/$id/"
+ );
+ }
+ print_header( \%header );
+ } else {
+ my $session = new CGI::Cookie(
+ -name => 'session_id',
+ -expires => '+1M',
+ -value => $session_id,
+ );
+ my %header;
+
+ warn "unten $hidden";
+ if ( $hidden eq 'f' ) {
+ %header = ( -cookie => [$session], -location => "$id/" );
+ } else {
+
+ %header =
+ ( -cookie => [$session], -location => "hidden/$id/" );
+ }
+ print_header( \%header );
+ }
+ return;
+ }
+ }
+ print_header();
+ my $as_hidden = $cgi->param("as_hidden") ? 1 : 0;
+ $template->process(
+ 'paste',
+ { "dbname" => "dbi:Pg:dbname=$dbname",
+ "dbuser" => $dbuser,
+ "dbpass" => $dbpass,
+ "status" => $statusmessage,
+ "pnew" => $pnew,
+ "base_url" => $base_url,
+ "as_hidden" => $as_hidden,
+ "round" => sub { return floor(@_); },
+ }
+ ) or die $template->error() . "\n";
+
+}
sub error ($$) {
- my ($title,$errormessage) = @_;
- print_header();
- $template->process('show_message', { "dbname" => "dbi:Pg:dbname=$dbname",
- "dbuser" => $dbuser,
- "dbpass" => $dbpass,
- "title" => $title,
- "message" => $errormessage,
- "round" => sub { return floor(@_); },
- "base_url" => $base_url,