GNU/Linux->UNIX

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index 35bdb38..6a2189e 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -27,7 +27,7 @@ use Exporter;
 sub Wrequire ($);
 sub Wuse ($@);
 our $W;
-our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img $W &top_dir &top_dir_disk);
+our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img &centerimg $W &top_dir &top_dir_disk);
 our @ISA=qw(Exporter);
 
 BEGIN
@@ -413,6 +413,13 @@ my($url,$contents,%args)=@_;
        return $contents;
 }
 
+sub make ($)
+{
+my($cmd)=@_;
+
+       system {'flock'} 'flock','-x',top_dir_disk(),$cmd.' >&2';
+}
+
 sub img_size ($$)
 {
 my($width,$height)=@_;
@@ -433,18 +440,22 @@ my @img_variants=(
                { "id"=>"png","qs"=>1.0,"content-type"=>"image/png" },
                { "id"=>"gif","qs"=>0.9,"content-type"=>"image/gif" },
                );
-my $img_variants_re='[.](?:'.join('|',map(($_->{"id"}),@img_variants)).')$';
+my $img_variants_re='[.](?:'.join('|',"jpeg",map(($_->{"id"}),@img_variants)).')$';
 
 sub img_src ($)
 {
 my($file_base)=@_;
 
-       if (!url_is_local($file_base)
-                       # Known image extension?
-                       || $file_base=~m#$img_variants_re#o) {
+       if (!url_is_local($file_base)) {
                return $file_base if !wantarray();
                return ($file_base,$file_base);
                }
+       # Known image extension?
+       if ($file_base=~m#$img_variants_re#o) {
+               return $file_base if !wantarray();
+               return ($file_base,$file_base) if $file_base!~m#^/#;
+               return (top_dir($file_base),top_dir_disk().$file_base);
+               }
 
        my $file_base_disk;
        my $file_base_uri;
@@ -460,8 +471,8 @@ my($file_base)=@_;
        for my $var (@img_variants) {
                my $file=$file_base_disk.".".$var->{"id"};
                # TODO: Somehow quickly check dependencies?
-               system 'make >&2 -s --no-print-directory'
-                                               .' -C '."'".File::Basename::dirname($file)."' '".File::Basename::basename($file)."'"
+               make('make -s --no-print-directory'
+                                               .' -C '."'".File::Basename::dirname($file)."' '".File::Basename::basename($file)."'")
                                if !-f $file;
                push @nego_variants,negotiate_variant(
                                %$var,
@@ -477,16 +488,31 @@ my($file_base)=@_;
        return ($file_base_uri.".".$ext,$file_base_disk.".".$ext);
 }
 
-sub img ($$;$)
+sub img ($$;%)
 {
-my($file_base,$alt,$attrs)=@_;
+my($file_base,$alt,%attr)=@_;
 
        my($file_uri,$file_disk)=img_src $file_base;
        my($width,$height)=Image::Size::imgsize($file_disk);
        $alt=~s/<[^>]*>//g;
        $alt=CGI::escapeHTML($alt);
-       return "<img src=\"$file_uri\" alt=\"$alt\" title=\"$alt\" ".img_size($width,$height)
-                       .(!$attrs ? "" : " ".$attrs)." />";
+       my $content="<img src=\"$file_uri\" alt=\"$alt\" title=\"$alt\" ".img_size($width,$height)
+                       .(!$attr{"attr"} ? "" : " ".$attr{"attr"})." />";
+       return a_href img_src($attr{"a_href_img"}),$content if $attr{"a_href_img"};
+       return a_href $attr{"a_href"},$content if $attr{"a_href"};
+       return $content;
+}
+
+sub centerimg
+{
+       my $r.="";
+       $r.='<table border="0" width="100%"><tr>'."\n";
+       @_=( [@_] ) if !ref $_[0];
+       for (@_) {
+               $r.="\t".'<td align="center">'.&{\&img}(@$_).'</td>'."\n";
+               }
+       $r.='</tr></table>'."\n";
+       return $r;
 }
 
 sub readfile ($$)
@@ -567,6 +593,9 @@ HERE
 
        print '<meta name="robots" content="'.($W->{"indexme"} ? "" : "no" ).'index,follow" />'."\n";
        print $W->{"head"};
+       for my $type (qw(prev next index contents start up)) {
+               do { print '<link rel="'.$type.'" href="'.$_.'" />'."\n" if $_; } for ($W->{"rel_$type"});
+               }
        print "</head><body";
        print ' bgcolor="black" text="white" link="aqua" vlink="teal"'
                        if $W->{"browser"}->netscape() && $W->{"browser"}->major<=4;