Changeset 3019

Timestamp:

2002-02-27T18:57:30+13:00 (22 years ago)

Author:

jrm21

Message:

Fixes for when on windows - it was having a lot of trouble sorting out links
that were to dos-style filenames, so we convert '\' chars into '/' so we can
remove the directory prefix, otherwise the links were broken...

File:

• trunk/gsdl/perllib/plugins/HTMLPlug.pm (modified) (9 diffs)

trunk/gsdl/perllib/plugins/HTMLPlug.pm

@@ -141 +141 @@
     my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
     my $outhandle = $self->{'outhandle'};
-
     print $outhandle "HTMLPlug: processing $file\n"
     if $self->{'verbosity'} > 1;
 
+    if ($ENV{'GSDLOS'} =~ /^windows/i) {
+      # this makes life so much easier... perl can cope with unix-style '/'s.
+      $base_dir =~ s@(\\)+@/@g;
+      $file =~ s@(\\)+@/@g; 
+    }
     my $cursection = $doc_obj->get_top_section();
 
@@ -155 +159 @@
     # like when w3mir is used to download a website).
     my $web_url = "http://$file";
-    $web_url =~ s/\\/\//g; # for windows
     $doc_obj->add_utf8_metadata($cursection, "URL", $web_url);
 
@@ -258 +261 @@
     my $self = shift (@_);
     my ($textref, $base_dir, $file, $doc_obj, $cursection) = @_;
-
     # trap links
     if (!$self->{'nolinks'}) {
@@ -277 +279 @@
 
     # add text to document object
+    # turn \ into \\ so that the rest of greenstone doesn't think there
+    # is an escape code following. (Macro parsing loses them...)
+    $$textref =~ s/\\/\\\\/go;
     $doc_obj->add_utf8_text($cursection, $$textref);
 }
@@ -350 +355 @@
     $filename =~ s/^[^:]*:\/\///;
     $filename = &util::filename_cat($base_dir, $filename);
-    
+   
     my ($ext) = $filename =~ /(\.[^\.]*)$/;
 
@@ -391 +396 @@
     }
     
-    if ($before_hash =~ s/^((?:http|ftp|file):\/\/)//i) {
+    if ($before_hash =~ s@^((?:http|ftp|file)://)@@i) {
     my $type = $1;
 
@@ -415 +420 @@
     
     } elsif ($link !~ /^(mailto|news|gopher|nntp|telnet|javascript):/i) {
-    if ($before_hash =~ s/^\/// || $before_hash =~ /\\/) {
+    if ($before_hash =~ s@^/@@ || $before_hash =~ /\\/) {
 
         # the first directory will be the domain name if file_is_url
         # to generate archives, otherwise we'll assume all files are
         # from the same site and base_dir is the root
-            # This is not called in Windows
+
         if ($self->{'file_is_url'}) {
         my @dirs = split /[\/\\]/, $file;
         my $domname = shift (@dirs);
         $before_hash = &util::filename_cat($domname, $before_hash);
-        $before_hash =~ s/\\/\//g; # for windows
+        $before_hash =~ s@\\@/@g; # for windows
         }
         else
@@ -431 +436 @@
         # see if link shares directory with source document
         # => turn into relative link if this is so!
-        my $before_hash_fix = "";
         
-        # filename_cat appends / or \ to the beginning of the
-        # file pathname but in Windows we don't want to do that
         if ($ENV{'GSDLOS'} =~ /^windows/i) {
-            $before_hash_fix = $before_hash;
+            # too difficult doing a pattern match with embedded '\'s...
+            my $win_before_hash=$before_hash;
+            $win_before_hash =~ s@(\\)+@/@g;
+            # $base_dir is already similarly "converted" on windows.
+            if ($win_before_hash =~ s@^$base_dir/@@o) {
+              # if this is true, we removed a prefix
+              $before_hash=$win_before_hash;
+            }
+
         }
         else {
-            $before_hash_fix = &util::filename_cat("",$before_hash);
-        }
-
-        my $base_dir_win_match = $base_dir;
-        $base_dir_win_match =~ s/\\/\\\\/g;
-
-        $before_hash_fix =~ s/^$base_dir_win_match(\\|\/)//;
-        $before_hash = $before_hash_fix;
+            $before_hash = &util::filename_cat("",$before_hash);
+            $before_hash =~ s@^$base_dir/@@;
+        }
 
         }
@@ -665 +670 @@
     &BasPlug::read_file($self, $filename, $encoding, $language, $textref);
 
-    # turn \ into \\ so that the rest of greenstone doesn't think there
-    # is an escape code following.
-    $$textref =~ s/\\/\\\\/go;
 
     # Convert things like é to their UTF8 equivalents