]> git.p6c8.net - selfforum.git/commitdiff
added version checks, fixed a small bug in Template.pm
authorndparker <>
Sat, 16 Jun 2001 22:02:23 +0000 (22:02 +0000)
committerndparker <>
Sat, 16 Jun 2001 22:02:23 +0000 (22:02 +0000)
selfforum-cgi/shared/Id.pm
selfforum-cgi/shared/Lock.pm
selfforum-cgi/shared/Mail.pm [deleted file]
selfforum-cgi/shared/Template.pm

index 480a57e2da7ff21179a7f10ca9482e4f3736ff2b..22535a20bc4ff605b8160d36f4aee3eff5320f39 100644 (file)
@@ -14,8 +14,15 @@ use strict;
 use vars qw(
   @table
   @EXPORT
+  $VERSION
 );
 
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
 ################################################################################
 #
 # Export
@@ -79,7 +86,7 @@ BEGIN {
   );
 }
 
-# keep require happy
+# keep 'require' happy
 1;
 
 #
index a611ce6b44c5757e2712dcc14939412b01fce0b5..88f9a5a8f27ec00f62ef1bd3f07f95547e407ba7 100644 (file)
@@ -19,11 +19,18 @@ use vars qw(
   $violentTimeout
   $masterTimeout
   $iAmMaster
+  $VERSION
 );
 
 use Carp;
 use Fcntl;
 
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
 ################################################################################
 #
 # Export
@@ -55,7 +62,7 @@ use base qw(Exporter);
   ALL   => \@EXPORT_OK
 );
 
-### sub ~file ($) ##############################################################
+### ~file () ###################################################################
 #
 # create lock file names
 #
@@ -77,7 +84,7 @@ sub masterlockfile ($) {
 # Windows section (no symlinks)
 #
 
-### sub w_lock_file ($;$) ######################################################
+### w_lock_file () #############################################################
 #
 # set read lock (shared lock)
 # (for no-symlink-systems)
@@ -115,7 +122,7 @@ sub w_lock_file ($;$) {
   0;
 }
 
-### sub w_unlock_file ($;$) ####################################################
+### w_unlock_file () ###########################################################
 #
 # remove read lock (shared lock)
 # (for no-symlink-systems)
@@ -151,7 +158,7 @@ sub w_unlock_file ($;$) {
   return;
 }
 
-### sub w_write_lock_file ($;$) ################################################
+### w_write_lock_file () #######################################################
 #
 # set write lock (exclusive lock)
 # (for no-symlink-systems)
@@ -214,7 +221,7 @@ sub w_write_lock_file ($;$) {
   0;
 }
 
-### sub w_write_unlock_file ($;$) ##############################################
+### w_write_unlock_file () #####################################################
 #
 # remove write lock (exclusive lock)
 # (for no-symlink-systems)
@@ -244,7 +251,7 @@ sub w_write_unlock_file ($;$) {
   1;
 }
 
-### sub w_violent_unlock_file ($) ##############################################
+### w_violent_unlock_file () ###################################################
 #
 # remove any lock violent  (excl. master lock)
 # (for no-symlink-systems)
@@ -276,7 +283,7 @@ sub w_violent_unlock_file ($) {
   return;
 }
 
-### sub w_set_master_lock ($;$) ################################################
+### w_set_master_lock () #######################################################
 #
 # set master lock
 # (for no-symlink-systems)
@@ -302,7 +309,7 @@ sub w_set_master_lock ($;$) {
   return;
 }
 
-### sub w_release_file ($) #####################################################
+### w_release_file () ##########################################################
 #
 # remove any locks (incl. master lock)
 # (for no-symlink-systems)
@@ -340,7 +347,7 @@ sub w_file_removed ($) {
 # *n*x section (symlinks possible)
 #
 
-### sub x_lock_file ($;$) ######################################################
+### x_lock_file () #############################################################
 #
 # set read lock (shared lock)
 # (symlinks possible)
@@ -378,7 +385,7 @@ sub x_lock_file ($;$) {
   0;
 }
 
-### sub x_unlock_file ($;$) ####################################################
+### x_unlock_file () ###########################################################
 #
 # remove read lock (shared lock)
 # (symlinks possible)
@@ -413,7 +420,7 @@ sub x_unlock_file ($;$) {
   }
 }
 
-### sub x_write_lock_file ($;$) ################################################
+### x_write_lock_file () #######################################################
 #
 # set write lock (exclusive lock)
 # (symlinks possible)
@@ -480,7 +487,7 @@ sub x_write_lock_file ($;$) {
   0;
 }
 
-### sub x_write_unlock_file ($;$) ##############################################
+### x_write_unlock_file () #####################################################
 #
 # remove write lock (exclusive lock)
 # (symlinks possible)
@@ -509,7 +516,7 @@ sub x_write_unlock_file ($;$) {
   1;
 }
 
-### sub x_violent_unlock_file ($) ##############################################
+### x_violent_unlock_file () ###################################################
 #
 # remove any lock violent  (excl. master lock)
 # (symlinks possible)
@@ -544,7 +551,7 @@ sub x_violent_unlock_file ($) {
     delete $LOCKED{$filename};
 }
 
-### sub x_set_master_lock ($;$) ################################################
+### x_set_master_lock () #######################################################
 #
 # set master lock
 # (symlinks possible)
@@ -570,7 +577,7 @@ sub x_set_master_lock ($;$) {
   return;
 }
 
-### sub x_release_file ($) #####################################################
+### x_release_file () ##########################################################
 #
 # remove any locks (incl. master lock)
 # (symlinks possible)
@@ -598,8 +605,8 @@ sub x_file_removed ($) {
   release_file (shift);
 }
 
-### sub w_simple_lock ($;$) ####################################################
-### sub w_simple_unlock ($) ####################################################
+### w_simple_lock () ###########################################################
+### w_simple_unlock () #########################################################
 #
 # simple file lock/unlock
 # (for no-symlink-systems: kill/create lockfile)
@@ -638,8 +645,8 @@ sub w_simple_unlock ($) {
   return;
 }
 
-### sub x_simple_lock ($;$) ####################################################
-### sub x_simple_unlock ($) ####################################################
+### x_simple_lock () ###########################################################
+### x_simple_unlock () #########################################################
 #
 # simple file lock/unlock
 # (symlinks possible: create/unlink symlink)
@@ -673,7 +680,7 @@ sub x_simple_unlock ($) {
   return;
 }
 
-### sub w_set_ref ($$$) ########################################################
+### w_set_ref () ###############################################################
 #
 # add $_[1] to reference counter
 # (may be negative...)
@@ -733,7 +740,7 @@ sub w_set_ref ($$$) {
   1;
 }
 
-### sub x_set_ref ($$$) ########################################################
+### x_set_ref () ###############################################################
 #
 # add $_[1] to reference counter
 # (may be negative...)
@@ -792,7 +799,7 @@ sub x_set_ref ($$$) {
   1;
 }
 
-### sub get_ref ($) ############################################################
+### get_ref () #################################################################
 #
 # read out the reference counter
 # (system independant)
@@ -866,7 +873,7 @@ BEGIN {
   }
 }
 
-# keeping require happy
+# keep 'require' happy
 1;
 
 #
diff --git a/selfforum-cgi/shared/Mail.pm b/selfforum-cgi/shared/Mail.pm
deleted file mode 100644 (file)
index 8070704..0000000
+++ /dev/null
@@ -1,247 +0,0 @@
-# Mail.pm
-
-##############################################
-#                                            #
-# Autor: n.d.p. nd@o3media.de                #
-#                                            #
-# Letze Aenderung: n.d.p. / 2001-01-03       #
-#                                            #
-# ========================================== #
-#                                            #
-# Funktion:                                  #
-#      ganz simples Formatieren und Senden   #
-#      einer Mail im text/plain, qp-Format   #
-#                                            #
-##############################################
-
-use strict;
-
-package Mail;
-
-use vars qw($mailbox $mailprog @EXPORT);
-
-use autouse 'CheckRFC' => qw(is_email($));
-
-# ===================
-# Funktionsexport
-# ===================
-
-use base qw(Exporter);
-@EXPORT = qw(is_mail_address send_mail);
-
-########################################
-# EXPORT
-# sub is_mail_address
-#
-# Funktion:
-#      Ueberpruefen der Syntax einer
-#      Email-Adresse
-#
-# Rueckgabe
-#      true/false
-########################################
-
-sub is_mail_address ($) {
-  return is_email $_[0];
-}
-
-########################################
-# EXPORT
-# sub send_mail
-#
-# Funktion:
-#      Senden der Nachricht
-#      ueber open-print-close
-#      $Mail::mailprog enthaelt
-#      den vollstaendigen string fuer
-#      open, dass heisst, es kann
-#      auch ein Dateiname sein.
-#
-# Rueckgabe:
-#      true/false
-########################################
-
-sub send_mail {
-  my $param=shift;
-  local *MAIL;
-
-  open MAIL,$mailprog or return 0;
-    print MAIL &as_string ($param);
-  close MAIL and return 1;
-
-  # Hier muss irgendwas schiefgelaufen sein
-  0;
-}
-
-##########################################
-# PRIVAT
-# sub as_string
-#
-# Funktion:
-#      Bereitstellung der gesamten Mail
-#      als String.
-#
-# Rueckgabe:
-#      String
-##########################################
-
-sub as_string {
-  my $param=shift;
-
-  my $header=&header_as_string ($param);
-  my $body=&body_as_string ($param);
-
-  # Rueckgabe
-  "$header\n$body\n";
-}
-
-##########################################
-# PRIVAT
-# sub body_as_string
-#
-# Funktion:
-#      Bereitstellung des Bodys
-#      als (qp-codierten) String.
-#
-# Rueckgabe:
-#      String
-##########################################
-
-sub body_as_string {
-  my $param=shift;
-
-  &encode_qp($param->{body});
-}
-
-##########################################
-# PRIVAT
-# sub header_as_string
-#
-# Funktion:
-#      Bereitstellung des Headers
-#      als String.
-#
-# Rueckgabe:
-#      String
-##########################################
-
-sub header_as_string {
-  my $param=shift;
-
-  my $string="Content-Disposition: inline\n";
-     $string.="MIME-Version: 1.0\n";
-     $string.="Content-Transfer-Encoding: quoted-printable\n";
-     $string.="Content-Type: text/plain\n";
-     $string.="Date: ".&rfc822_date(time)."\n";
-     $string.="From: ".$param->{'from'}."\n";
-     $string.=&get_list('To',$param->{'to'});
-     $string.=&get_list('Cc',$param->{'cc'});
-     $string.=&get_list('Bcc',$param->{'bcc'});
-     $string.="Subject: ".encode_qp($param->{'subject'})."\n";
-
-  # Rueckgabe
-  $string;
-}
-
-#######################################
-# PRIVAT
-# sub encode_qp
-#
-# C&P aus dem Modul MIME::QuotedPrint
-# Thanx for that
-#######################################
-
-sub encode_qp ($)
-{
-    my $res = shift;
-    $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;  # rule #2,#3
-    $res =~ s/([ \t]+)$/
-      join('', map { sprintf("=%02X", ord($_)) }
-                   split('', $1)
-      )/egm;                        # rule #3 (encode whitespace at eol)
-
-    # rule #5 (lines must be shorter than 76 chars, but we are not allowed
-    # to break =XX escapes.  This makes things complicated :-( )
-    my $brokenlines = "";
-    $brokenlines .= "$1=\n"
-        while $res =~ s/(.*?^[^\n]{73} (?:
-                 [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
-                |[^=\n]    (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
-                |          (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
-            ))//xsm;
-
-    "$brokenlines$res";
-}
-
-##############################################
-# PRIVAT
-# sub get_list
-#
-# Funktion:
-#      Aufbereitung einer Liste oder eines
-#      Strings fuer den Header (To, Cc, Bcc)
-#
-# Rueckgabe:
-#      Ergebnis oder nichts
-##############################################
-
-sub get_list ($$) {
-  my ($start,$list)=splice @_;
-
-  return $start . ': ' . $list . "\n" if (defined $list and not ref $list and length $list);
-
-  return $start . ': ' . join (', ',@$list) . "\n" if (ref $list);
-
-  '';
-}
-
-##############################################
-# PRIVAT
-# sub rfc822_date
-#
-# Funktion:
-#      Bereitstellung eines RFC-konformen
-#      Datumstrings
-#
-# Rueckgabe:
-#      Datumstring
-##############################################
-
-sub rfc822_date ($) {
-  my ($sek, $min, $std, $mtag, $mon, $jahr, $wtag) = gmtime (+shift);
-
-  sprintf ('%s, %02d %s %04d %02d:%02d:%02d GMT',
-             (qw(Sun Mon Tue Wed Thu Fri Sat))[$wtag],
-             $mtag,
-             (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon],
-             $jahr+1900, $std, $min, $sek);
-}
-
-##############################################
-# Modulinitialisierung
-# BEGIN
-#
-# Funktion:
-#      Bereitstellung des Regexps und des
-#      Mailprogs
-##############################################
-
-BEGIN {
-    # Standard-Mailprogramm
-
-    # Dieser String wird so, wie er ist, an die open-Anweisung geschickt,
-    # -t  = tainted(?),der Header (=alles bis zur ersten Leerzeile)
-    #       wird nach To:, Cc: und evtl. Bcc: abgesucht.
-    # -oi = damit wird verhindert, dass sendmail, ein Zeile, wo nur ein
-    #       Punkt drinsteht, als Mailende erkennt( waere Standard ).
-    # ===================================================================
-
-    $mailprog = '|/usr/lib/sendmail -t -oi';
-}
-
-# keeping require happy
-1;
-
-#####################
-# end of Mail
-#####################
\ No newline at end of file
index ece7eaa2f132bf6a0e79f08549c6179c65f32fb9..16562c91c706c7a80585e2d5f8c2c778c4961d20 100644 (file)
@@ -12,9 +12,15 @@ package Template;
 ################################################################################
 
 use strict;
-use vars qw($xml_dom_used);
+use vars qw(
+  $xml_dom_used
+  $VERSION
+);
 
-use Carp qw(croak confess);
+use Carp qw(
+  croak
+  confess
+);
 
 BEGIN {
   $xml_dom_used = eval q[
@@ -24,6 +30,13 @@ BEGIN {
   ];
 }
 
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+
 ### sub new ####################################################################
 #
 # constructor
@@ -178,7 +191,8 @@ sub scrap {
   );
 
   # remove newlines
-  $scrap =~ s/\n|\r\n|\n\r|\r//g if ($no_nl);
+  #
+  $scrap =~ s/\015\012|\015|\012//g if ($no_nl);
 
   # return
   \$scrap;
@@ -345,9 +359,9 @@ sub parse_if {
   return;
 }
 
-# keeping 'require' happy
+# keep 'require' happy
 1;
 
 #
 #
-### end of Template ############################################################
+### end of Template ############################################################
\ No newline at end of file

patrick-canterino.de