rework relative paths, optimise images

perlorg · Jan 30, 2005 · 01ba28e · 01ba28e
1 parent 6140912
commit 01ba28e
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 10 deletions.
diff --git a/perlmongers/bin/xml b/perlmongers/bin/xml
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/home/acme/bin/perl -w
 
 use strict;
 use Image::WorldMap;
@@ -15,12 +15,13 @@ my $tt = Template->new({
   PRE_CHOMP => 1,
   TRIM => 1,
   EVAL_PERL => 1 ,
-  INCLUDE_PATH => ['lib', 'src'],
+  INCLUDE_PATH => ['.', 'lib', 'src'],
   PROCESS => 'layout',
 });
 
 # Array containing all the group names
 my @groups;
+mkdir "html/groups/graphics";
 
 foreach my $name (keys %$xml) {
   my $group = $xml->{$name};
@@ -40,11 +41,11 @@ foreach my $name (keys %$xml) {
     my $map = Image::WorldMap->new("titchy.png");
     $map->add($group->{location}->{longitude}, $group->{location}->{latitude});
     $map->draw("foo.png");
-    system("pngtopnm foo.png | ppmquant 255 | pnmtopng -compression 9 > html/groups/$id.png");
+    system("pngtopnm foo.png | ppmquant 64 | pnmtopng -compression 9 > html/groups/graphics/$id.png");
   }
-  $group->{image} = "$id.png";
+  $group->{image} = "graphics/$id.png";
 
-  $tt->process('groups/group.html', $group, "html/groups/$id.html")
+  $tt->process('src/groups/group.html', $group, "html/groups/$id.html")
     || die $tt->error();
 
 }

diff --git a/perlmongers/lib/relative b/perlmongers/lib/relative
@@ -1,13 +1,18 @@
 [% PERL %]
-use URI::URL;
+use File::Spec::Functions qw(abs2rel catfile splitpath);
 my $template = '/' . $stash->get('template.name');
 my $url = $stash->get('url');
+
 if ($url !~ /http/) {
-  my $uri = URI::URL->new('http://www/src' . $url);
-  $uri = $uri->rel('http://www' . $template);
-  $uri .= 'index.html' if $uri =~ m|/$|;
-  print $uri
+  $url =~ s{^/}{};
+  $url = catfile "/src", $url;
+  $url .= 'index.html' if $url =~ m|/$|;
+  my($volume, $directories, $filepart) = splitpath($template);
+  my $uri = abs2rel($url, $directories);
+#  warn "$template -> $url = $uri\n";
+  print $uri;
 } else {
+#  warn "$template -> $url = $url (URL)\n";
   print $url;
 }
 [% END %]