lib/SuikaWiki/Name.pm


=head1 NAME

SuikaWiki::Name - SuikaWiki WikiName Implementation

=head1 DESCRIPTION

C<SuikaWiki::Name> implements WikiName related functions used in SuikaWiki.
SuikaWiki cope with two styles of WikiName: internal (array reference) form
and external (string) form.  This module provides "serializer" and "parser"
converting to each form, as well as "resolver" getting absolute WikiName
from relative WikiName and base WikiName.

This module is part of SuikaWiki.

=cut

package SuikaWiki::Name;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

use overload
    'eq' => sub {
      my ($n1, $n2) = @_;
      return 0 if not (ref $n1) or not (ref $n2);
      return 0 if @$n1 != @$n2;
      for (0..$#$n1) {
        return 0 if $n1->[$_] ne $n2->[$_];
      }
      return 1;
    },
    fallback => 1;

=head1 METHODS

=over 4

=item $name = SuikaWiki::Name->new ($name, %option)

Constructs a new instance of WikiName.  C<$name> can be either in external
or internal form and either in relative or absolute form.
C<wiki> or C<delimiter> option required when C<$name> is in external form.

Ensure <$name> is interpretable as an array reference when it is a reference
to something.

=cut

sub new ($;%) {
  my $class = shift;
  my ($name, %opt) = @_;
  my $self;
  if (ref $name) {
    $self = bless [@$name], $class;
  } else {
    my $root = $opt{root} || $opt{wiki}->{config}->{name}->{space}->{root};
    if ($name eq $root) {
      $self = bless [], $class;
    } else {
      my $delim = $opt{delimiter_reg} || $opt{delimiter}
               || $opt{wiki}->{config}->{name}->{space}->{separator_reg};
      $self = bless [split $delim, $name], $class;
    }
  }
  $self;
}

=item $string = $name->stringify (%option)

Returns WikiName in external (string) form.
C<delimiter> or C<wiki> option is required.

=cut

sub stringify ($%) {
  my ($self, %opt) = @_;
  if (@$self == 0) {
    $opt{root} || $opt{wiki}->{config}->{name}->{space}->{root};
  } else {
    my $delim = $opt{delimiter}
             || $opt{wiki}->{config}->{name}->{space}->{separator};
    join $delim, @$self;
  }
}

=item $name->append_component ($component)

Appends WikiName component.  C<$component> is either a reference
interpretable as an array reference or a string.

=cut

sub append_component ($$%) {
  my ($self, $component) = @_;
  push @$self, ref $component ? @$component : $component;
}

=item $name->prepend_component ($component)

Prepends WikiName component.  C<$component> is either a reference
interpretable as an array reference or a string.

=cut

sub prepend_component ($$%) {
  my ($self, $component) = @_;
  unshift @$self, ref $component ? @$component : $component;
}

=item $abs = $name->absolute (base => $base, %option)

Resolves WikiName to absolute form.  New instance is constructed.
Either C<self> and C<parent> options or C<wiki> option required
to specify "self" and "parent" indicator.

=cut

sub absolute ($%) {
  my ($self, %opt) = @_;
  my @abs = @{$opt{base} ||= []};
  my @rel = @$self;
  my $Self = $opt{self} || $opt{wiki}->{config}->{name}->{space}->{self};
  my $Parent = $opt{parent} || $opt{wiki}->{config}->{name}->{space}->{parent};
  while ($rel[0] eq $Self or $rel[0] eq $Parent) {
    if ($rel[0] eq $Parent) {
      $#abs-- if @abs;
    }
    shift @rel;
  }
  if (@rel == @$self) {
    if ($opt{nearest}) {
      my @base = @abs;
      SEEK: {
        last SEEK unless $opt{wiki}->{db};
        while (@base) {
          if ($opt{wiki}->{db}->exist ($opt{nearest}, [@base, @rel])) {
            @abs = (@base, @rel);
            last SEEK unless @{$opt{base}} == @abs and
                             join ($,, @{$opt{base}}) eq join ($,, @abs);
          }
          pop @base;
        }
        @abs = @rel;
      }
    } else {
      @abs = @rel;
    }
  } else {
    push @abs, @rel;
  }
  ref ($self)->new (\@abs);
}

=item $clone = $name->clone

Generates a clone of C<$name> object.

=cut

sub clone ($;%) {
  my $self = shift;
  bless [@$self], ref $self;
}

=head1 TO DO

More study needed to enable to include delimiter string in WikiName 
(string form) as part of data.

=head1 LICENCE

Copyright 2004 Wakaba <w@suika.fam.cx>.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2004/04/01 04:45:50 $
1	wakaba	1.1
2			=head1 NAME
3
4			SuikaWiki::Name - SuikaWiki WikiName Implementation
5
6			=head1 DESCRIPTION
7
8			C<SuikaWiki::Name> implements WikiName related functions used in SuikaWiki.
9			SuikaWiki cope with two styles of WikiName: internal (array reference) form
10			and external (string) form. This module provides "serializer" and "parser"
11			converting to each form, as well as "resolver" getting absolute WikiName
12			from relative WikiName and base WikiName.
13
14			This module is part of SuikaWiki.
15
16			=cut
17
18			package SuikaWiki::Name;
19			use strict;
20	wakaba	1.4	our $VERSION = do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
21	wakaba	1.2
22			use overload
23			'eq' => sub {
24			my ($n1, $n2) = @_;
25			return 0 if not (ref $n1) or not (ref $n2);
26			return 0 if @$n1 != @$n2;
27			for (0..$#$n1) {
28			return 0 if $n1->[$_] ne $n2->[$_];
29			}
30			return 1;
31			},
32			fallback => 1;
33	wakaba	1.1
34			=head1 METHODS
35
36			=over 4
37
38			=item $name = SuikaWiki::Name->new ($name, %option)
39
40			Constructs a new instance of WikiName. C<$name> can be either in external
41			or internal form and either in relative or absolute form.
42			C<wiki> or C<delimiter> option required when C<$name> is in external form.
43
44			Ensure <$name> is interpretable as an array reference when it is a reference
45			to something.
46
47			=cut
48
49			sub new ($;%) {
50			my $class = shift;
51			my ($name, %opt) = @_;
52			my $self;
53			if (ref $name) {
54			$self = bless [@$name], $class;
55			} else {
56	wakaba	1.3	my $root = $opt{root} \|\| $opt{wiki}->{config}->{name}->{space}->{root};
57			if ($name eq $root) {
58			$self = bless [], $class;
59			} else {
60			my $delim = $opt{delimiter_reg} \|\| $opt{delimiter}
61			\|\| $opt{wiki}->{config}->{name}->{space}->{separator_reg};
62			$self = bless [split $delim, $name], $class;
63			}
64	wakaba	1.1	}
65			$self;
66			}
67
68			=item $string = $name->stringify (%option)
69
70			Returns WikiName in external (string) form.
71			C<delimiter> or C<wiki> option is required.
72
73			=cut
74
75			sub stringify ($%) {
76			my ($self, %opt) = @_;
77	wakaba	1.3	if (@$self == 0) {
78			$opt{root} \|\| $opt{wiki}->{config}->{name}->{space}->{root};
79			} else {
80			my $delim = $opt{delimiter}
81			\|\| $opt{wiki}->{config}->{name}->{space}->{separator};
82			join $delim, @$self;
83			}
84	wakaba	1.1	}
85
86			=item $name->append_component ($component)
87
88			Appends WikiName component. C<$component> is either a reference
89			interpretable as an array reference or a string.
90
91			=cut
92
93			sub append_component ($$%) {
94			my ($self, $component) = @_;
95			push @$self, ref $component ? @$component : $component;
96			}
97
98			=item $name->prepend_component ($component)
99
100			Prepends WikiName component. C<$component> is either a reference
101			interpretable as an array reference or a string.
102
103			=cut
104
105			sub prepend_component ($$%) {
106			my ($self, $component) = @_;
107			unshift @$self, ref $component ? @$component : $component;
108			}
109
110			=item $abs = $name->absolute (base => $base, %option)
111
112			Resolves WikiName to absolute form. New instance is constructed.
113			Either C<self> and C<parent> options or C<wiki> option required
114			to specify "self" and "parent" indicator.
115
116			=cut
117
118			sub absolute ($%) {
119			my ($self, %opt) = @_;
120	wakaba	1.4	my @abs = @{$opt{base} \|\|= []};
121	wakaba	1.1	my @rel = @$self;
122			my $Self = $opt{self} \|\| $opt{wiki}->{config}->{name}->{space}->{self};
123			my $Parent = $opt{parent} \|\| $opt{wiki}->{config}->{name}->{space}->{parent};
124			while ($rel[0] eq $Self or $rel[0] eq $Parent) {
125			if ($rel[0] eq $Parent) {
126			$#abs-- if @abs;
127			}
128			shift @rel;
129			}
130			if (@rel == @$self) {
131	wakaba	1.4	if ($opt{nearest}) {
132			my @base = @abs;
133			SEEK: {
134			last SEEK unless $opt{wiki}->{db};
135			while (@base) {
136			if ($opt{wiki}->{db}->exist ($opt{nearest}, [@base, @rel])) {
137			@abs = (@base, @rel);
138			last SEEK unless @{$opt{base}} == @abs and
139			join ($,, @{$opt{base}}) eq join ($,, @abs);
140			}
141			pop @base;
142			}
143			@abs = @rel;
144			}
145			} else {
146			@abs = @rel;
147			}
148	wakaba	1.1	} else {
149			push @abs, @rel;
150			}
151			ref ($self)->new (\@abs);
152			}
153
154	wakaba	1.2	=item $clone = $name->clone
155
156			Generates a clone of C<$name> object.
157
158			=cut
159
160			sub clone ($;%) {
161			my $self = shift;
162			bless [@$self], ref $self;
163			}
164
165	wakaba	1.1	=head1 TO DO
166
167			More study needed to enable to include delimiter string in WikiName
168			(string form) as part of data.
169
170			=head1 LICENCE
171
172			Copyright 2004 Wakaba <w@suika.fam.cx>. All rights reserved.
173
174			This program is free software; you can redistribute it and/or
175			modify it under the same terms as Perl itself.
176
177			=cut
178
179	wakaba	1.4	1; # $Date: 2004/04/01 04:45:50 $