shared/Lock.pm: fixed a small bug (now returns 0 if occupied)

[selfforum.git] / selfforum-cgi / shared / Template.pm

diff --git a/selfforum-cgi/shared/Template.pm b/selfforum-cgi/shared/Template.pm
index 74626d981f7004567f0a7ee6b78750d6241141db..e74d1d24dcad70a7b2c8ba9b64bd0935fd3eafcb 100644 (file)
--- a/selfforum-cgi/shared/Template.pm
+++ b/selfforum-cgi/shared/Template.pm
@@ -12,6 +12,7 @@ use strict;
 
 package Template;
 
 
 package Template;
 

+use autouse 'Carp' => qw(croak confess);

 use XML::DOM;
 
 # ====================================================
 use XML::DOM;
 
 # ====================================================


@@ -63,7 +64,7 @@ sub file {
 
 sub insert {
   my $self=shift;
 
 sub insert {
   my $self=shift;

-  die "no template file specified" unless (defined $self -> {file});
+  croak "no template file specified" unless (defined $self -> {file});

 
   my $name=shift;
 
 
   my $name=shift;
 


@@ -81,7 +82,7 @@ sub list {
   my $self=shift;
   my $name=shift;
 
   my $self=shift;
   my $name=shift;
 

-  die "no template file specified" unless (defined $self->{file});
+  croak "no template file specified" unless (defined $self->{file});

 
   my $list = join '', map { ${ $self -> scrap ($name, $_) } } @{ +shift };
 
 
   my $list = join '', map { ${ $self -> scrap ($name, $_) } } @{ +shift };
 


@@ -99,7 +100,7 @@ sub scrap {
   my $self=shift;
   my $name=shift;
 
   my $self=shift;
   my $name=shift;
 

-  die "no template file specified" unless (defined $self->{file});
+  croak "no template file specified" unless (defined $self->{file});

 
   my %params;
 
 
   my %params;
 


@@ -140,22 +141,27 @@ sub parse_file {
 
   if (-f $self -> {file}) {
     my $filename = $self -> {file};
 
   if (-f $self -> {file}) {
     my $filename = $self -> {file};

-    my $xml = new XML::DOM::Parser -> parsefile ($filename);
+    my $xml = eval {
+      local $SIG{__DIE__};
+      new XML::DOM::Parser -> parsefile ($filename);
+    };
+    croak "error in template file '$filename': $@" if ($@);
+

     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 
     # Metas bestimmen
     $self -> {metaon}  = $template -> getAttribute ('metaon');
     $self -> {metaoff} = $template -> getAttribute ('metaoff');
 
     my $template = $xml -> getElementsByTagName ('Template', 0) -> item (0);
 
     # Metas bestimmen
     $self -> {metaon}  = $template -> getAttribute ('metaon');
     $self -> {metaoff} = $template -> getAttribute ('metaoff');
 

-    die "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff});
+    croak "missing meta defintion(s) in template file '$filename'." unless ($self -> {metaon} and $self -> {metaoff});

 
     $self -> {parsed} = {};
     foreach ($template -> getElementsByTagName ('Scrap', 0)) {
       my $name = $_ -> getAttribute ('id');
 
 
     $self -> {parsed} = {};
     foreach ($template -> getElementsByTagName ('Scrap', 0)) {
       my $name = $_ -> getAttribute ('id');
 

-      die "Element 'Scrap' requires attribute 'id' in template file '$filename'." unless (length ($name));
-      die "double defined id '$name' in template file '$filename'." if (exists ($self -> {parsed} -> {$name}));
-      die "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')." unless ($name =~ /^[_a-zA-Z]\S*$/);
+      croak "Element 'Scrap' requires attribute 'id' in template file '$filename'." unless (length ($name));
+      croak "double defined id '$name' in template file '$filename'." if (exists ($self -> {parsed} -> {$name}));
+      croak "use '/^[_a-zA-Z]\\S*\$/' for 'Scrap'-ids in template file '$filename' (wrong: '$name')." unless ($name =~ /^[_a-zA-Z]\S*$/);

 
       $self -> {parsed} -> {$name} = $_ -> getFirstChild -> getData;
       $self -> {parsed} -> {$name} =~ s/^\s+|\s+$//g;}
 
       $self -> {parsed} -> {$name} = $_ -> getFirstChild -> getData;
       $self -> {parsed} -> {$name} =~ s/^\s+|\s+$//g;}


@@ -174,7 +180,7 @@ sub parse_file {
 
 sub parse_if {
   my $self = shift;
 
 sub parse_if {
   my $self = shift;

-  my ($scrap,$params) = @_;
+  my ($scrap, $params) = @_;

 
   my $qmon  = quotemeta $self -> {metaon};
   my $qmoff = quotemeta $self -> {metaoff};
 
   my $qmon  = quotemeta $self -> {metaon};
   my $qmoff = quotemeta $self -> {metaoff};


@@ -183,46 +189,56 @@ sub parse_if {
   # ... aber er funktioniert :-)
   #
   # pfff - rekursive Strukturen iterativ parsen ist nicht wirklich witzig
   # ... aber er funktioniert :-)
   #
   # pfff - rekursive Strukturen iterativ parsen ist nicht wirklich witzig

-  while ($$scrap=~s[ ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # Wenn IF oder ELSE von
-                     (?=$qmon\s*%IF\s+.+?\s*$qmoff)           # IF gefolgt werden, soll
-                                                              # dieses Stueck uebersprungen
-                                                              # werden und erstmal mit der
-                                                              # naechsten Ebene weitergemacht
-                                                              # werden.
-
-                    |(                                        # hier beginnt $2
-                      $qmon\s*%IF\s+(.+?)\s*$qmoff            # IF
-                      (.*?)                                   # $4
-                      (?:
-                        $qmon\s*%ENDIF\s*$qmoff               # gefolgt von ENDIF
-                       |                                      # oder
-                        $qmon\s*%ELSE\s*$qmoff                # von ELSE... ($4 ELSE $5) $5 $6
-                        (.*?)
-                        $qmon\s*%ENDIF\s*$qmoff               # und ENDIF
-                      )
-                     )
-                   ]
-                   [my $ret;
-                    if ($2) {
-                      my ($t4,$t5,$t6) = ($4,$5,$6);
-                      my $flag=0;
-                      foreach (split /\s+/,$3) {
-                        if (exists($params->{$_}) and length(${$params->{$_}})) {$ret = $t4; $flag=1;last;}}
-                      $ret = $t5 unless ($flag);}
-                    else {$ret=$1;}
-                    $ret;
-                   ]gosex) {};
+  #
+
+  1 while ($$scrap =~ s {
+    ($qmon\s*%(?:IF|ELSE)\s+.+?\s*$qmoff.*?) # Wenn IF oder ELSE von
+    (?=$qmon\s*%IF\s+.+?\s*$qmoff)           # IF gefolgt werden, soll
+                                             # dieses Stueck uebersprungen
+                                             # werden und erstmal mit der
+                                             # naechsten Ebene weitergemacht
+                                             # werden.
+
+   |(                                        # hier beginnt $2
+     $qmon\s*%IF\s+(.+?)\s*$qmoff            # IF
+     (.*?)                                   # $4
+     (?:
+       $qmon\s*%ENDIF\s*$qmoff               # gefolgt von ENDIF
+      |                                      # oder
+       $qmon\s*%ELSE\s*$qmoff                # von ELSE... ($4 ELSE $5)
+       (.*?)
+       $qmon\s*%ENDIF\s*$qmoff               # und ENDIF
+     )
+    )
+  }
+  { my $ret;
+    if ($2) {
+      my ($t3, $t4, $t5) = ($3, $4, $5);
+
+      for (split /\s+/,$t3) {
+        next unless (
+          exists($params->{$_})
+          and length ${$params->{$_}}
+        );
+
+        $ret = $t4; last;
+      }
+
+      $ret = $t5 || '' unless (defined $ret);
+    }
+    else {
+      $ret=$1;
+    }
+
+    $ret;
+  }gosex);

 
   return;
 }
 
 
   return;
 }
 

-# ====================================================
-# Modulinitialisierung
-# ====================================================
-
-# making require happy
+# keep require happy

 1;
 
 1;
 

-# ====================================================
-# end of Template
-# ====================================================
\ No newline at end of file
+#
+#
+### end of Template ############################################################