quickmsg
authorshort <>
Sat, 27 Sep 2003 12:30:37 +0000 (12:30 +0000)
committershort <>
Sat, 27 Sep 2003 12:30:37 +0000 (12:30 +0000)
CV.html.pl
Makefile.am
Redirect.pl [moved from redirect.pl with 98% similarity]
SendMsg.pl [new file with mode: 0755]
WebConfig.pm

index c512858..69a22c8 100755 (executable)
@@ -35,7 +35,7 @@ require 'My::Project';
 my $W=My::Web->init(
                "__PACKAGE__"=>__PACKAGE__,
                "title"=>'CV - Jan Kratochvil',
-               "footer_ids"=>0,
+               "footer"=>0,
                );
 My::Web->heading();
 
index ec18d28..baa3a06 100644 (file)
@@ -56,7 +56,8 @@ endif
 EXTRA_DIST+= \
        Index.html.pl \
        WebConfig.pm \
-       redirect.pl \
+       Redirect.pl \
        have_js.js.pl \
        robots.txt \
-       CV.html.pl
+       CV.html.pl \
+       SendMsg.pl
similarity index 98%
rename from redirect.pl
rename to Redirect.pl
index 59acbe5..6b51f62 100755 (executable)
@@ -18,6 +18,7 @@
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 
+package Redirect;
 require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway
 use vars qw($VERSION $CVS_ID);
 $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
diff --git a/SendMsg.pl b/SendMsg.pl
new file mode 100755 (executable)
index 0000000..c480be3
--- /dev/null
@@ -0,0 +1,60 @@
+#! /usr/bin/perl
+# 
+# $Id$
+# Quick Send Message
+# Copyright (C) 2003 Jan Kratochvil <project-www.jankratochvil.net@jankratochvil.net>
+# 
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; exactly version 2 of June 1991 is required
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+package SendMsg;
+require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway
+use vars qw($VERSION $CVS_ID);
+$VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
+$CVS_ID=q$Id$;
+use strict;
+use warnings;
+
+BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/,<F>)[0]]}; eval "use lib '$top_dir'"; close F; }
+use My::Web;
+use Apache::Constants qw(HTTP_NO_CONTENT);
+require "Mail::Send";
+
+
+my $W=My::Web->init(
+               "__PACKAGE__"=>__PACKAGE__,
+               "header_only"=>1,
+               "args_check"=>{
+                               "msgscript"=>'.*',      #       If 'text/javascript' is supported.
+                               "msghtml"=>'.*',        # No 'text/javascript' available.
+                               },
+               );
+my $msg=$W->{"args"}{"msghtml"} || $W->{"args"}{"msgscript"};
+if ($msg) {
+
+       my $subject=$msg.' @'.$W->{"r"}->uri();
+       print STDERR "Message: $subject\n";
+
+       my $send=Mail::Send->new();
+       $send->to(split /,/,$W->{"SendMsg_to"});
+       $send->subject($subject);
+       my $fh=$send->open();
+       print $fh "$subject\n\n";
+       for (sort keys %ENV) {
+               print $fh $_."=".$ENV{$_}."\n";
+               }
+       $fh->close();   # send it here
+
+       }
+$W->{"r"}->status(HTTP_NO_CONTENT);
index ee3b9cb..71f3a51 100644 (file)
@@ -35,6 +35,7 @@ require CGI;
 
 our %WebConfig=(
                "admin_mail"=>'web-www.jankratochvil.net@jankratochvil.net',
+               "SendMsg_to"=>'web-www.jankratochvil.net@jankratochvil.net',
                "cvs_id_author"=>sub {
                        my($name)=@_;
                                return My::Web::a_href("http://www.jankratochvil.net/","Jan Kratochvil") if 0