First version of hxsp (new version of UWOBO implemented in Perl by

[helm.git] / helm / hxsp / splitted / 9.load.p.pl

diff --git a/helm/hxsp/splitted/9.load.p.pl b/helm/hxsp/splitted/9.load.p.pl
new file mode 100644 (file)
index 0000000..2746b27
--- /dev/null
+++ b/helm/hxsp/splitted/9.load.p.pl
@@ -0,0 +1,149 @@
+#################################################################################################
+#################################################################################################
+#################################################################################################
+# Subrutines to load config files and templates
+#################################################################################################
+#################################################################################################
+#################################################################################################
+
+sub load_messages
+{
+   if ($language eq "IT")
+   {
+       open(MESSAGE, "./msg/message.it") || die "Can't open config file '/msg/message.it' : $!";
+   }
+   else
+   {
+       open(MESSAGE, "./msg/message.en") || die "Can't open config file '/msg/message.en' : $!";
+   }
+   while(my $line = <MESSAGE>) {
+      # ignore comments and full line comments
+      $line =~ s/#.*$//;
+      next unless $line =~ /\S/;
+      $line =~ s/\{URL\}/$puwobo_url/g;
+      $line =~ s/\{VER\}/$ver/g;
+      if ($line =~ /^(home_message)\s*=\s*(.*)$/) {$home_message = $2; }
+      if ($line =~ /^(help_message)\s*=\s*(.*)$/) {$help_message = $2; }
+      if ($line =~ /^(s_add)\s*=\s*(.*)$/) {$s_add = $2; }
+      if ($line =~ /^(s_reload)\s*=\s*(.*)$/) {$s_reload = $2; }
+      if ($line =~ /^(s_remove)\s*=\s*(.*)$/) {$s_remove = $2; }
+      if ($line =~ /^(list)\s*=\s*(.*)$/) {$list = $2; }
+      if ($line =~ /^(empty)\s*=\s*(.*)$/) {$empty = $2; }
+      if ($line =~ /^(all_usage)\s*=\s*(.*)$/) {$all_usage = $2; }
+      if ($all_usage_synerr eq "ON")
+      {
+         $help_usage=$add_usage=$remove_usage=$list_usage=$reload_usage=$apply_usage=$all_usage;
+      }
+      else
+      {
+         if ($line =~ /^(help_usage)\s*=\s*(.*)$/) {$help_usage = $2; }
+         if ($line =~ /^(add_usage)\s*=\s*(.*)$/) {$add_usage = $2; }
+         if ($line =~ /^(remove_usage)\s*=\s*(.*)$/) {$remove_usage = $2; }
+         if ($line =~ /^(list_usage)\s*=\s*(.*)$/) {$list_usage = $2; }
+         if ($line =~ /^(reload_usage)\s*=\s*(.*)$/) {$reload_usage = $2; }
+         if ($line =~ /^(apply_usage)\s*=\s*(.*)$/) {$apply_usage = $2; }
+      }
+   }
+   close MESSAGE;
+}
+
+sub load_conf
+{
+   open(CONFIG, "./config") || die "Can't open config file 'config' : $!";
+   while(my $line = <CONFIG>) {
+       # ignore comments and full line comments
+       $line =~ s/#.*$//;
+       next unless $line =~ /\S/;
+       if ($line =~ /^(working_path)\s*=\s*(.*)$/) {$working_path = $2; }
+       if ($line =~ /^(language)\s*=\s*(.*)$/) {$language = $2; }
+       if ($line =~ /^(port)\s*=\s*(.*)$/) {$port = $2; }
+       if ($line =~ /^(all_usage_synerr)\s*=\s*(.*)$/) {$all_usage_synerr = $2; }
+       if ($line =~ /^(expand_xinc)\s*=\s*(.*)$/) {$expand_xinc = $2; }
+       if ($line =~ /^(max_depth)\s*=\s*(.*)$/) {$max_depth = $2; }
+   }
+   close CONFIG;
+}
+
+sub load_err
+{
+   if ($language eq "IT")
+   {
+      open(ERRO, "./msg/error.it") || die "Can't open config file '/msg/error.it' : $!";
+   }
+   else
+   {
+      open(ERRO, "./msg/error.en") || die "Can't open config file '/msg/error.en' : $!";
+   }
+   while(my $line = <ERRO>)
+   {
+      # ignore comments and full line comments
+      $line =~ s/#.*$//;
+       next unless $line =~ /\S/;
+       if ($line =~ /^(.*?)\s*=\s*(.*)$/) {$error{$1} = $2; }
+   }
+   close ERRO;
+}
+
+sub load_templates
+{
+        # load ok template
+        open(OK_TPL, "./tpl/ok.tpl")
+        || die "Can't open template file '/tpl/ok.tpl' : $!";
+        while(my $line = <OK_TPL>) {$ok_tpl .= $line; }
+        close OK_TPL;
+
+        # load operror template
+        open(OPERROR_TPL, "./tpl/operror.tpl")
+        || die "Can't open template file '/tpl/operror.tpl' : $!";
+        while(my $line = <OPERROR_TPL>) {$operror_tpl .= $line; }
+        close OPERROR_TPL;
+
+        # load synerror template
+        open(SYNERROR_TPL, "./tpl/synerror.tpl")
+        || die "Can't open template file '/tpl/synerror.tpl' : $!";
+        while(my $line = <SYNERROR_TPL>) {$synerror_tpl .= $line; }
+        close SYNERROR_TPL;
+}
+
+#################################################################################################
+#################################################################################################
+#################################################################################################
+# the LibXML callbacks follow
+# these callbacks are used for both the original parse AND the XInclude (if set)
+#################################################################################################
+#################################################################################################
+#################################################################################################
+
+sub match_uri {
+    my $uri = shift;
+    return $uri !~ /:\/\// ? 1 : 0; # we handle only files
+}
+
+sub open_uri {
+    my $uri = shift;
+
+    my $handler = new IO::File;
+    if ( not $handler->open( "<$uri" ) ){
+        $file = 0;
+    }
+
+    return $file;
+}
+
+sub read_uri {
+    my $handler = shift;
+    my $length  = shift;
+    my $buffer = undef;
+    if ( $handler ) {
+        $handler->read( $rv , $length );
+    }
+    return $buffer;
+}
+
+sub close_uri {
+    my $handler = shift;
+    if ( $handler ) {
+        $handler->close();
+    }
+    return 1;
+}
\ No newline at end of file