X-Git-Url: https://git.distorted.org.uk/~mdw/tgal/blobdiff_plain/f615860793ef624269d888e88385647c73043938..24f4eac3128ad2053a503924519076a2cd342e95:/mason/.perl-lib/TrivGal.pm diff --git a/mason/.perl-lib/TrivGal.pm b/mason/.perl-lib/TrivGal.pm index ea3b47a..600e9f5 100644 --- a/mason/.perl-lib/TrivGal.pm +++ b/mason/.perl-lib/TrivGal.pm @@ -56,10 +56,10 @@ sub join_paths (@) { my @p = @_; my $p = ""; ELT: for my $e (@p) { - $e =~ s:^/{2,}:/:; - $e =~ s,([^/])/+$,$1,; + $e =~ s#^/{2,}#/#; + $e =~ s#([^/])/+$#$1#; if ($e eq "") { next ELT; } - elsif ($p eq "" || $e =~ m,^/,) { $p = $e; } + elsif ($p eq "" || $e =~ m#^/#) { $p = $e; } else { $p = "$p/$e"; } } return $p; @@ -69,7 +69,10 @@ export qw{split_path}; sub split_path ($) { my ($path) = @_; - my ($dir, $base, $ext) = $path =~ m,^(?:(.*)/)?(?:([^/]*)\.)?([^./]*)$,; + my ($dir, $base, $ext) = + $path =~ m#^ (?: (.*) /)? + (?: ([^/]*) \.)? + ([^./]*) $#x; if (defined $base) { $ext = ".$ext"; } else { $base = $ext; $ext = ""; } return ($dir, $base, $ext); @@ -78,14 +81,14 @@ sub split_path ($) { export qw{urlencode}; sub urlencode ($) { my ($u) = @_; - $u =~ s:([^0-9a-zA-Z_./~-]):sprintf "%%%02x", ord $1:eg; + $u =~ s#([^0-9a-zA-Z_./~-])#sprintf "%%%02x", ord $1#eg; return $u; } export qw{urldecode}; sub urldecode ($) { my ($u) = @_; - $u =~ s:\%([0-9a-fA-F]{2}):chr hex $1:eg; + $u =~ s#\%([0-9a-fA-F]{2})#chr hex $1#eg; return $u; } @@ -249,7 +252,7 @@ package TrivGal::Image { $scaled->image_set_format($ty->imlibfmt); $scaled->set_quality(90); - my $new = "$TMP/t${$}$ext"; + my $new = "$TMP/t$$-$ext"; make_path $TMP; $scaled->save($new); make_path $dir; @@ -282,6 +285,7 @@ sub listdir ($) { my (@d, @f); my $ix = undef; + $path =~ s#/$##; if (-f "$path/.tgal.index") { open my $f, "<", "$path/.tgal.index"; my $item = undef; @@ -294,10 +298,16 @@ sub listdir ($) { $comment = defined $comment ? $comment . "\n" . $_ : $_; } else { if ($item && $comment) { $item->comment($comment); } - my ($indexp, $name, $c) = /(!\s+)?(\S+)\s*(\S|\S.*\S)?\s*$/; + my ($indexp, $name, $c) = + /^ (! \s+)? # index flag + (\S+) \s* # filename + (\S | \S.*\S )? # start of the comment + \s* + $/x; $name = urldecode $name; my $list; - if ($name =~ m!/$!) { + $item = TrivGal::Item->new($name); + if ($name =~ m#/$#) { $list = \@d; die "can't index a folder" if $indexp; } else { @@ -309,7 +319,6 @@ sub listdir ($) { $ix = $item; } } - $item = TrivGal::Item->new($name); $comment = $c; push @$list, $item; } @@ -317,7 +326,7 @@ sub listdir ($) { if ($item && $comment) { $item->comment($comment); } close $f; } else { - my $st = stat "$path/$e"; + my $st = stat $path; unless ($st->mode&0004) { return ([], [], undef); } opendir $d, $path; @@ -330,7 +339,7 @@ sub listdir ($) { my $st = stat "$path/$e"; my $list = undef; if ($dotp) { } - elsif (-d $st) { $list = \@d; } + elsif (-d $st) { $list = \@d; $e .= "/"; } elsif ($TYPE{lc $ext} && -f $st) { $list = \@f; } $list and push @$list, TrivGal::Item->new($e); } @@ -363,7 +372,7 @@ sub find_covering_file ($$$) { for (;;) { my $stuff = contents "$top/$path/$name"; return $stuff if defined $stuff; if ($path eq "") { return undef; } - if ($path =~ m!^(.*)/[^/]+/?!) { $path = $1; } + if ($path =~ m#^(.*)/[^/]+/?#) { $path = $1; } else { $path = ""; } } }