# -*- perl -*- =head1 NAME SuikaWiki::Name::Space --- SuikaWiki: Namespace support for WikiName =cut package SuikaWiki::Name::Space; use strict; our $VERSION = do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; =head1 MEMBERS =over 4 =item $SuikaWiki::Name::Space::Delimiter (default '//') Namespace delimiter =item $SuikaWiki::Name::Space::Self (default '.') "Self" indicator used with relative path =item $SuikaWiki::Name::Space::Parent (default '..') "Parent" indicator used with relative path =cut our $Delimiter = '//'; our $Self = '.'; our $Parent = '..'; =item $normalized_name = SuikaWiki::Name::Space::normalize_name ($normalize_name, %option) Normalizes WikiName Options: =over 4 =item -might_be_ns_path => 1/0 (default 0) If C<1>, WikiName ends with delimiter is considered as a path, not a name. Unless this option is turned on, trailing delimiter(s) is ignored. =back =cut sub normalize_name ($%) { my ($name, %option) = @_; $name = join $Delimiter, grep {$_} split /\Q$Delimiter\E/, $name; if ($option{-might_be_ns_path}) { my $n = $_[0]; $n =~ s/.*?\Q$Delimiter\E//g; $name .= $Delimiter if $n eq ''; } $name; } =item 0/1 = SuikaWiki::Name::Space::validate_name ($normalized_name, %option) Validate WikiName and returns 1 if valid and 0 if invalid =cut sub validate_name ($%) { my ($name, %option) = @_; for (split /\Q$Delimiter\E/, $name) { return 0 if !$_ || $_ eq $Self || $_ eq $Parent; } 1; } =item $resolved_name = SuikaWiki::Name::Space::resolve_relative_name ($normalized_base_name => $normalized_name, %option) Resolves relative WikiName =cut sub resolve_relative_name ($$%) { my @base = split m#\Q$Delimiter\E#, $_[0]; my @name = split m#\Q$Delimiter\E#, $_[1]; if ($name[0] eq $Self || $name[0] eq $Parent) { my $n = $_[0]; $n =~ s/.*?\Q$Delimiter\E//g; push @base, '' if $n eq ''; } if ($name[0] eq $Self) { ## .//Foo//Bar @name = (@base, @name[1..$#name]); } elsif ($name[0] eq $Parent) { ## ..//Foo//Bar $#base--; @name = (@base, @name[1..$#name]); } join $Delimiter, @name; } =item $short_name = SuikaWiki::Name::Space::get_short_name ($normalized_long_name, %option) Returns "short" WikiName (ie. WikiName except its namespace) =cut sub get_short_name ($%) { my ($long_name) = @_; $long_name =~ s/.*?\Q$Delimiter\E//g; $long_name; } sub get_short_name_or_last_ns_name ($%) { my ($long_name) = @_; $long_name =~ s/.*?\Q$Delimiter\E//g; unless ($long_name) { $long_name = shift; $long_name =~ s/(.*?\Q$Delimiter\E)//g; $long_name = $1; } $long_name; } =item $path = SuikaWiki::Name::Space::get_path_name ($normalized_long_name, %option) Returns "path" of WikiName (ie. WikiName except its short name) =cut sub get_path_name ($%) { my $long_name = shift; my $path = ''; while ($long_name =~ s/(.*?\Q$Delimiter\E)//) { $path .= $1; } $path; } =item @parts = SuikaWiki::Name::Soace::split_name ($wiki_name) Splits WikiName and returns its as an array =cut sub split_name ($) { split m#\Q$Delimiter\E#, $_[0]; } =item $wiki_name = SuikaWiki::Name::Soace::join_names ([@parts]) Joins WikiName parts =cut sub join_names (\@) { join $Delimiter, @{$_[0]}; } =back =head1 SEE ALSO suikawiki.pl, suikawiki-config.ph, =head1 LICENSE Copyright 2003 Wakaba This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # $Date: 2003/04/03 01:08:17 $