Net-FCP/FCP/Metadata.pm

=head1 NAME

Net::FCP::Metadata - metadata utility class.

=head1 SYNOPSIS

 use Net::FCP::Metadata;

=head1 DESCRIPTION

=over 4

=cut

package Net::FCP::Metadata;

use Carp ();

use Net::FCP::Util qw(tolc touc xeh);

no warnings;

use overload
   '""' => sub { $_[0]->as_string };

=item $metadata = new Net::FCP::Metadata [$string_or_object]

Creates a new metadata Object from the given string or reference. The
object is overloaded and will stringify into the corresponding string form
(which might be slightly different than the string it was created from).

If no arguments is given, creates a new metadata object with just a
C<version> part.

The object is implemented as a hash reference. See C<parse_metadata>,
below, for info on it's structure.

=cut

sub new {
   my ($class, $data) = @_;

   $data = ref $data ? %$data
         : $data     ? parse_metadata ($data)
         :             { version => { revision => 1 } };

   bless $data, $class;
}

=item $metadata->as_string

Returns the string form of the metadata data.

=cut

sub as_string {
   build_metadata ($_[0]);
}

=item $metadata->add_redirect ($name, $target[ info1 => arg1...])

Add a simple redirection to the C<document> section to the given
target. All extra arguments will be added to the C<info> subsection and
often contains C<description> and C<format> fields.

=cut

sub add_redirect {
   my ($self, $name, $target, %info) = @_;

   push @{ $self->{document} }, {
      redirect => { target => $target },
      $name ? (name => $name) : (),
      %info ? (info => \%info) : (),
   };
}

=item $meta = Net::FCP::Metadata::parse_metadata $string

Internal utility function, do not use directly!

Parse a metadata string and return it.

The metadata will be a hashref with key C<version> (containing the
mandatory version header entries) and key C<raw> containing the original
metadata string.

All other headers are represented by arrayrefs (they can be repeated).

Since this description is confusing, here is a rather verbose example of a
parsed manifest:

   (
      raw => "Version...",
      version => { revision => 1 },
      document => [
                    {
                      info => { format" => "image/jpeg" },
                      name => "background.jpg",
                      redirect => { target => "freenet:CHK\@ZcagI,ra726bSw" },
                    },
                    {
                      info => { format" => "text/html" },
                      name => ".next",
                      redirect => { target => "freenet:SSK\@ilUPAgM/TFEE/3" },
                    },
                    {
                      info => { format" => "text/html" },
                      redirect => { target => "freenet:CHK\@8M8Po8ucwI,8xA" },
                    }
                  ]
   )

=cut

sub parse_metadata {
   my $data = shift;
   my $meta = { raw => $data };

   if ($data =~ /^Version\015?\012/gc) {
      my $hdr = $meta->{version} = {};

      for (;;) {
         while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
            my ($k, $v) = ($1, $2);
            my @p = split /\./, tolc $k, 3;

            $hdr->{$p[0]}               = $v if @p == 1; # lamest code I ever wrote
            $hdr->{$p[0]}{$p[1]}        = $v if @p == 2;
            $hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3;
            die "FATAL: 4+ dot metadata"     if @p >= 4;
         }

         if ($data =~ /\GEndPart\015?\012/gc) {
            # nop
         } elsif ($data =~ /\GEnd(\015?\012|$)/gc) {
            last;
         } elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
            push @{$meta->{tolc $1}}, $hdr = {};
         } elsif ($data =~ /\G(.*)/gcs) {
            print STDERR "metadata format error ($1), please report this string: <<$data>>";
            die "metadata format error";
         }
      }
   }

   #$meta->{tail} = substr $data, pos $data;

   $meta;
}

=item $string = Net::FCP::Metadata::build_metadata $meta

Internal utility function, do not use directly!

Takes a hash reference as returned by C<Net::FCP::parse_metadata> and
returns the corresponding string form. If a string is given, it's returned
as is.

=cut

sub build_metadata_subhash($$$) {
   my ($prefix, $level, $hash) = @_;

   join "",
      map
         ref $hash->{$_} ? build_metadata_subhash ($prefix . (Net::FCP::touc $_) . ".", $level + 1, $hash->{$_})
                         : $prefix . ($level > 1 ? $_ : Net::FCP::touc $_) . "=" . $hash->{$_} . "\n",
         keys %$hash;
}

sub build_metadata_hash($$) {
   my ($header, $hash) = @_;

   if (ref $hash eq ARRAY::) {
      join "", map build_metadata_hash ($header, $_), @$hash
   } else {
      (Net::FCP::touc $header) . "\n"
      . (build_metadata_subhash "", 0, $hash)
      . "EndPart\n";
   }
}

sub build_metadata($) {
   my ($meta) = @_;

   return $meta unless ref $meta;

   $meta = { %$meta };

   delete $meta->{raw};

   my $res =
      (build_metadata_hash version => delete $meta->{version})
      . (join "", map +(build_metadata_hash $_, $meta->{$_}), keys %$meta);

   substr $res, -5, 4, ""; # get rid of "Part". Broken Syntax....

   $res;
}

=back

=head1 SEE ALSO

L<Net::FCP>.

=head1 BUGS

Not heavily tested.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1;

Revision:	1.5
Committed:	Thu Mar 3 17:31:26 2005 UTC (19 years, 3 months ago) by root
Branch:	MAIN
CVS Tags:	rel-1_1, rel-1_0, rel-1_2, HEAD
Changes since 1.4:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Net::FCP::Metadata - metadata utility class.
4
5			=head1 SYNOPSIS
6
7			use Net::FCP::Metadata;
8
9			=head1 DESCRIPTION
10
11			=over 4
12
13			=cut
14
15			package Net::FCP::Metadata;
16
17			use Carp ();
18
19	root	1.2	use Net::FCP::Util qw(tolc touc xeh);
20
21	root	1.1	no warnings;
22
23			use overload
24			'""' => sub { $_[0]->as_string };
25
26	root	1.3	=item $metadata = new Net::FCP::Metadata [$string_or_object]
27	root	1.1
28			Creates a new metadata Object from the given string or reference. The
29			object is overloaded and will stringify into the corresponding string form
30			(which might be slightly different than the string it was created from).
31
32	root	1.3	If no arguments is given, creates a new metadata object with just a
33			C<version> part.
34
35	root	1.1	The object is implemented as a hash reference. See C<parse_metadata>,
36			below, for info on it's structure.
37
38			=cut
39
40			sub new {
41			my ($class, $data) = @_;
42
43	root	1.3	$data = ref $data ? %$data
44			: $data ? parse_metadata ($data)
45			: { version => { revision => 1 } };
46	root	1.1
47			bless $data, $class;
48			}
49
50			=item $metadata->as_string
51
52			Returns the string form of the metadata data.
53
54			=cut
55
56			sub as_string {
57			build_metadata ($_[0]);
58			}
59
60	root	1.3	=item $metadata->add_redirect ($name, $target[ info1 => arg1...])
61
62			Add a simple redirection to the C<document> section to the given
63			target. All extra arguments will be added to the C<info> subsection and
64			often contains C<description> and C<format> fields.
65
66			=cut
67
68			sub add_redirect {
69			my ($self, $name, $target, %info) = @_;
70
71			push @{ $self->{document} }, {
72			redirect => { target => $target },
73			$name ? (name => $name) : (),
74			%info ? (info => \%info) : (),
75			};
76			}
77
78	root	1.1	=item $meta = Net::FCP::Metadata::parse_metadata $string
79
80			Internal utility function, do not use directly!
81
82			Parse a metadata string and return it.
83
84			The metadata will be a hashref with key C<version> (containing the
85			mandatory version header entries) and key C<raw> containing the original
86			metadata string.
87
88			All other headers are represented by arrayrefs (they can be repeated).
89
90			Since this description is confusing, here is a rather verbose example of a
91			parsed manifest:
92
93			(
94			raw => "Version...",
95			version => { revision => 1 },
96			document => [
97			{
98			info => { format" => "image/jpeg" },
99			name => "background.jpg",
100			redirect => { target => "freenet:CHK\@ZcagI,ra726bSw" },
101			},
102			{
103			info => { format" => "text/html" },
104			name => ".next",
105			redirect => { target => "freenet:SSK\@ilUPAgM/TFEE/3" },
106			},
107			{
108			info => { format" => "text/html" },
109			redirect => { target => "freenet:CHK\@8M8Po8ucwI,8xA" },
110			}
111			]
112			)
113
114			=cut
115
116			sub parse_metadata {
117			my $data = shift;
118			my $meta = { raw => $data };
119
120			if ($data =~ /^Version\015?\012/gc) {
121			my $hdr = $meta->{version} = {};
122
123			for (;;) {
124			while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
125			my ($k, $v) = ($1, $2);
126			my @p = split /\./, tolc $k, 3;
127
128			$hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
129			$hdr->{$p[0]}{$p[1]} = $v if @p == 2;
130			$hdr->{$p[0]}{$p[1]}{$p[2]} = $v if @p == 3;
131			die "FATAL: 4+ dot metadata" if @p >= 4;
132			}
133
134			if ($data =~ /\GEndPart\015?\012/gc) {
135			# nop
136			} elsif ($data =~ /\GEnd(\015?\012\|$)/gc) {
137			last;
138			} elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
139			push @{$meta->{tolc $1}}, $hdr = {};
140			} elsif ($data =~ /\G(.*)/gcs) {
141			print STDERR "metadata format error ($1), please report this string: <<$data>>";
142			die "metadata format error";
143			}
144			}
145			}
146
147			#$meta->{tail} = substr $data, pos $data;
148
149			$meta;
150			}
151
152			=item $string = Net::FCP::Metadata::build_metadata $meta
153
154			Internal utility function, do not use directly!
155
156			Takes a hash reference as returned by C<Net::FCP::parse_metadata> and
157			returns the corresponding string form. If a string is given, it's returned
158			as is.
159
160			=cut
161
162			sub build_metadata_subhash($$$) {
163			my ($prefix, $level, $hash) = @_;
164
165			join "",
166			map
167			ref $hash->{$_} ? build_metadata_subhash ($prefix . (Net::FCP::touc $_) . ".", $level + 1, $hash->{$_})
168			: $prefix . ($level > 1 ? $_ : Net::FCP::touc $_) . "=" . $hash->{$_} . "\n",
169			keys %$hash;
170			}
171
172			sub build_metadata_hash($$) {
173			my ($header, $hash) = @_;
174
175			if (ref $hash eq ARRAY::) {
176			join "", map build_metadata_hash ($header, $_), @$hash
177			} else {
178			(Net::FCP::touc $header) . "\n"
179			. (build_metadata_subhash "", 0, $hash)
180			. "EndPart\n";
181			}
182			}
183
184			sub build_metadata($) {
185			my ($meta) = @_;
186
187			return $meta unless ref $meta;
188
189			$meta = { %$meta };
190
191			delete $meta->{raw};
192
193			my $res =
194			(build_metadata_hash version => delete $meta->{version})
195			. (join "", map +(build_metadata_hash $_, $meta->{$_}), keys %$meta);
196
197	root	1.3	substr $res, -5, 4, ""; # get rid of "Part". Broken Syntax....
198
199			$res;
200	root	1.1	}
201
202			=back
203
204			=head1 SEE ALSO
205
206			L<Net::FCP>.
207
208			=head1 BUGS
209
210			Not heavily tested.
211
212			=head1 AUTHOR
213
214	root	1.5	Marc Lehmann <schmorp@schmorp.de>
215	root	1.4	http://home.schmorp.de/
216	root	1.1
217			=cut
218
219			1;
220