root/lang/perl/Data-XMind/trunk/lib/Data/XMind.pm @ 25900

Revision 25900, 4.7 kB (checked in by woremacx, 6 years ago)

fixed bug on depth handling

Line 
1package Data::XMind;
2
3use strict;
4use warnings;
5use 5.8.1;
6
7our $VERSION = '0.01';
8
9use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
10
11use Data::XMind::Content;
12use Data::XMind::Util qw(newid);
13
14
15sub new {
16    my $class = shift;
17
18    my $self = bless {
19        @_,
20    }, $class;
21
22    $self->{id} ||= newid;
23
24    my $content = Data::XMind::Content->new(
25        title => $self->{title},
26    );
27    $content->{parent} = $self;
28
29    $self->{depth} = 0;
30    $self->{content} = $content;
31    $self->{last_content} = $self->{content};
32    $self->{parent} = undef;
33
34    $self;
35}
36
37sub title {
38    my $self = shift;
39
40    if (scalar(@_)) {
41        $self->{content}->{title} = shift;
42    }
43
44    $self->{content}->{title};
45}
46
47sub add {
48    my $self = shift;
49    my $opt = ref($_[0]) ? $_[0] : {@_};
50
51    die unless defined($opt->{depth}) && $opt->{depth} > 0;
52    die unless defined($opt->{title}) && length($opt->{title});
53
54    my $opt_depth = $opt->{depth};
55    my $last_depth = $self->{last_content}->{depth};
56
57    die if ($opt_depth == 0);
58
59    my $content = Data::XMind::Content->new(
60        title => $opt->{title},
61    );
62
63    if ($opt_depth < $last_depth) {
64        my $done = 0;
65        my $last_content = $self->{last_content};
66        my $parent;
67        while ($parent = $last_content->{parent}) {
68            if ($opt_depth == $parent->{depth}) {
69                $self->{last_content} = $parent;
70                $last_depth = $self->{last_content}->{depth};
71                $done++;
72                last;
73            }
74            $last_content = $parent;
75        }
76        die unless $done;
77    }
78
79    if ($opt_depth == $last_depth) {
80        $self->{last_content} = $self->{last_content}->{parent}->add($content);
81    }
82    elsif ($opt_depth == ($last_depth + 1)) {
83        $self->{last_content} = $self->{last_content}->add($content);
84    }
85
86    $self->{last_content};
87}
88
89sub add_note {
90    my $self = shift;
91    my $str = shift;
92
93    my $content = $self->{last_content};
94    $content->add_note($str);
95}
96
97my $template = << '__TMPL__';
98<?xml version="1.0" encoding="UTF-8" standalone="no"?>
99<xmap-content xmlns="urn:xmind:xmap:xmlns:content:2.0" xmlns:fo="http://www.w3.org/1999/XSL/Format" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xhtml="http://www.w3.org/1999/xhtml" xmlns:xlink="http://www.w3.org/1999/xlink" version="2.0">
100<sheet id="[% id %]">
101<title>[% title %]</title>
102[%- content -%]
103</sheet>
104</xmap-content>
105__TMPL__
106
107sub as_xml {
108    my $self = shift;
109
110    my $vars = {
111        id => $self->{id},
112        title => $self->{title},
113        content => $self->{content}->as_xml,
114    };
115
116    my $tt = Template->new;
117    $tt->process(\$template, $vars, \my $xml) or die $tt->error();
118
119    $xml;
120}
121
122sub as_xmind {
123    my $self = shift;
124    my $basename = scalar(@_) ? shift : time();
125
126    my $name = $basename . ".xmind";
127    my $zip = Archive::Zip->new;
128
129    my %data = (
130        'meta.xml' => '<?xml version="1.0" encoding="UTF-8" standalone="no"?><meta xmlns="urn:xmind:xmap:xmlns:meta:2.0" version="2.0"/>',
131        'content.xml' => $self->as_xml,
132        'META-INF/manifest.xml' => '<?xml version="1.0" encoding="UTF-8" standalone="no"?><manifest xmlns="urn:xmind:xmap:xmlns:manifest:1.0"><file-entry full-path="content.xml" media-type="text/xml"/><file-entry full-path="META-INF/" media-type=""/><file-entry full-path="META-INF/manifest.xml" media-type="text/xml"/></manifest>',
133    );
134
135    while (my ($key, $val) = each(%data)) {
136        my $str = $zip->addString($val, $key);
137        $str->desiredCompressionMethod(COMPRESSION_DEFLATED);
138    }
139
140    unless ($zip->writeToFileNamed($name) == AZ_OK) {
141        die 'write error';
142    }
143}
144
1451;
146__END__
147
148=encoding utf-8
149
150=for stopwords
151
152=head1 NAME
153
154Data::XMind - generates XMind file
155
156=head1 SYNOPSIS
157
158  use Data::XMind;
159
160  my $obj = Data::XMind->new(title => "woremacx");
161
162  $obj->add(title => "blogs", depth => 1);
163  $obj->add_note("about blogs written by woremacx");
164
165  $obj->add(title => "blog.woremacx.com", depth => 2);
166  $obj->add_note("http://blog.woremacx.com/");
167
168  $obj->add(title => "woremacx diary", depth => 2);
169  $obj->add_note("http://d.hatena.ne.jp/");
170
171  $obj->as_xmind("woremacx"); # you will get woremacx.xmind
172
173
174=head1 DESCRIPTION
175
176Data::XMind generates XMind file.
177
178eg/xmind_from_text.pl and eg/xmind_from_text_result.xmind are simple examples.
179
180=head1 METHODS
181
182=head2 title
183
184set title of first element
185
186=head2 add
187
188make a new element and put it in to appropriate element by depth
189
190=head2 add_note
191
192add note to last added element
193
194=head2 as_xml
195
196generate content.xml
197
198=head2 as_xmind
199
200generate xmind file
201
202=head1 AUTHOR
203
204woremacx E<lt>woremacx@cpan.orgE<gt>
205
206=head1 LICENSE
207
208This library is free software; you can redistribute it and/or modify
209it under the same terms as Perl itself.
210
211=head1 SEE ALSO
212
213=cut
Note: See TracBrowser for help on using the browser.