From 285a930dbf5683ccdb8d705bd9fbe001a81fe719 Mon Sep 17 00:00:00 2001 From: PHO Date: Tue, 6 Nov 2012 14:06:03 +0900 Subject: [PATCH 1/1] migrate from GNU arch to Git --- Changes | 6 + Makefile.PL | 37 + README | 40 + README-NLS | 200 +++++ bin/pci-nopaste | 83 +++ lib/POE/Component/IRC/Plugin/NoPaste.pm | 292 ++++++++ lib/POE/Component/IRC/Plugin/NoPaste/DB.pm | 56 ++ lib/POE/Component/IRC/Plugin/NoPaste/Httpd.pm | 217 ++++++ .../IRC/Plugin/NoPaste/Httpd/Index.pm | 296 ++++++++ .../IRC/Plugin/NoPaste/Httpd/Pasted.pm | 127 ++++ lib/POE/Component/IRC/Plugin/NoPaste/Pager.pm | 240 ++++++ .../IRC/Plugin/NoPaste/StaticFile.pm | 48 ++ .../Component/IRC/Plugin/NoPaste/Template.pm | 693 ++++++++++++++++++ .../IRC/Plugin/NoPaste/css/style.css | 120 +++ .../IRC/Plugin/NoPaste/tmpl/error.html | 15 + .../IRC/Plugin/NoPaste/tmpl/index.html | 128 ++++ .../IRC/Plugin/NoPaste/tmpl/pasted.html | 53 ++ misc/nopaste-config-schema.yml | 42 ++ misc/nopaste-db-schema.sql | 14 + po/Makefile.PL | 4 + po/Makefile.in | 92 +++ po/PACKAGE | 17 + po/POTFILES.in | 4 + po/ja.po | 140 ++++ rc.d/linux/pci-nopaste.in | 126 ++++ t/POE-Component-IRC-Plugin-NoPaste.t | 15 + 26 files changed, 3105 insertions(+) create mode 100644 Changes create mode 100644 Makefile.PL create mode 100644 README create mode 100644 README-NLS create mode 100644 bin/pci-nopaste create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/DB.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/Httpd.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/Pager.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/StaticFile.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/Template.pm create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/css/style.css create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/tmpl/error.html create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/tmpl/index.html create mode 100644 lib/POE/Component/IRC/Plugin/NoPaste/tmpl/pasted.html create mode 100644 misc/nopaste-config-schema.yml create mode 100644 misc/nopaste-db-schema.sql create mode 100644 po/Makefile.PL create mode 100644 po/Makefile.in create mode 100644 po/PACKAGE create mode 100644 po/POTFILES.in create mode 100644 po/ja.po create mode 100644 rc.d/linux/pci-nopaste.in create mode 100644 t/POE-Component-IRC-Plugin-NoPaste.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..16a22dc --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension POE::Component::IRC::Plugin::NoPaste. + +0.01 Wed Sep 14 01:22:49 2005 + - original version; created by h2xs 1.23 with options + -X POE::Component::IRC::Plugin::NoPaste + diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..4f151b4 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,37 @@ +#use 5.008006; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'POE::Component::IRC::Plugin::NoPaste', + VERSION_FROM => 'lib/POE/Component/IRC/Plugin/NoPaste.pm', # finds $VERSION + PREREQ_PM => { + Carp => 0, + CGI => 2.69, + DBD::SQLite => 1.08, + DBI => 0, + Encode => 0, + Error => 0, + Exporter => 0, + File::Copy => 0, + File::Spec => 0, + File::stat => 0, + Getopt::Long => 0, + Hash::Util => 0, + HTTP::Status => 0, + Locale::TextDomain => 0, + Net::Domain => 0, + POE::Component::IRC => 4.69, + POE::Component::Server::HTTP => 0.08, + Pod::Usage => 0, + Time::Format => 0, + UNIVERSAL => 0, + URI => 0, + URI::QueryParam => 0, + YAML => 0, + }, + EXE_FILES => [qw(bin/pci-nopaste)], + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/POE/Component/IRC/Plugin/NoPaste.pm', # retrieve abstract from module + AUTHOR => 'phonohawk ') : ()), +); diff --git a/README b/README new file mode 100644 index 0000000..350e537 --- /dev/null +++ b/README @@ -0,0 +1,40 @@ +POE-Component-IRC-Plugin-NoPaste version 0.01 +============================================= + +The README is used to introduce the module and provide instructions on +how to install the module, any machine dependencies it may have (for +example C compilers and installed libraries) and any other information +that should be provided before the module is installed. + +A README file is required for CPAN modules since CPAN extracts the +README file from a module distribution so that people browsing the +archive can use it get an idea of the modules uses. It is usually a +good idea to provide version information here so that people can +decide whether fixes for the module are worth downloading. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + blah blah blah + +COPYRIGHT AND LICENCE + +Put the correct copyright and licence information here. + +Copyright (C) 2005 by Administrador + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.6 or, +at your option, any later version of Perl 5 you may have available. + + diff --git a/README-NLS b/README-NLS new file mode 100644 index 0000000..9f77651 --- /dev/null +++ b/README-NLS @@ -0,0 +1,200 @@ +Notes on National Language Support (NLS) +**************************************** + +This package is internationalized with libintl-perl, a free +internationalization library for Perl, you will need to install a copy of +libintl-perl in order to use the package. You can get libintl-perl from the +Comprehensive Perl Archive Network CPAN at http://www.cpan.org/. + +The following notes are meant to be a quick start guide for somewhat +experienced users and system administrators and many important details had to +be omitted for brevity. If you have any difficulties with the +internationalization features of this package, no matter if you are a +programmer, a translator, or an end user, feel free to ask at the mailing list +for libintl-perl. To do so, send an e-mail to the address + (please replace "AT" with a "@", and "DOT" +with a dot "."). + +You can subscribe to this list at + + http://ml.imperia.org/mailman/listinfo/libintl-perl + +A searchable archive of earlier postings is located at + + http://ml.imperia.org/libintl-perl/ + +You may already find an answer to your question there. + +Feel free to include this document in your own Perl packages internationalized +with libintl-perl, no severe copyright restrictions apply. You should send +corrections or improvements to the author Guido Flohr , so that others can benefit from your changes. + +The End User's View +=================== + +The installation routine for this package will automatically take care that +your system has a sufficient version of libintl-perl installed. This is +basically sufficient for proper operation, but - especially if +internationalized software is new to you - you should read on carefully in +order to fully benefit from the internationalization (I18N) features of this +package. + +Perl Setup +---------- + +The I18N library libintl-perl will run with a wide range of Perl versions (at +least from Perl version 5.005_03 to Perl 5.8.0) but you will experience slight +difference in features and performance depending on the version of Perl you +use. + +With Perl versions prior to 5.7.3 you can use the package for all European +scripts (including those with Greek or Cyrillic scripts), and also for many +scripts used outside Europe, like Arabic, Hebrew, Georgian, Vietnamese or +Thai, more general all scripts using 8 bit charsets. Other scripts are only +available if the translations in this package are provided in Unicode and they +can only be output in Unicode. + +Beginning with Perl 5.7.3 the module Encode became part of the Perl core, and +it offers you a much wider range of possible scripts. If you plan to use some +of the lesser used scripts for Chinese, Japanese, and Korean, you should also +install the module Encode::HanExtra. + +Setting Your Language +--------------------- + +Most modern systems are already prepared and configured for +internationalization, and the user interface of the software you have +installed will already be configured for your preferred language. Packages +internationalized with libintl-perl will honor these configuration settings +and will also operate in your preferred language if the necessary translations +are available. + +The environment variable "LANGUAGE" has the highest precedence for +translations. The most common format for this environment variable is a +(lowercase) two-letter language code and an (uppercase) two-letter country +code separated by an underscore "_", for example: + + LANGUAGE=fr_BE + export LANGUAGE + +This will set your language preferences to French ("fr") for Belgium ("BE"). +Other examples are French for France ("fr_FR"), German for Austria ("de_AT"), +and so on. You can also omit the country part ("FR", "DE", "IT", "RU", ...) +in which case a default setting for the country will be assumed. + +If there are no translations available for your selected languages, the +original message (normally in English) will be displayed. + +You can also define a chain of languages to be tried separated by a colon: + + LANGUAGE=fr_BE:fr_FR:fr:it + +Read this as: "I want translations in French for Belgium. If they are not +available try French for France, then any French translation, and finally +Italian". Please note that this chain notation is only allowed for the +environment variable "LANGUAGE", it is not valid for any of the following +variables. + +If "LANGUAGE" is not set, the library checks the variable "LANG". It has the +same syntax as "LANGUAGE" but does not allow the preferences chain with the +colon syntax. After "LANG" the variable "LC_MESSAGES" (think "locale category +messages") is tried, and finally "LC_ALL". + +Note for Microsoft Windows users: The locale preferences you have configured +for your system cannot yet be evaluated by libintl-perl. This may change for +future versions of libintl-perl but for the moment you have to make do with +the instructions given above. In order to set environment variables, you have +to right-click on the icon "My Computer" on your desktop, select "Properties" +in the context menu, and then click the tab labelled "Environment variables". + +Setting the Output Charset +-------------------------- + +Even if you have managed to properly select your preferred language, you may +still have difficulties reading the program languages, because libintl-perl +was unable to determine the correct charset to use for messages. For example, +it may assume Unicode ("UTF-8") but you really need ISO-Latin-1 (also known as +"Latin-1" or "ISO-8859-1"). If this is the case, please set the environment +variable "OUTPUT_CHARSET" to the appropriate value, for example: + + OUTPUT_CHARSET=iso-8859-1 + export OUTPUT_CHARSET + +Charset names are case-insensitive, i. e. "LATIN-1" is the equivalent to +"Latin-1" or even "lAtIn-1". + +Note: The output charset "utf8" is NOT recognized. Please use the correct +abbreviation "utf-8" (with a hyphen) instead. + +The Translator's View +===================== + +If you want to contribute a new translation to this package, please contact +the author first. Somebody may have already started this translation, and +furthermore the package author will be able to give you detailled instructions +and help. + +Translating a Perl package is not much work and it does not require any +technical skills. If you are able to use the software itself, you will also +be able to contribute a translation for your language. But why should you do +that? You are able to read and understand this text and you will also be able +to understand the English messages that the software spits out by default. + +Computers are an integral part of today's society. Computers are used to +explore new sources of information, forbidding computers would be a modern +form of censorship. Computers may also improve social life, the internet +helps people to find contacts in their area and all over the world, even if +they would otherwise be deprived from that because of a handicap, lack of money +for traveling, or other reasons. In many societies, the ability to use and +handle a computer also has a strong impact on your perspectives in life, you +may not be able to find an adequate job because of your lack of computer +experience, or you may even lose your job because of that. + +Everybody should benefit from computers, regardless of cultural +background. Computers are expansive goods, and their price is already a high +barrier to cross. If computers speak in a foreign language, the learning +curve gets steeper and the barrier gets even higher. You can help the people +that share your native language by contributing a translation. The author of +this package has already prepared everything, the rest is up to you! + +The Programmer's View +===================== + +You have downloaded this package because you want to use it in your own +project(s). The fact that the package is internationalized with libintl-perl +does not affect its usability in any way. But you should keep in mind that +textual messages produced by the package may change according to the locale +settings at run-time. This can lead to errors. For example, if you parse +error messages produced by the package, you will most probably fail to detect +what you are looking for, if these error messages are suddenly presented in +another language or another output charset. + +It is probably needless to say that this is bad practice and an indicator for +a poorly written interface. Either you have missed the correct method for +determining the substance of the message in a locale-independent manner, or +the author of the package has mis-designed the package interface. In any +case, this is a technical problem that should be solved by technicians. You +should not put that burden on the shoulders of your users but rather solve the +problem in cooperation with the author of the module that causes it. + +If this is absolutely impossible, as a temporary workaround you can completely +switch off the native language support of the package by setting the +environment variable "LANGUAGE" to the special value "C": + + BEGIN { + $ENV{LANGUAGE} = $ENV{LANG} = "C"; + } + +The value "C" instructs libintl-perl to leave all messages untouched, and you +can use the package as if it was not internationalized at all. + +If the project you are working on is not yet internationalized, you should +consider to prepare it for internationalization now. Doing so is only little +work for yourself, but results in a large benefit for the users of your +software. The package "libintl-perl" ships with exhaustive documentation for +programmers and a sample package that you can use as a skeleton for your own +project(s). Internationalizing Perl software with libintl-perl is easy, the +package that this file is a part of, prooves that. + +Guido Flohr diff --git a/bin/pci-nopaste b/bin/pci-nopaste new file mode 100644 index 0000000..6a643d6 --- /dev/null +++ b/bin/pci-nopaste @@ -0,0 +1,83 @@ +#!/usr/bin/perl +# -*- cperl -*- +use strict; +use warnings; + +BEGIN { + local $| = 1; + print ".:NoPaste:. loading bunch of modules... "; +} + +use Locale::TextDomain qw(pci-nopaste); +use YAML (); +use Getopt::Long; +use Pod::Usage; +use POE qw( + Component::IRC::State + Component::IRC::Plugin::Connector + Component::IRC::Plugin::NoPaste + ); +use constant ALIAS => 'pci-nopaste'; + +BEGIN { + print "done.\n"; +} + +my %opts; +GetOptions( + 'help|h' => \$opts{help}, + man => \$opts{man}, + 'config|c=s' => \$opts{config}, + ); + +$opts{man} and + pod2usage(-verbose => 2); + +$opts{help} and + pod2usage(-verbose => 1); + +if (not $opts{config}) { + if (-f '/etc/pci-nopaste.yml') { + $opts{config} = '/etc/pci-nopaste.yml'; + } + else { + die __x( + "{process}: option --config= is missing.\n", + process => $0, + ); + } +} + +my $config = YAML::LoadFile($opts{config}); +my $irc = POE::Component::IRC::State->spawn; + +POE::Session->create( + package_states => [ + __PACKAGE__, [ qw(_start _signal_stop) ], + ], + ); + +$poe_kernel->run; +exit 0; + +sub _start { + $_[KERNEL]->alias_set(ALIAS); + #foreach (qw[HUP INT QUIT ABRT TERM]) { +# $_[KERNEL]->sig($_ => '_signal_stop'); +# } + + $irc->plugin_add( + Connector => POE::Component::IRC::Plugin::Connector->new()); + + $irc->plugin_add( + NoPaste => POE::Component::IRC::Plugin::NoPaste->new($config)); +} + +sub _signal_stop { + $_[KERNEL]->sig_handled; + + print STDERR __"Shutdown time has arrived. Telling components to stop...\n"; + + $_[KERNEL]->alias_remove(ALIAS); + $irc->yield('shutdown'); +} diff --git a/lib/POE/Component/IRC/Plugin/NoPaste.pm b/lib/POE/Component/IRC/Plugin/NoPaste.pm new file mode 100644 index 0000000..c6a0666 --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste.pm @@ -0,0 +1,292 @@ +# -*- cperl -*- +package POE::Component::IRC::Plugin::NoPaste; +use strict; +use warnings; +use POE qw( + Component::IRC::Plugin::NoPaste::Httpd + Component::IRC::Plugin::NoPaste::DB + ); +use POE::Component::IRC::Plugin qw(:ALL); +use Encode qw(from_to); +use Locale::TextDomain qw(pci-nopaste); +use URI; +use Net::Domain qw(hostfqdn); +use Hash::Util qw(lock_keys); +our $VERSION = '0.01'; + +#$SIG{__DIE__} = sub { print "$_[0]\n"; }; + +sub new { + my ($class, $config) = @_; + my $this = bless {} => $class; + + $this->{config} = $config; # comes from yaml + + $this->{httpd_alias} = undef; + $this->{irc} = undef; + + $this->{db} = POE::Component::IRC::Plugin::NoPaste::DB->new($config); + + $this->{name_to_channel} = {}; # name => /channels/* + # Note: keys of hash are name of channels which are encoded in + # channel's specific charset, and are lowercased. + foreach my $ch (@{$config->{channels}}) { + my $name = $ch->{name}; + from_to $name, 'UTF-8' => $ch->{charset}; + $this->{name_to_channel}{lc $name} = $ch; + } + + $this->{id_to_channel} = {}; # id => /channels/* + foreach my $ch (@{$config->{channels}}) { + $this->{id_to_channel}{$ch->{id}} = $ch; + } + + lock_keys %$this; + + $this; +} + +sub PCI_register { + my ($this, $irc) = @_; + + $this->{irc} = $irc; + + $this->{httpd_alias} = + POE::Component::IRC::Plugin::NoPaste::Httpd->spawn($this); + + $irc->plugin_register( + $this, + 'SERVER', + qw(001 public), + ); + + $irc->yield( + connect => $this->{config}{irc}); + + return 1; +} + +sub PCI_unregister { + my ($this, $irc) = @_; + + $poe_kernel->post( + $this->{httpd_alias} => 'shutdown'); + + return 1; +} + +sub S_001 { + my ($this, $irc, $line) = @_; + + $this->log(__x( + "connected to {server}:{port}.", + server => $this->{config}{irc}{server}, + port => $this->{config}{irc}{port})); + + foreach my $ch (@{$this->{config}{channels}}) { + my $name = $ch->{name}; + from_to $name, 'UTF-8' => $ch->{charset}; + + $irc->yield( + join => $name); + } + + return PCI_EAT_NONE; +} + +sub S_public { + my ($this, $irc, $from, $to, $msg) = @_; + + local $SIG{__DIE__} = sub { + print STDERR $_[0], "\n"; + }; + + my $mynick = $irc->nick_name; + my $ch = $this->{name_to_channel}{lc $$to->[0]}; + + if ($$msg =~ m/$mynick/i and # Never use /o flag. + defined $ch) { + + local $ENV{LANGUAGE} = $ch->{locale}; + + my $name = $ch->{name}; + from_to $name, 'UTF-8' => $ch->{charset}; + + my $reply = __x( + "{nick}: The NoPaste for {channel} is at {url}", + nick => (split /!/, $$from)[0], + channel => $ch->{name}, + url => do { + my $uri = URI->new; + $uri->scheme('http'); + $uri->host(hostfqdn); + $uri->port($this->{config}{httpd}{port}); + $uri->path("/nopaste/$ch->{id}/"); + $uri->canonical->as_string; + }, + ); + from_to $reply, 'UTF-8' => $ch->{charset}; + + $irc->yield( + privmsg => $name => $reply); + } + + return PCI_EAT_NONE; +} + +sub log { + my ($this, $msg) = @_; + + print STDERR "NoPaste: $msg\n"; +} + +sub pickup_writable { + my ($this, $channel_id, $host) = @_; + + $this->pickup(write => $channel_id, $host); +} + +sub pickup_readable { + my ($this, $channel_id, $host) = @_; + + $this->pickup(read => $channel_id, $host); +} + +sub pickup { + # $what: 'read' or 'write' + my ($this, $what, $channel_id, $host) = @_; + + my $ch = $this->{id_to_channel}{$channel_id}; + $ch or return (); + + my $name = $ch->{name}; + from_to $name, 'UTF-8' => $ch->{charset}; + + my $restrict = $ch->{restriction}{$what}; + grep { + #$this->log("restrict: $restrict, name: $name, nick: $_"); + if (not $this->{irc}->nick_info($_)) { + 0; + } + elsif ($host ne $this->{irc}->nick_info($_)->{Host}) { + 0; + } + elsif ($restrict eq 'op') { + $this->{irc}->is_channel_operator($name, $_); + } + elsif ($restrict eq 'halfop') { + $this->{irc}->is_channel_halfop($name, $_); + } + elsif ($restrict eq 'voice') { + $this->{irc}->has_channel_voice($name, $_); + } + elsif ($restrict eq 'member') { + 1; + } + else { + 0; + } + } $this->{irc}->channel_list($name); +} + +sub gen_unwritable_error { + my ($this, $ch) = @_; + + my $msg = __"Sorry, but you can't paste to this channel;\n"; + + $_ = $ch->{restriction}{write}; + if ($_ eq 'op') { + $msg .= __( + # "it" means "this channel" + "allowed only for those who have op in it."); + } + elsif ($_ eq 'halfop') { + $msg .= __"allowed only for those who have halfop in it."; + } + elsif ($_ eq 'voice') { + $msg .= __"allowed only for those who have voice in it."; + } + elsif ($_ eq 'member') { + $msg .= __"allowed only for those who are in it."; + } + + $msg; +} + +sub gen_unreadable_error { + my ($this, $ch) = @_; + + my $msg = __"Sorry, but you can't read posts pasted to this channel;\n"; + + $_ = $ch->{restriction}{read}; + if ($_ eq 'op') { + $msg .= __( + # "it" means "this channel" + "allowed only for those who have op in it."); + } + elsif ($_ eq 'halfop') { + $msg .= __"allowed only for those who have halfop in it."; + } + elsif ($_ eq 'voice') { + $msg .= __"allowed only for those who have voice in it."; + } + elsif ($_ eq 'member') { + $msg .= __"allowed only for those who are in it."; + } + + $msg; +} + +1; +__END__ + +# Below is stub documentation for your module. You'd better edit it! + +=head1 NAME + +POE::Component::IRC::Plugin::NoPaste - Perl extension for blah blah blah + +=head1 SYNOPSIS + + use POE::Component::IRC::Plugin::NoPaste; + blah blah blah + +=head1 DESCRIPTION + +Stub documentation for POE::Component::IRC::Plugin::NoPaste, created by h2xs. It looks like the +author of the extension was negligent enough to leave the stub +unedited. + +Blah blah blah. + +=head2 EXPORT + +None by default. + + + +=head1 SEE ALSO + +Mention other useful documentation such as the documentation of +related modules or operating system documentation (such as man pages +in UNIX), or any relevant external documentation such as RFCs or +standards. + +If you have a mailing list set up for your module, mention it here. + +If you have a web site set up for your module, mention it here. + +=head1 AUTHOR + +Administrador, Eadmin@apple.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 by Administrador + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.6 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/DB.pm b/lib/POE/Component/IRC/Plugin/NoPaste/DB.pm new file mode 100644 index 0000000..8ef6148 --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/DB.pm @@ -0,0 +1,56 @@ +# -*- cperl -*- +package POE::Component::IRC::Plugin::NoPaste::DB; +use strict; +use warnings; +use DBI; +use Hash::Util qw(lock_keys); + +sub new { + my ($class, $config) = @_; + my $this = bless {} => $class; + + $this->{config} = $config; + $this->{dbh} = DBI->connect( + "dbi:SQLite:dbname=$config->{db}{file}", "", "", { + RaiseError => 1, + AutoCommit => 1, + }); + + lock_keys %$this; + + $this->setup_db; + $this; +} + +sub dbh { + my $this = shift; + + $this->{dbh}; +} + +sub setup_db { + my $this = shift; + + eval { + $this->{dbh}->do(q{ + SELECT * + FROM post + LIMIT 0 + }); + }; + if ($@) { + $this->{dbh}->do(q{ +CREATE TABLE post ( + post_id INTEGER PRIMARY KEY, -- unique id of the post + channel_id VARCHAR(512) NOT NULL, -- id of the channel in ascii + + posted_time INTEGER NOT NULL, -- timestamp in epoch + nick VARCHAR(512) NOT NULL, -- nick of the person who posted this + title BLOB NOT NULL, -- title of the post + body BLOB NOT NULL -- body of the post +); +}); + } +} + +1; diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/Httpd.pm b/lib/POE/Component/IRC/Plugin/NoPaste/Httpd.pm new file mode 100644 index 0000000..366d0fd --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/Httpd.pm @@ -0,0 +1,217 @@ +# -*- cperl -*- +package POE::Component::IRC::Plugin::NoPaste::Httpd; +use strict; +use warnings; +require Exporter; +BEGIN { + # with out this BEGIN block, NoPaste::Httpd::* can't import them by Exporter. + our @ISA = qw(Exporter); + our @EXPORT = qw( + notfound_handler + need_auth_handler + redirect_handler + internal_server_error_handler); +} +use POE qw( + Component::Server::HTTP + Component::IRC::Plugin::NoPaste::Template + Component::IRC::Plugin::NoPaste::StaticFile + Component::IRC::Plugin::NoPaste::Httpd::Index + Component::IRC::Plugin::NoPaste::Httpd::Pasted + ); +use CGI::Pretty qw(:standard); +use HTTP::Status; +use Carp; +use Hash::Util qw(lock_keys); + +sub spawn { + my ($class, $nopaste) = @_; + my $this = bless {} => $class; + + $this->{nopaste} = $nopaste; + + $this->{my_alias} = undef; + $this->{httpd_alias} = undef; + + lock_keys %$this; + + POE::Session->create( + heap => $this, + package_states => [ + __PACKAGE__, [ qw(_start shutdown) ], + ], + ); + + $this->{my_alias}; +} + +sub _start { + my $this = $_[HEAP]; + + $this->{my_alias} = 'PCI::Plugin::NoPaste::Httpd::' . $_[SESSION]->ID; + $_[KERNEL]->alias_set($this->{my_alias}); + + my $barrier = sub { + my $code = $_[0]; + return sub { + my ($req, $resp) = @_; + + local $ENV{OUTPUT_CHARSET} = 'UTF-8'; + + # copy the content of POST to query if needed. + if ($req->method eq 'POST' and + $req->headers->content_type eq 'application/x-www-form-urlencoded' and + !defined $req->uri->query) { + $_ = $req->content; + tr/\x0d\x0a//d; + $req->uri->query($_); + } + + my $last_exception; + my $retval = eval { + local $SIG{__DIE__} = sub { + print $_[0]; + $last_exception = Carp::longmess(@_); + }; + + $code->($this, @_); + }; if ($@) { + $retval = $this->internal_server_error_handler( + $req, $resp, $last_exception); + } + + # complete the response + $resp->code or + $resp->code($retval); + $resp->message or + $resp->message(status_message($resp->code)); + + if (!length $resp->content) { + if ($resp->code >= 200 && $resp->code < 300) { + $retval = $this->internal_server_error_handler( + $req, $resp, 'Content handler did not set any content.'); + } + elsif ($resp->code >= 300 && $resp->code < 400) { + # FIXME: complete a HTML which links to the destination of redirection + } + } + + # default value of Content-Type is text/html + $resp->header('Content-Type') or + $resp->header('Content-Type' => 'text/html; charset=UTF-8'); + + # complete Content-Length + $resp->header('Content-Length') or + $resp->header('Content-Length' => length($resp->content)); + + # remove content if the method is HEAD + if ($req->method eq 'HEAD') { + $resp->content(undef); + } + + return $retval; + }; + }; + + $this->{httpd_alias} = POE::Component::Server::HTTP->new( + Port => $this->{nopaste}{config}{httpd}{port}, + ContentHandler => { + '/' + => $barrier->(\¬found_handler), + '/css/' + => $barrier->(\&css_handler), + '/nopaste/' + => $barrier->(\&POE::Component::IRC::Plugin::NoPaste::Httpd::Index::handler), + '/post/' + => $barrier->(\&POE::Component::IRC::Plugin::NoPaste::Httpd::Index::handler), + '/pasted/' + => $barrier->(\&POE::Component::IRC::Plugin::NoPaste::Httpd::Pasted::handler), + }, + Headers => { + Server => 'PCI::Plugin::NoPaste UI (Powered by PoCo::Server::HTTP)', + Connection => 'close', + }, + )->{httpd}; +} + +sub shutdown { + my $this = $_[HEAP]; + + $_[KERNEL]->alias_remove($this->{my_alias}); + $_[KERNEL]->call($this->{httpd_alias} => 'shutdown'); +} + +sub notfound_handler { + my ($this, $req, $resp) = @_; + my $t = POE::Component::IRC::Plugin::NoPaste::Template->new( + -data => static_file('tmpl/error.html')); + $t->expand( + status_code => '404', + status_message => 'Not Found', + requested_url => ''.$req->uri, + ); + $resp->content($t->str); + return RC_NOT_FOUND; +} + +sub css_handler { + my ($this, $req, $resp) = @_; + (my $path = $req->uri->path) =~ s|^/css/||; + my $content = static_file('css/'.$path); + + if (defined $content) { + $resp->header('Content-Type' => 'text/css; charset=UTF-8'); + $resp->content($content); + return RC_OK; + } + else { + return notfound_handler(@_); + } +} + +sub internal_server_error_handler { + my ($this, $req, $resp, $error) = @_; + + my $style = { + -style => 'white-space: pre;', + }; + + my $html = join '', + start_html( + -title => 'Internal Server Error', + -encoding => 'UTF-8', + ), + h1('Internal Server Error'), + h2('Request'), + p($style, $req->as_string), + h2('Error'), + p($style, $error), + end_html; + + $resp->code(RC_INTERNAL_SERVER_ERROR); + $resp->message(status_message($resp->code)); + $resp->header('Content-Type' => 'text/html; charset=UTF-8'); + $resp->content($html); + return RC_INTERNAL_SERVER_ERROR; +} + +sub redirect_handler { + # $req : HTTP::Request + # $resp: HTTP::Response + # $path: destination of the redirection + # $query_hash: query (can be undef) + my ($this, $req, $resp, $path, $query_hash) = @_; + + $resp->header(Location => do { + my $uri = $req->uri->clone; + $uri->path($path); + $uri->query(undef); + $query_hash and + $uri->query_form_hash($query_hash); + $uri->fragment(undef); + $uri->as_string; + }); + return RC_SEE_OTHER; +} + +1; diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm b/lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm new file mode 100644 index 0000000..207d41b --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm @@ -0,0 +1,296 @@ +# -*- cperl -*- +package POE::Component::IRC::Plugin::NoPaste::Httpd::Index; +use strict; +use warnings; +use POE; +use POE::Component::IRC::Plugin::NoPaste::Httpd; +use POE::Component::IRC::Plugin::NoPaste::StaticFile; +use POE::Component::IRC::Plugin::NoPaste::Pager; +use URI::QueryParam; +use Locale::TextDomain qw(pci-nopaste); +use HTTP::Status; +use Socket; +use Time::Format qw(%time); +use Encode qw(from_to); +use constant NICK_LIMIT => 20; +use constant TITLE_LIMIT => 100; +use constant BODY_LIMIT => 500 * 1024; + +sub handler { + my ($this, $req, $resp) = @_; + + if ($req->uri->path =~ m!^/nopaste/(.+?)/?$! and + $this->{nopaste}{id_to_channel}{$1}) { + return index_handler( + $this, $req, $resp, $this->{nopaste}{id_to_channel}{$1}); + } + elsif ($req->uri->path =~ m!^/post/(.+?)/?$! and + $this->{nopaste}{id_to_channel}{$1}) { + return post_handler( + $this, $req, $resp, $this->{nopaste}{id_to_channel}{$1}); + } + else { + return notfound_handler(@_); + } +} + +sub index_handler { + my ($this, $req, $resp, $ch, $error) = @_; + + local $ENV{LANGUAGE} = $ch->{locale}; + + my $t = POE::Component::IRC::Plugin::NoPaste::Template->new( + -data => static_file('tmpl/index.html')); + + $t->expand( + lang => $ch->{locale}, + title => "NoPaste :: $ch->{name}", + ); + + my ($ptr) = gethostbyaddr( + inet_aton($req->{connection}->remote_ip), AF_INET); + my @writable = $this->{nopaste}->pickup_writable($ch->{id}, $ptr); + my @readable = $this->{nopaste}->pickup_readable($ch->{id}, $ptr); + + if (@writable or $ch->{restriction}{write} eq 'any') { + if ($error) { + $_ = $error; + s!\n!
!g; + $t->writable->error->add(error => $_); + } + + $t->writable->expand( + channel_id => $ch->{id}, + l18n_name => __"Name", + ); + + if ($ch->{restriction}{write} ne 'any') { + if (@writable ==1) { + $t->writable->restricted->only_one->add( + nick => $writable[0], + ); + } + else { + foreach my $nick (@writable) { + $t->writable->restricted->multiple->entry->add( + nick => $nick, + ); + } + $t->writable->restricted->multiple->add; + } + $t->writable->restricted->add; + } + else { + $t->writable->not_restricted->add; + } + + $t->writable->add( + l18n_title => __"Title", + l18n_body => __( + # body of the post + "Body", + ), + l18n_paste => __"Paste", + ); + + # set the default values + my $q = $req->uri->clone; + if (not $q->query_param('nick') and @writable == 1) { + $q->query_param(nick => $writable[0]); + } + $t->setform($q => 'post'); + } + else { + my $msg = $this->{nopaste}->gen_unwritable_error($ch); + $msg =~ s!\n!
!g; + + $t->not_writable->add( + error => $msg, + ); + } + + if (@readable or $ch->{restriction}{read} eq 'any') { + my $pager = POE::Component::IRC::Plugin::NoPaste::Pager->new( + fetch => { + sql => q{ + SELECT * + FROM post + WHERE channel_id = ? + ORDER BY posted_time DESC + }, + placeholder => [$ch->{id}], + dbh => $this->{nopaste}{db}->dbh, + }, + page_to_show => scalar $req->uri->query_param('page'), + pagenums_limit => 20, + items_per_page => 20, + show_meta => sub { + my %meta = @_; + + if ($meta{page} == 1) { + $t->readable->prev->nolink->add; + } + else { + $t->readable->prev->link->add( + page => $meta{page} - 1, + ); + } + $t->readable->prev->add; + + foreach my $i ($meta{pagelink_begin} .. $meta{pagelink_end}) { + if ($i == $meta{page}) { + $t->readable->pages->page->nolink->add( + page => $i, + ); + } + else { + $t->readable->pages->page->link->add( + page => $i, + ); + } + $t->readable->pages->page->add; + } + $t->readable->pages->add; + + if ($meta{page} == $meta{last_page}) { + $t->readable->next->nolink->add; + } + else { + $t->readable->next->link->add( + page => $meta{page} + 1, + ); + } + $t->readable->next->add; + }, + show_content => sub { + my $row = shift; + + $t->readable->list_data->add( + id => $row->{post_id}, + title => $row->{title}, + name => $row->{nick}, + body => $row->{body}, + timestamp => $time{'yyyy-mm-dd hh:mm:ss', $row->{posted_time}}, + ); + }, + no_content => sub { + $t->readable->list_nodata->add( + l18n_nodata => __"There are no entries currently.", + ); + }, + ); + $pager->execute; + + $t->readable->add( + l18n_title => __"Title", + l18n_name => __"Name", + l18n_timestamp => __"Time Stamp", + ); + } + else { + my $msg = $this->{nopaste}->gen_unreadable_error($ch); + $msg =~ s!\n!
!g; + + $t->not_readable->add( + error => $msg, + ); + } + + $resp->content($t->str); + return RC_OK; +} + +sub post_handler { + my ($this, $req, $resp, $ch) = @_; + my $nick = $req->uri->query_param('nick'); + my $title = $req->uri->query_param('title'); + my $body = $req->uri->query_param('body'); + + local $ENV{LANGUAGE} = $ch->{locale}; + + my @error; + if (not defined $nick or not length $nick) { + push @error, __"Please don't omit your name."; + } + elsif (length($nick) > NICK_LIMIT) { + push @error, __x("Please shorten your name up to {n} bytes.", n => NICK_LIMIT); + } + if (not defined $title or not length $title) { + push @error, __"Please don't omit the title."; + } + elsif (length($title) > TITLE_LIMIT) { + push @error, __x("Please shorten the title up to {n} bytes.", n => TITLE_LIMIT); + } + if (not defined $body or not length $body) { + push @error, __"Please don't omit the body."; + } + elsif (length($body) > BODY_LIMIT) { + push @error, __x("Please shorten the body up to {n} bytes.", n => BODY_LIMIT); + } + + if (@error) { + return index_handler($this, $req, $resp, $ch, join("\n", map {"* $_"} @error)); + } + + my ($ptr) = gethostbyaddr( + inet_aton($req->{connection}->remote_ip), AF_INET); + my @writable = $this->{nopaste}->pickup_writable($ch->{id}, $ptr); + if ($ch->{restriction}{write} eq 'any' or + grep {$_ eq $nick} @writable) { + + my $db = $this->{nopaste}{db}; + + # check for duplication + if ($db->dbh->selectrow_hashref(q{ + SELECT * + FROM post + WHERE channel_id = ? AND nick = ? AND + title = ? AND body = ? + }, undef, $ch->{id}, $nick, $title, $body)) { + return index_handler( + $this, $req, $resp, $ch, __"A duplicated entry is being pasted."); + } + + # insert it + $db->dbh->do(q{ + INSERT INTO post + (channel_id, posted_time, nick, title, body) + VALUES (? , ? , ? , ? , ? ) + }, undef, $ch->{id}, time, $nick, $title, $body); + + # get the post id + my ($post_id) = $db->dbh->selectrow_array(q{ + SELECT LAST_INSERT_ROWID()}); + + # announce it in the channel + my $name = $ch->{name}; + from_to $name, 'UTF-8' => $ch->{charset}; + + my @msg = ( + __x("{nick} pasted an entry: {title}", nick => $nick, title => $title), + do { + my $uri = $req->uri->clone; + $uri->path("/pasted/$post_id"); + $uri->query(undef); + $uri->fragment(undef); + $uri->as_string; + }, + ); + foreach (@msg) { + my $line = $_; + from_to $line, 'UTF-8' => $ch->{charset}; + + $this->{nopaste}{irc}->yield( + notice => $name => $line); + } + + # redirect to the index + return redirect_handler( + $this, $req, $resp, "/nopaste/$ch->{id}/"); + } + else { + return index_handler($this, $req, $resp, $ch); + } +} + +1; diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm b/lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm new file mode 100644 index 0000000..b9cae0e --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm @@ -0,0 +1,127 @@ +# -*- cperl -*- +package POE::Component::IRC::Plugin::NoPaste::Httpd::Pasted; +use strict; +use warnings; +use POE; +use POE::Component::IRC::Plugin::NoPaste::Httpd; +use POE::Component::IRC::Plugin::NoPaste::StaticFile; +use Locale::TextDomain qw(pci-nopaste); +use HTTP::Status; +use Socket; +use Time::Format qw(%time); +use Encode qw(from_to); + +sub handler { + my ($this, $req, $resp) = @_; + + if ($req->uri->path =~ m!^/pasted/(\d+)$!) { + return pasted_handler( + $this, $req, $resp, $1); + } + else { + return notfound_handler(@_); + } +} + +sub pasted_handler { + my ($this, $req, $resp, $post_id) = @_; + + # check for the existence of line in db + my $post = $this->{nopaste}{db}->dbh->selectrow_hashref(q{ + SELECT * + FROM post + WHERE post_id = ? + }, undef, $post_id); + + if (not $post) { + return notfound_handler(@_); + } + + # is the channel_id still defined? + my $ch = $this->{nopaste}{id_to_channel}{$post->{channel_id}}; + if (not $ch) { + # no. probably there should be some way to change channel_id. + return notfound_handler(@_); + } + + my $escape = sub { + $_ = shift; + s!&!&!g; + s!!>!g; + $_; + }; + + local $ENV{LANGUAGE} = $ch->{locale}; + + my $t = POE::Component::IRC::Plugin::NoPaste::Template->new( + -data => static_file('tmpl/pasted.html')); + + $t->expand( + lang => $ch->{locale}, + title => $escape->("NoPaste :: $ch->{name}"), + ); + + my ($ptr) = gethostbyaddr( + inet_aton($req->{connection}->remote_ip), AF_INET); + my @readable = $this->{nopaste}->pickup_readable($ch->{id}, $ptr); + + if (@readable or $ch->{restriction}{read} eq 'any') { + # we want to know which are the next and the previous posts. + my $prev = $this->{nopaste}{db}->dbh->selectrow_hashref(q{ + SELECT * + FROM post + WHERE channel_id = ? AND posted_time > ? + LIMIT 1 + }, undef, $ch->{id}, $post->{posted_time}); + my $next = $this->{nopaste}{db}->dbh->selectrow_hashref(q{ + SELECT * + FROM post + WHERE channel_id = ? AND posted_time < ? + LIMIT 1 + }, undef, $ch->{id}, $post->{posted_time}); + + if ($prev) { + $t->readable->prev->add( + id => $prev->{post_id}, + pasted_by => __x( + "Pasted by {name}", name => $escape->($prev->{nick})), + title => $escape->($prev->{title}), + ); + } + $t->readable->expand( + channel_id => $ch->{id}, + l18n_index => __"Index", + ); + if ($next) { + $t->readable->next->add( + id => $next->{post_id}, + pasted_by => __x( + "Pasted by {name}", name => $escape->($next->{nick})), + title => $escape->($next->{title}), + ); + } + + $t->readable->add( + l18n_name => __"Name", + name => $escape->($post->{nick}), + l18n_title => __"Title", + title => $escape->($post->{title}), + l18n_body => __"Body", + body => $escape->($post->{body}), + ); + } + else { + my $msg = $this->{nopaste}->gen_unreadable_error($ch); + $msg =~ s!\n!
!g; + + $t->not_readable->add( + error => $msg, + ); + } + + $resp->content($t->str); + return RC_OK; +} + +1; diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/Pager.pm b/lib/POE/Component/IRC/Plugin/NoPaste/Pager.pm new file mode 100644 index 0000000..8aafb1e --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/Pager.pm @@ -0,0 +1,240 @@ +# -*- cperl -*- +package POE::Component::IRC::Plugin::NoPaste::Pager; +use strict; +use warnings; +use Carp; +use UNIVERSAL qw(isa); +use Error qw(:try); +use Hash::Util qw(lock_keys); +our $VERSION = '0.1'; + +=pod + + my $pager = Pager->new( + # 目的のデータを取り出す方法。 + # SQL文を使用する場合: + fetch => { + sql => q{SELECT foo, bar FROM foo WHERE bar=? AND baz=?}, + placeholder => [100, 200], + dbh => $dbh, + }, + # CODEを使用する場合: + fetch => { + code => sub { + # $begin: 表示を開始する項目の番號(0オリジン) + # $length: 表示する項目の個數 + # $code_show: 表面的には、show_contentで指定された關數(内部的には違ふ) + my ($begin, $length, $code_show) = @_; + for ($begin .. ($begin + $length - 1)) { + $code_show->("Item [$_]"); + } + }, + }, + # 全項目數を知る方法。 + # fetchがSQL文であるなら、countを省略すれば + # 自動的にSELECT COUNT(*)文をfetchのSQLから生成する。 + count => { + sql => q{SELECT COUNT(*) FROM foo WHERE bar=? AND baz=?}, + placeholder => [100, 200], + dbh => $dbh, + }, + # 若しくは + count => { + code => sub { + return 100; + }, + }, + page_to_show => 2, # 表示したいページ(1オリジン); デフォルトは1 + pagenums_limit => 10, # 各ページへのリンクの最大表示個數; デフォルトは10 + items_per_page => 20, # ページ毎の項目の最大表示數; デフォルトは20 + # メタ情報が得られた時に呼ばれる關數。 + show_meta => sub { + # 番號は全て1オリジン。 + # total: 総件數 + # page: 現在のページ番號 + # last_page: 最終ページ番號 + # pagelink_begin: 各ページへのリンクの開始ページ番號 + # pagelink_end: 各ページへのリンクの終了ページ番號(この番號も含む) + my %meta = @_; + print "page: $meta{page}/$meta{last_page}; total: $meta{total}\n"; + }, + # 項目が得られた時に呼ばれる關數。 + show_content => sub { + # fetchがSQL文なら、$_[0]はfetchrow_hashrefで得られたハッシュ。 + # CODEなら、そのCODEの中から明示的に呼ばれなければならない。 + print "item: $_[0]\n"; + }, + # 項目が一つも無い時に呼ばれる關數。省略可。 + no_content => sub { + # do what you want to + }, + ); + $pager->execute; + +=cut + +sub new { + my ($class, %args) = @_; + + my $fetch = $args{fetch}; + if (!isa $fetch, 'HASH') { + croak "Arg{fetch} is not a hashref"; + } + if (defined $fetch->{sql}) { + $fetch->{dbh} or croak "Arg{fetch} has a sql, but not dbh"; + $fetch->{code} and croak "Arg{fetch} has both of sql and code"; + # FIXME: LIMITが付いてゐたらcroak + } + elsif (defined $fetch->{code}) { + (isa $fetch->{code}, 'CODE') or croak "Arg{fetch}{code} is not a coderef: ".$fetch->{code}; + $fetch->{sql} and croak "Arg{fetch} has both of sql and code"; + } + + my $count = $args{count}; + if (!defined $count) { + if (defined $fetch->{sql}) { + # fetchのSQL文を改造して作る。 + (my $sql = $fetch->{sql}) =~ s/^\s*select\s+(.+?)\s+from/select count(*) from/i; + $count = $args{count} = {}; + $count->{sql} = $sql; + $count->{placeholder} = $fetch->{placeholder} if $fetch->{placeholder}; + $count->{dbh} = $fetch->{dbh}; + } + else { + croak "Arg{count} cannot be omitted when the Arg{fetch} is not a SQL"; + } + } + elsif (!isa $count, 'HASH') { + croak "Arg{count} is not a hashref"; + } + # FIXME: $args{count}のsanity checkを（もっと） + + # FIXME: 以下の三つの變數をsanity check + $args{page_to_show} ||= 1; + $args{pagenums_limit} ||= 10; + $args{items_per_page} ||= 20; + + foreach my $key (qw/show_meta show_content/) { + if (!defined $args{$key}) { + croak "Missing Arg{$key}"; + } + elsif (!isa $args{$key}, 'CODE') { + croak "Arg{$key} is not a coderef: $args{$key}"; + } + } + + if (defined $args{no_content} and + !isa $args{no_content}, 'CODE') { + croak "Arg{no_content} is not a coderef: $args{no_content}"; + } + $args{no_content} ||= undef; + + my $this = bless \%args => $class; + lock_keys %$this; + $this; +} + +sub ceil { + my $val = $_[0]; + my $floor = int($val); + $floor == $val ? $floor : $floor + 1; +} + +sub min { + my $min = $_[0]; + foreach (@_) { + $min = $_ if $min > $_; + } + $min; +} + +sub max { + my $max = $_[0]; + foreach (@_) { + $max = $_ if $max < $_; + } + $max; +} + +sub execute { + my $this = shift; + + my $count; + if (defined $this->{count}{sql}) { + try { + $count = $this->{count}{dbh}->selectrow_array( + $this->{count}{sql}, undef, @{$this->{count}{placeholder} || []}); + } otherwise { + throw Error::Simple "Failed to do count by sql: $_[0]"; + }; + } + else { + try { + $count = $this->{count}{code}->(); + } otherwise { + throw Error::Simple "Failed to do count by code: $_[0]"; + }; + } + + # この情報を基に、メタデータを生成 + my $last_page = max(1, ceil($count / $this->{items_per_page})); + my $page = min($this->{page_to_show}, $last_page); + my $pagelink_begin = max(1, int($page - $this->{pagenums_limit} / 2)); + my $pagelink_end = min($last_page, $pagelink_begin + $this->{pagenums_limit} - 1); + + # show_metaを呼ぶ + $this->{show_meta}->( + count => $count, + page => $page, + last_page => $last_page, + pagelink_begin => $pagelink_begin, + pagelink_end => $pagelink_end); + + # fetch實行 + my $fetch_begin = ($page - 1) * $this->{items_per_page}; + my $fetch_length = min($count - $fetch_begin, + $this->{items_per_page}); + if (defined $this->{fetch}{sql}) { + try { + # FIXME: これより増しなLIMIT生成方法を + my $sql = $this->{fetch}{sql} . " LIMIT $fetch_begin, $fetch_length"; + + my $sth = $this->{fetch}{dbh}->prepare($sql); + $sth->execute(@{$this->{fetch}{placeholder} || []}); + while ($_ = $sth->fetchrow_hashref) { + $this->{show_content}->($_); + } + if ($sth->rows == 0) { + $this->{no_content} and + $this->{no_content}->(); + } + } otherwise { + throw Error::Simple "Failed to do fetch by sql: $_[0]"; + }; + } + else { + # $fetch_length囘呼ばれたかどうかをチェックする + my $called_count = 0; + my $checked_show = sub { + $called_count++; + goto &{$this->{show_content}}; + }; + try { + $this->{fetch}{code}->( + $fetch_begin, $fetch_length, $checked_show); + } otherwise { + throw Error::Simple "Failed to do fetch by code: $_[0]"; + }; + if ($called_count != $fetch_length) { + carp "Fetch coderef didn't call show_content exactly $fetch_length times (call \$length($fetch_length) times)"; + } + if ($fetch_length == 0) { + $this->{no_content} and + $this->{no_content}->(); + } + } + + $this; +} + +1; diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/StaticFile.pm b/lib/POE/Component/IRC/Plugin/NoPaste/StaticFile.pm new file mode 100644 index 0000000..3c96964 --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/StaticFile.pm @@ -0,0 +1,48 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +package POE::Component::IRC::Plugin::NoPaste::StaticFile; +use strict; +use warnings; +use File::Spec; +use File::stat; +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(&static_file); + +# path => [lastmod, content] +my $TABLE = {}; + +sub static_file { + my ($path) = @_; + my $fullpath; + + foreach my $inc (@INC) { + my $fpath = File::Spec->canonpath( + File::Spec->catdir( + File::Spec->splitdir($inc), + qw(POE Component IRC Plugin NoPaste), + File::Spec->splitdir($path))); + + if (-r $fpath) { + $fullpath = $fpath; + last; + } + } + defined $fullpath or return undef; + + my $lastmod = stat($fullpath)->mtime; + + my $entry = $TABLE->{$fullpath}; + if (!$entry or $entry->[0] < $lastmod) { + local $/ = undef; + open my $fh, '<', $fullpath; + my $content = <$fh>; + close $fh; + + $entry = $TABLE->{$fullpath} = [$lastmod, $content]; + } + + return $entry->[1]; +} + +1; diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/Template.pm b/lib/POE/Component/IRC/Plugin/NoPaste/Template.pm new file mode 100644 index 0000000..7505e6c --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/Template.pm @@ -0,0 +1,693 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +package POE::Component::IRC::Plugin::NoPaste::Template; +use strict; +use warnings; +use Carp; +use UNIVERSAL; +our $AUTOLOAD; +our $VERSION = 2; + +our $SETFORM_SUPPORTED = 1; +BEGIN { + eval q{ use URI; use URI::QueryParam; }; + $@ and $SETFORM_SUPPORTED = 0; +} + +=head1 NAME + + Template - Text Template Class (especially for (x)html) + +=head1 SYNOPSIS + + ### sample.html ### + + + + Sample Page - <t-tag:embed> - Sample Page + + +

+ + line:
+ +

+ + + + + ### sample.pl ### + + use Template; + my $t = Template->new( + -fpath => './sample.html', + ); + $t->expand( + embed => 'EMBED TITLE', + ); + foreach (1 .. 3) { + $t->block->add( + foo => ".: $_ :.", + ); + } + print $t->str; + + + ### output ### + + + + Sample Page - EMBED TITLE - Sample Page + + +

+ + line: 1
+ + line: 2
+ + line: 3
+ +

+ + + +=head1 DESCRIPTION + +not available yet... + +=head1 CONSTRUCTOR + +=over 4 + +=item $t = Template->new( %args ); + +=over 8 + +=item -fpath => file to use as template (one of this and -data is required) + +=item -data => data to use as template + +=item -strip => whether delete newlines after , or not + +=item -lang => language to output + +Any blocks surrounded by and are treated as +language specific block. + + e.g. + + This is default + Nihongo(Japanese) + + my $t = Template->new( + -fpath => './foo.html', + -lang => 'ja'); + print $t->str; # this shows "Nihongo(Japanese)" + + $t = Template->new( + -fpath => './foo.html', + -lang => 'en'); + print $t->str; # this shows "This is default" + +=back + +=back + +=cut + +sub new { + # %args = ( + # -fpath => テンプレートとして使用するファイル + # -data => テンプレートとして使用するデータ + # -strip => やの直後の改行を削除するかどうか, + # -lang => 言語名, + # ) + my ($class, %args) = @_; + my $this = { + original => undef, # リーフをに置換した中身。 + current => undef, # <&foo>を置換した後のもの。 + leaves => {}, # {名前 => Template} + parent => undef, # これがトップレベルでなければ、親(Template)。 + leafname => undef, # これがトップレベルでなければ、リーフ名。 + }; + bless $this => $class; + + my $source; + if (defined $args{-fpath}) { + if (defined $args{-data}) { + croak "You can't specify both of -fpath and -data at the same time.\n"; + } + local $/ = undef; + open my $fh, '<', $args{-fpath} + or croak "Failed to open file $args{-fpath}"; + $source = <$fh>; + close($fh); + } + elsif (defined $args{-data}) { + $source = $args{-data}; + } + else { + croak "Missing both of -fpath and -data. Read `perldoc Template'\n"; + } + + # やの直後が改行コードなら、それを消す。 + # その改行コードから始まるスペースまたはタブも、インデントと見做して消す。 + if ($args{-strip}) { + $source =~ s{(|)\x0d?\x0a[ \t]*}{$1}g; + } + + # 言語 + my $lang = 'default'; + if ($args{-lang} and $source =~ m//) { + $lang = $args{-lang}; + } + $source =~ s{(.+?)}{ + if ($1 eq $lang) { + $2; + } + else { + ''; + } + }seg; + + $this->_load($source); + $this; +} + +sub reset { + my $this = shift; + $this->{current} = $this->{original}; + $this; +} + +sub expand { + # $t->expand({foo => '---' , bar => '+++'}); + # もしくは + # $t->expand(foo => '---' , bar => '+++'); + + # このメソッドは、キー内に現われたアンダースコアを + # ハイフンにフォールバックする事が出來る。 + # つまり、というタグを、キー名"foo_bar"で指定する事が出來る。 + my $this = shift; + my $hash = do { + if (@_ == 1 && UNIVERSAL::isa($_[0],'HASH')) { + $_[0]; + } + elsif (@_ % 2 == 0) { + my %h = @_; + \%h; + } + else { + croak "Illegal argument for Template->expand"; + } + }; + while (my ($key,$value) = each %$hash) { + # $key,$value共にスカラー値でなければならない。 + # リファならエラー。 + if (!defined $value) { + croak "Values must not be undef; key: $key"; + } + if (ref($key) ne '') { + croak "Keys and values must be scalar values: $key"; + } + if (ref($value) ne '') { + croak "Keys and values must be scalar values: $value"; + } + + if ($this->{current} !~ s||$value|g) { + # 無い。アンダースコアをハイフンに変えてみる。 + (my $tred_key = $key) =~ tr/_/-/; + if ($this->{current} !~ s||$value|g) { + # そのようなキーは存在しなかった。警告。 + #carp "No are in template, or you have replaced it already"; + } + } + } + $this; +} + +sub add { + my $this = shift; + + # 引数があればexpandする。 + if (@_ > 0) { + eval { + $this->expand(@_); + }; if ($@) { + croak $@; + } + } + + # 親が存在しなければcroak。 + if (!defined $this->{parent}) { + croak "This template doesn't have its parent."; + } + + # 親のの直前に、このリーフを挿入。 + my $str = $this->str; + $this->{parent}{current} =~ s|({leafname}\E(?:\s*/)?>)|$str$1|g; + + # リセット + $this->reset; + + $this; +} + +sub str { + my $this = shift; + my $result = $this->{current}; + + # 未置換のがあればそれを消してcarp。 + while ($result =~ s/()//) { + carp "Unexpanded tag: $1"; + } + + # を消す。 + $result =~ s///g; + + $result; +} + +sub leaf { + my ($this,$leafname) = @_; + $this->{leaves}{$leafname}; +} + +sub AUTOLOAD { + my $this = shift; + (my $leafname = $AUTOLOAD) =~ s/.+?:://g; + + # 余分な引數が付いてゐれば、恐らくこれは關數名の誤り。 + if (@_) { + croak "Calling autoloaded Template->$leafname with extra arguments must be a mistake"; + } + + # アンダースコアはハイフンに置換。 + $leafname =~ tr/_/-/; + $this->{leaves}{$leafname}; +} + +sub _new_leaf { + my ($class,$parent,$leafname,$source) = @_; + my $this = { + original => undef, + current => undef, + leaves => {}, + parent => $parent, + leafname => $leafname, + }; + bless $this,$class; + + $this->_load($source); +} + +sub _load { + my ($this,$source) = @_; + + # ... をに置換しつつ、そのリーフを保存。 + while ($source =~ s|(.+?)||s) { + my ($leafname,$source) = ($1,$2); + + if (defined $this->{leaves}{$leafname}) { + # 既にこのリーフが定義されていたらcroak。 + croak "duplicated leaves in template: $leafname"; + } + else { + $this->{leaves}{$leafname} = __PACKAGE__->_new_leaf($this,$leafname,$source); + } + } + $this->{original} = $this->{current} = $source; + + $this; +} + +sub escape_tag { + my @args = @_; + my @result; + foreach my $str (@args) { + if (defined $str) { + $str =~ s/\&/\&/g; + $str =~ s//\>/g; + $str =~ s/\"/\"/g; + } + push @result, $str; + } + wantarray ? @result : $result[0]; +} + +sub unescape_tag { + my @args = @_; + my @result; + foreach my $str (@args) { + if (defined $str) { + $str =~ s/\<//g; + $str =~ s/\"/\"/g; + $str =~ s/\&/\&/g; + } + push @result, $str; + } + wantarray ? @result : $result[0]; +} + +sub html2tag { + my $tag = {}; + $_ = shift; + + s|^<||; + s|^(/?\w+)|| and $tag->{__top} = lc $1; + + while (1) { + s|([\w\-]+)=([\"\'])(.*?)\2|| and do { + $tag->{lc $1} = $3; + next; + }; + s|([\w\-]+)=([^\s\>]+)|| and do { + $tag->{lc $1} = $2; + next; + }; + s,(\w+|/),, and do { + $tag->{__end} = lc $1; + next; + }; + last; + } + + my $new = {}; + foreach (keys %$tag) { + $new->{unescape_tag($_)} = unescape_tag($tag->{$_}); + } + $new; +} + +sub tag2html { + my $tag = shift; + + my $html; + $html .= '<' . $tag->{__top}; + foreach (keys %$tag) { + /^__/ and next; + $html .= sprintf ' %s="%s"', escape_tag($_), escape_tag($tag->{$_}); + } + defined $tag->{__end} and + $html .= ' ' . $tag->{__end}; + + $html .= '>'; + $html; +} + +sub setform { + # $uri: URI + my ($this, $uri, $name) = @_; + defined $name or $name = ''; + + if (!UNIVERSAL::isa($uri, 'URI')) { + croak "Usage: Template->setform(URI [, name])"; + } + + $SETFORM_SUPPORTED or + croak "Install URI::QueryParam to enable setform"; + + my $is_xhtml = ($this->{current} =~ m|^\s*<\?xml|); + + my $outhtml = ''; + my $in_select; # name + my $in_select_option_tag; # tag + my $in_textarea; # name + my $in_form = ''; # name + foreach (split /(<[^\<\>]+?>)/, $this->{current}) { + if (defined $in_select and defined $in_select_option_tag) { + my $value = ''; + /^([^ \<\r\n]*)/i and $value = $1; + + my $tag = $in_select_option_tag; + if (grep {$value eq $_} $uri->query_param($in_select)) { + $tag->{$is_xhtml ? 'selected' : '__end'} = 'selected'; + } + else { + delete $tag->{$is_xhtml ? 'selected' : '__end'}; + } + + $outhtml .= tag2html($tag); + undef $in_select_option_tag; + } + if (defined $in_textarea) { + if (!m|^|i) { + next; + } + } + + my $taghtml = $_; + if (!/^{__top}) { + $outhtml .= $taghtml; + } + elsif ($tag->{__top} eq 'form') { + if (defined($_ = $tag->{name})) { + $in_form = unescape_tag($_); + } + else { + $in_form = ''; + } + + if (!$tag->{action}) { + my $act = $uri->clone; + $act->query(undef); + $act->fragment(undef); + $tag->{action} = $act->canonical->as_string; + } + + $outhtml .= tag2html($tag); + } + elsif ($name ne $in_form) { + $outhtml .= $taghtml; + } + elsif ($tag->{__top} eq 'input') { + if (defined $tag->{name}) { + my $type = $tag->{type}; + if (!$type or + grep {$_ eq $type} qw[text password hidden submit]) { + if (defined(my $value = $uri->query_param($tag->{name}))) { + $tag->{value} = $value; + } + $outhtml .= tag2html($tag); + } + elsif (grep {$_ eq $type} qw[radio checkbox]) { + if (defined $tag->{value} and + grep {$_ eq $tag->{value}} + $uri->query_param($tag->{name})) { + $tag->{$is_xhtml ? 'checked' : '__end'} = 'checked'; + } + else { + delete $tag->{$is_xhtml ? 'checked' : '__end'}; + } + $outhtml .= tag2html($tag); + } + else { + $outhtml .= $taghtml; + } + } + else { + $outhtml .= $taghtml; + } + } + elsif ($tag->{__top} eq 'textarea') { + if (defined($_ = $tag->{name})) { + $in_textarea = $_; + $outhtml .= tag2html($tag); + if (defined(my $value = $uri->query_param($_))) { + $outhtml .= escape_tag($value); + } + } + else { + $outhtml .= tag2html($tag); + } + } + elsif ($tag->{__top} eq '/textarea') { + $outhtml .= tag2html($tag); + undef $in_textarea; + } + elsif ($tag->{__top} eq 'select') { + if (defined($_ = $tag->{name})) { + $in_select = $_; + } + $outhtml .= tag2html($tag); + } + elsif ($tag->{__top} eq '/select') { + $outhtml .= tag2html($tag); + undef $in_select; + } + elsif (defined $in_select) { + if ($tag->{__top} eq 'option') { + if (defined(my $val = $tag->{value})) { + if (grep {$val eq $_} $uri->query_param($in_select)) { + $tag->{$is_xhtml ? 'selected' : '__end'} = 'selected'; + } + else { + delete $tag->{$is_xhtml ? 'selected' : '__end'}; + } + $outhtml .= tag2html($tag); + } + else { + $in_select_option_tag = $tag; + } + } + else { + $outhtml .= $taghtml; + } + } + else { + $outhtml .= $taghtml; + } + } + + $this->{current} = $outhtml; +} + +sub addhiddenform { + # $uri: URI or HASH + my ($this, $uri, $name) = @_; + defined $name or $name = ''; + + $SETFORM_SUPPORTED or + croak "Install URI::QueryParam to enable setform"; + + if (!UNIVERSAL::isa($uri, 'URI')) { + if (UNIVERSAL::isa($uri, 'HASH')) { + my $u = URI->new('', 'http'); + while (my ($key, $value) = each %$uri) { + $u->query_param( + $key => UNIVERSAL::isa($value, 'ARRAY') ? @$value : $value); + } + $uri = $u; + } + else { + croak "\$uri was not URI nor HASH"; + } + } + + my $is_xhtml = ($this->{current} =~ m|^\s*<\?xml|); + + my $outhtml = ''; + foreach (split /(<[^\<\>]+?>)/, $this->{current}) { + my $taghtml = $_; + if (!/^{__top} and + $tag->{__top} eq 'form' and + !$tag->{action}) { + my $act = $uri->clone; + $act->query(undef); + $act->fragment(undef); + $tag->{action} = $act->canonical->as_string; + + $outhtml .= tag2html($tag); + } + else { + $outhtml .= $taghtml; + } + + if (defined $tag->{__top} and + $tag->{__top} eq 'form') { + if ((!defined $tag->{name} and $name eq '') or + (defined $tag->{name} and $name eq $tag->{name})) { + foreach my $key ($uri->query_param) { + my $format = $is_xhtml ? + q{} : + q{}; + $outhtml .= sprintf($format, $key, $uri->query_param($key)); + } + } + } + } + + $this->{current} = $outhtml; +} + +sub disableform { + my ($this, $keylist, $name) = @_; + defined $name or $name = ''; + + my %keyhash = map {$_ => 1} @$keylist; + + my $is_xhtml = ($this->{current} =~ m|^\s*<\?xml|); + + my $outhtml = ''; + my $in_textarea; # name + my $in_form = ''; + foreach (split /(<[^\<\>]+?>)/, $this->{current}) { + my $taghtml = $_; + if (!/^|i) { + next; + } + } + + my $tag = html2tag($taghtml); + + if (!defined $tag->{__top}) { + $outhtml .= $taghtml; + } + elsif ($tag->{__top} eq 'form') { + if (defined($_ = $tag->{name})) { + $in_form = unescape_tag($_); + } + else { + $in_form = ''; + } + + $outhtml .= tag2html($tag); + } + elsif ($name ne $in_form) { + $outhtml .= $taghtml; + } + elsif ($tag->{__top} eq 'textarea') { + $in_textarea = 1; + $outhtml .= tag2html($tag); + } + elsif ($tag->{__top} eq '/textarea') { + $outhtml .= tag2html($tag); + undef $in_textarea; + } + elsif ($tag->{__top} eq 'input' or + $tag->{__top} eq 'select' or + $tag->{__top} eq 'textarea') { + + my $name = $tag->{name}; + if ($name and $keyhash{$name}) { + # disable this + $tag->{$is_xhtml ? 'disabled' : '__end'} = 'disabled'; + + # nameを消したいところだが、多分消した時の動作は實裝依存になる。 + # 代はりにnameを別の名前に變換する。 + $tag->{name} = sprintf 'DiSaBLeD_%s_DiSaBLeD', $tag->{name}; + } + + $outhtml .= tag2html($tag); + } + else { + $outhtml .= $taghtml; + } + } + + $this->{current} = $outhtml; +} + +1; diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/css/style.css b/lib/POE/Component/IRC/Plugin/NoPaste/css/style.css new file mode 100644 index 0000000..b8d68cc --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/css/style.css @@ -0,0 +1,120 @@ +@charset "UTF-8"; + +* { + margin: 0; + padding: 0; +} + +body { + background-color: #dddddd; +} + +h1 { + font-size: 200%; + color: white; + background-color: #333388; + + -moz-border-radius: 8px; + + border-color: #7777bb; + border-width: 0 2px 2px 0; + border-style: solid; + + padding: 5px; + margin: 10px; +} + +#form, #list, #pasted { + margin: 0 10px 10px 10px; +} +table { + width: 100%; +} +th, td { + -moz-border-radius: 5px; +} +table th { + background-color: #333388; + color: white; + padding: 3px; +} +table td { + background-color: #7777bb; + color: white; + padding: 3px; +} +table input, table textarea, table select { + font-size: 110%; + + background-color: #7f7fbf; + color: inherit; + + border-color: #ddddff; + border-width: 1px; + border-style: dashed; + + padding: 3px; +} +table input:hover, table textarea:hover, table select:hover { + background-color: #6f6faf; +} +table input[type="text"] { + width: 99%; +} +table input[type="submit"] { + font-size: 150%; + padding: 2px 5px; +} +table textarea { + font-size: 100%; + + width: 99%; +} + +.error { + margin: 5px 0px; + padding: 10px; + background-color: #bb7777; + + -moz-border-radius: 6px; + + color: white; + font-size: 120%; +} + +a { + font-weight: bold; + color: white; + text-decoration: underline; + font-style: italic; +} +a:visited { + text-decoration: none; +} + +#list, #pasted { + text-align: center; +} +#list table, #pasted table { + margin-top: 3px; +} +.pager { + display: inline; + + background-color: #5f5faf; + color: white; + + -moz-border-radius: 5px; + + padding: 3px; +} +.pager a:visited { + text-decoration: underline; +} + +#pasted td { + text-align: left; +} +#pasted th { + width: 10%; +} \ No newline at end of file diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/error.html b/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/error.html new file mode 100644 index 0000000..908848f --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/error.html @@ -0,0 +1,15 @@ + + + + + <t-tag:status-code /> <t-tag:status-message /> + + +

+

+ The requested URL is not valid for the NoPaste.
+

+ + diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/index.html b/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/index.html new file mode 100644 index 0000000..4f146a5 --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/index.html @@ -0,0 +1,128 @@ + + + + + <t-tag:title /> + + + +

+ + +
+ +

+ + +
+ + + + + + + + + + + + + + + + + +
+ + + + + + + + + + + + +
+ +
+ +
+ +
+
+
+ + +
+

+
+ + + +
+ +

+ + + << + + + << + + + + + + + + + + + + + + + >> + + + >> + + +

+ + + + + + + + + + + + + + + + + + +
+
+ + +
+

+
+ + + diff --git a/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/pasted.html b/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/pasted.html new file mode 100644 index 0000000..22ba70b --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/NoPaste/tmpl/pasted.html @@ -0,0 +1,53 @@ + + + + + <t-tag:title /> + + + +

+ + +
+

+ + + << + + + + + + + + >> + + +

+ + + + + + + + + + + + + + +
+
+ + +
+

+
+ + + diff --git a/misc/nopaste-config-schema.yml b/misc/nopaste-config-schema.yml new file mode 100644 index 0000000..ead597f --- /dev/null +++ b/misc/nopaste-config-schema.yml @@ -0,0 +1,42 @@ +# You can validate config files with this file by a tool named kwalify. +# http://www.kuwata-lab.com/kwalify/ + +# Usage: +# kwalify -f nopaste-config-schema.yml + +type: map +mapping: + "irc": + type: map + mapping: + "server" : {required: true} + "port" : {required: true, type: integer} + "nick" : {required: true} + "username": {required: true} + "ircname" : {required: true} + "httpd": + type: map + mapping: + "port": {required: true, type: integer} + "db": + type: map + mapping: + "file": {required: true} + "channels": + type: seq + sequence: + - type: map + mapping: + "name" : {required: true} + "id" : {required: true, pattern: "/^[a-zA-Z0-9_\-.]+$/"} + "charset" : {desc: default is "ISO-8859-1"} + "locale" : {desc: default is "en"} + "restriction": + type: map + mapping: + "read": + desc: default is "any" + enum: &permission [op, halfop, voice, member, any] + "write": + desc: default is "any" + enum: *permission diff --git a/misc/nopaste-db-schema.sql b/misc/nopaste-db-schema.sql new file mode 100644 index 0000000..4b22cc2 --- /dev/null +++ b/misc/nopaste-db-schema.sql @@ -0,0 +1,14 @@ +-- posts +CREATE TABLE post ( + post_id INTEGER PRIMARY KEY, -- unique id of the post + channel_id VARCHAR(512) NOT NULL, -- id of the channel in ascii + + posted_time INTEGER NOT NULL, -- timestamp in epoch + nick VARCHAR(512) NOT NULL, -- nick of the person who posted this + title BLOB NOT NULL, -- title of the post + body BLOB NOT NULL -- body of the post +); + +-- Local Variables: +-- sql-product: sqlite +-- End: \ No newline at end of file diff --git a/po/Makefile.PL b/po/Makefile.PL new file mode 100644 index 0000000..eccbd0d --- /dev/null +++ b/po/Makefile.PL @@ -0,0 +1,4 @@ +use File::Copy; + +print "Writing Makefile for po\n"; +copy "Makefile.in" => "Makefile"; diff --git a/po/Makefile.in b/po/Makefile.in new file mode 100644 index 0000000..1020ecb --- /dev/null +++ b/po/Makefile.in @@ -0,0 +1,92 @@ +# Makefile for various po files. + +srcdir = . +libdir = ../lib + +include PACKAGE + +#CATALOGS = $(addsuffix .po, LINGUAS) +CATALOGS = $(LINGUAS) +MO_FILES = $(addsuffix .mo, $(LINGUAS)) + +MSGMERGE = msgmerge +MSGFMT = msgfmt +XGETTEXT = xgettext +CATOBJEXT = .po + +default: help + +all: $(TEXTDOMAIN).pot update-po update-mo install + +help: + @echo "Available targets:" + @echo " pot - remake master catalog" + @echo " update-po - merge po files" + @echo " update-mo - regenerate mo files" + @echo " install - install mo files" + @echo " all - all of the above" + +POTFILES = $(srcdir)/POTFILES.in \ + $(shell cat $(srcdir)/POTFILES.in) + +pot: $(TEXTDOMAIN).pot + +clean: + rm -f *~ *.bak *.mo + +# FIXME: The parameter --from-code is only needed if your sources contain +# any 8 bit data (even in comments). UTF-8 is only a guess here, but it +# will at least accept any 8 bit data. +# +# The parameter "--language=perl" is not strictly needed because the +# source language of all our files will be auto-detected by xgettext +# by their filename extension. You should even avoid this parameter +# if you want to extract strings from multiple source languages. +$(TEXTDOMAIN).pot: $(POTFILES) + $(XGETTEXT) --output=$(srcdir)/$(TEXTDOMAIN).pox --from-code=utf-8 \ + --add-comments=TRANSLATORS: --files-from=$(srcdir)/POTFILES.in \ + --copyright-holder="$(COPYRIGHT_HOLDER)" \ + --msgid-bugs-address="$(MSGID_BUGS_ADDRESS)" \ + --keyword --keyword='$$__' --keyword=__ --keyword=__x \ + --keyword=__n:1,2 --keyword=__nx:1,2 --keyword=__xn:1,2 \ + --keyword=N__ --language=perl && \ + rm -f $@ && mv $(TEXTDOMAIN).pox $@ + +install: $(MO_FILES) + cd $(srcdir); \ + targetdir='$(libdir)/LocaleData'; \ + languages='$(LINGUAS)'; \ + for lang in $$languages; do \ + mkdir -p "$$targetdir/$$lang/LC_MESSAGES" || exit 1; \ + dest="$$targetdir/$$lang/LC_MESSAGES/$(TEXTDOMAIN).mo"; \ + cat="$$lang.mo"; \ + echo "installing $$cat as $$dest"; \ + cp -f $$cat $$dest && chmod 644 $$dest || exit 1; \ + done + +update-mo: $(MO_FILES) + +update-po: + $(MAKE) $(TEXTDOMAIN).pot + cd $(srcdir); \ + catalogs='$(CATALOGS)'; \ + for cat in $$catalogs; do \ + cat=`basename $$cat`; \ + lang=`echo $$cat | sed 's/\$(CATOBJEXT)$$//'`; \ + mv $$lang.po $$lang.old.po; \ + echo "$$lang:"; \ + if $(MSGMERGE) $$lang.old.po $(TEXTDOMAIN).pot -o $$lang.po; then \ + rm -f $$lang.old.po; \ + else \ + echo "msgmerge for $$cat failed!"; \ + rm -f $$lang.po; \ + mv $$lang.old.po $$lang.po; \ + fi; \ + done + +.SUFFIXES: +.SUFFIXES: .po .mo + +.po.mo: + $(MSGFMT) --check --statistics --verbose -o $@ $< + diff --git a/po/PACKAGE b/po/PACKAGE new file mode 100644 index 0000000..f5d8d83 --- /dev/null +++ b/po/PACKAGE @@ -0,0 +1,17 @@ +# -*- makefile -*- +# Makefile snippet that holds all package-dependent information. + +# Add more languages here! Beware that this is a makefile snippet and +# you have to adhere to make syntax. +LINGUAS = \ + ja \ + $(NULL) + +# Textdomain for our package. +TEXTDOMAIN = pci-nopaste + +# Initial copyright holder added to pot and po files. +COPYRIGHT_HOLDER = phonohawk + +# Where to send msgid bugs? +MSGID_BUGS_ADDRESS = phonohawk diff --git a/po/POTFILES.in b/po/POTFILES.in new file mode 100644 index 0000000..624acdd --- /dev/null +++ b/po/POTFILES.in @@ -0,0 +1,4 @@ +../bin/pci-nopaste +../lib/POE/Component/IRC/Plugin/NoPaste.pm +../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm +../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm \ No newline at end of file diff --git a/po/ja.po b/po/ja.po new file mode 100644 index 0000000..3bf11a0 --- /dev/null +++ b/po/ja.po @@ -0,0 +1,140 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR phonohawk +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +msgid "" +msgstr "" +"Project-Id-Version: pci-nopaste #0\n" +"Report-Msgid-Bugs-To: phonohawk \n" +"POT-Creation-Date: 2012-11-06 12:58+0900\n" +"PO-Revision-Date: 2005-09-24 17:57+0900\n" +"Last-Translator: phonohawk \n" +"Language-Team: Japanese \n" +"Language: ja\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#: ../bin/pci-nopaste:45 +#, perl-brace-format +msgid "{process}: option --config= is missing.\n" +msgstr "{process}: オプション --config=<設定ファイル> が不足しています。\n" + +#: ../bin/pci-nopaste:79 +msgid "Shutdown time has arrived. Telling components to stop...\n" +msgstr "終了の時が来ました。各部に停止指示を出しています…\n" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:82 +#, perl-brace-format +msgid "connected to {server}:{port}." +msgstr "{server}:{port} に接続しました。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:116 +#, perl-brace-format +msgid "{nick}: The NoPaste for {channel} is at {url}" +msgstr "{nick}: {channel} の NoPaste は {url} に在ります。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:195 +msgid "Sorry, but you can't paste to this channel;\n" +msgstr "済みませんが、このチャンネルに貼り付ける事は出来ません。\n" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:201 +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:225 +msgid "allowed only for those who have op in it." +msgstr "op を持っている方のみに限られます。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:204 +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:228 +msgid "allowed only for those who have halfop in it." +msgstr "halfop を持っている方のみに限られます。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:207 +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:231 +msgid "allowed only for those who have voice in it." +msgstr "voice を持っている方のみに限られます。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:210 +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:234 +msgid "allowed only for those who are in it." +msgstr "入室している方のみに限られます。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste.pm:219 +msgid "Sorry, but you can't read posts pasted to this channel;\n" +msgstr "" +"済みませんが、このチャンネルへ貼り付けられた文章を読む事は出来ません。\n" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:64 +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:186 +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm:106 +msgid "Name" +msgstr "名前" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:88 +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:185 +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm:108 +msgid "Title" +msgstr "題名" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:91 +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm:110 +msgid "Body" +msgstr "本文" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:93 +msgid "Paste" +msgstr "貼り付ける" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:178 +msgid "There are no entries currently." +msgstr "項目は現在一つもありません。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:187 +msgid "Time Stamp" +msgstr "貼り付け時刻" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:213 +msgid "Please don't omit your name." +msgstr "名前を省略しないで下さい。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:216 +#, perl-brace-format +msgid "Please shorten your name up to {n} bytes." +msgstr "名前は {n} バイト以内に縮めて下さい。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:219 +msgid "Please don't omit the title." +msgstr "題名を省略しないで下さい。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:222 +#, perl-brace-format +msgid "Please shorten the title up to {n} bytes." +msgstr "題名は {n} バイト以内に縮めて下さい。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:225 +msgid "Please don't omit the body." +msgstr "本文を省略しないで下さい。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:228 +#, perl-brace-format +msgid "Please shorten the body up to {n} bytes." +msgstr "本文は {n} バイト以内に縮めて下さい。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:251 +msgid "A duplicated entry is being pasted." +msgstr "重複した貼付けを行おうとしています。" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Index.pm:270 +#, perl-brace-format +msgid "{nick} pasted an entry: {title}" +msgstr "{nick} が貼り付けました: {title}" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm:88 +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm:100 +#, perl-brace-format +msgid "Pasted by {name}" +msgstr "投稿者: {name}" + +#: ../lib/POE/Component/IRC/Plugin/NoPaste/Httpd/Pasted.pm:94 +msgid "Index" +msgstr "目次" diff --git a/rc.d/linux/pci-nopaste.in b/rc.d/linux/pci-nopaste.in new file mode 100644 index 0000000..1f1f007 --- /dev/null +++ b/rc.d/linux/pci-nopaste.in @@ -0,0 +1,126 @@ +#!/bin/sh +# +# /etc/init.d/pci-nopaste +# +### BEGIN INIT INFO +# Provides: pci-nopaste +# Required-Start: $local_fs $remote_fs $network +# Required-Stop: $local_fs $remote_fs $network +# Default-Start: 3 5 +# Default-Stop: 0 1 2 6 +# Short-Description: An obsolete implementation of no-paste, based on POE::Component::IRC +# Description: See http://git.cielonegro.org/gitweb.cgi?p=pci-nopaste.git;a=summary +### END INIT INFO + +pidfile="@localstatedir@/pci-nopaste/pci-nopaste.pid" +command="@DAEMON@ -f -p $pidfile @bindir@/pci-nopaste" +command_args="--config=@sysconfdir@/pci-nopaste.conf" +pci_nopaste_user="no-paste" + +success() { + RES_COL=60 + echo -en "\\033[${RES_COL}G" + echo -n "[" + echo -en "\\033[1;32m" + echo -n " OK " + echo -en "\\033[0;39m" + echo "]" +} + +failure() { + RES_COL=60 + echo -en "\\033[${RES_COL}G" + echo -n "[" + echo -en "\\033[1;31m" + echo -n "FAILED" + echo -en "\\033[0;39m" + echo "]" +} + +status() { + if [ -s "$pidfile" ]; then + read _pid < "$PIDFILE" + + if [ -n "$_pid" -a -d "/proc/$_pid" ]; then + echo "pci-nopaste (pid $_pid) is running..." + return 0 + else + echo "pci-nopaste is not running." + return 1 + fi + else + echo "pci-nopaste is not running." + return 1 + fi +} + +start() { + if status >/dev/null 2>&1; then + echo "pci-nopaste is already running." + return 0 + fi + + echo -n "Starting pci-nopaste.." + /bin/su -s /bin/sh "$pci_nopaste_user" \ + -c "$command $command_args" + RETVAL=$? + + if [ $RETVAL -eq 0 ]; then + success + else + failure + fi + + return $RETVAL +} + +stop() { + if ! status >/dev/null 2>&1; then + echo "pci-nopaste not running? (check $pidfile)." 1>&2 + exit 1 + fi + + echo -n "Stopping pci-nopaste: " + /bin/su -s /bin/sh "$pci_nopaste_user" \ + -c "kill -TERM $_pid" + RETVAL=$? + + if [ $? -eq 0 ]; then + success + else + failure + fi + + return $RETVAL +} + +restart() { + stop + start +} + +RETVAL=0 + +case "$1" in + start) + start + RETVAL=$? + ;; + stop) + stop + RETVAL=$? + ;; + restart|reload|force-reload) + restart + RETVAL=$? + ;; + status) + status + RETVAL=$? + ;; + *) + echo "Usage: $0 {start|stop|status|restart|reload|force-reload}" + RETVAL=1 +esac + +exit $RETVAL diff --git a/t/POE-Component-IRC-Plugin-NoPaste.t b/t/POE-Component-IRC-Plugin-NoPaste.t new file mode 100644 index 0000000..f52fb3c --- /dev/null +++ b/t/POE-Component-IRC-Plugin-NoPaste.t @@ -0,0 +1,15 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl POE-Component-IRC-Plugin-NoPaste.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test::More tests => 1; +BEGIN { use_ok('POE::Component::IRC::Plugin::NoPaste') }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + -- 2.40.0