File Coverage

blib/lib/MojoMojo/Controller/Export.pm
Criterion Covered Total %
statement 21 60 35.0
branch 0 12 0.0
condition n/a
subroutine 7 10 70.0
pod 1 1 100.0
total 29 83 34.9


line stmt bran cond sub pod time code
1             package MojoMojo::Controller::Export;
2              
3 35     35   17003 use strict;
  35         83  
  35         4976  
4 35     35   4051 use parent 'Catalyst::Controller';
  35         78  
  35         234  
5              
6 35     35   22444 use Archive::Zip;
  35         905752  
  35         1388  
7 35     35   296 use DateTime;
  35         79  
  35         417  
8 35     35   699 use Encode ();
  35         83  
  35         11525  
9              
10             my $model = '$c->model("DBIC::Page")';
11              
12             =head1 NAME
13              
14             MojoMojo::Controller::Export - Export / Import related controller
15              
16             =head1 SYNOPSIS
17              
18              
19             =head1 DESCRIPTION
20              
21             MojoMojo has an extensive export system. You can download all the
22             nodes of the wiki either as preformatted HTML, for offline reading
23             or in a raw format suitable for reimporting into another MojoMojo
24             installation. Either way, MojoMojo will create and send you a zip
25             file with a directory containing all the files. The name of the
26             directory will contain a timestamp showing when the archive was made.
27              
28             =head1 ACTIONS
29              
30             =head2 generate_export_filename
31              
32             Create the filename under which we export pages.
33              
34             =cut
35              
36             sub generate_export_filename {
37 0     0     my ($c, $export_type) = @_;
38 0           my $now = DateTime->now();
39            
40             my $prefix = sprintf("%s-%s-$export_type-%s",
41             $c->fixw( $c->pref('name') ),
42 0           substr($c->stash->{page}->path, 1), # skip the leading slash, because it will be replaced by an underscore
43             $now->ymd . 'T' . $now->hms('-')
44             );
45 0           $prefix =~ s|/|_|g;
46 0           return $prefix;
47             }
48              
49             =head2 export_raw
50              
51             This action will give you a ZIP file containing the raw wiki source
52             for all the nodes of the wiki.
53              
54             =cut
55              
56             sub export_raw : Global {
57 0     0   0 my ( $self, $c ) = @_;
58 0 0       0 if ( !$c->user_exists() ) {
59 0         0 $c->stash->{message} = $c->loc('To export, you must be logged in.');
60 0         0 $c->detach('MojoMojo::Controller::PageAdmin', 'unauthorized');
61             }
62            
63 0         0 my $prefix = generate_export_filename($c, 'markup');
64              
65 0 0       0 unless ( $c->res->{body} = $c->cache->get($prefix) ) {
66 0         0 my @pages = $c->stash->{page}->descendants;
67 0         0 my $archive = Archive::Zip->new();
68 0         0 $archive->addDirectory("$prefix/");
69 0         0 foreach my $page (@pages) {
70 0 0       0 next if not $page->content;
71             # XXX - see notes from export_html about encode_utf8
72 0 0       0 $archive->addString(
73             Encode::encode_utf8($page->content->body),
74             $prefix . $page->path . ( $page->path eq '/' ? '' : '/' ) . 'index' );
75             }
76 0         0 my $fh = IO::Scalar->new( \$c->res->{body} );
77 0         0 $archive->writeToFileHandle($fh);
78 0         0 $c->cache->set( $prefix, $c->res->body );
79             }
80 0         0 $c->res->headers->header( "Content-Type" => 'archive/zip' );
81 0         0 $c->res->headers->header( "Content-Disposition" => "attachment; filename=$prefix.zip" );
82 35     35   251 }
  35         88  
  35         318  
83              
84             =head2 export_html (/.export_html)
85              
86             This action will give you a ZIP file containing HTML formatted
87             versions of all the nodes of the wiki.
88              
89             =cut
90              
91             sub export_html : Global {
92 0     0 1   my ( $self, $c ) = @_;
93 0 0         if ( !$c->user_exists() ) {
94 0           $c->stash->{message} = $c->loc('To export, you must be logged in.');
95 0           $c->detach('MojoMojo::Controller::PageAdmin', 'unauthorized');
96             }
97            
98 0           my $prefix = generate_export_filename($c, 'html');
99              
100 0 0         unless ( $c->res->{body} = $c->cache->get($prefix) ) {
101 0           my @pages = $c->stash->{page}->descendants;
102 0           my $archive = Archive::Zip->new();
103 0           $archive->addDirectory("$prefix/");
104 0           foreach my $page (@pages) {
105 0           $c->log->debug( 'Rendering ' . $page->path );
106             # XXX - Note: subreq calls and gets unicode data from Catalyst
107             # (because we're using Plugin::Unicode ;). However,
108             # seems like Compress::Zlib expects octets -- so we explicitly
109             # encode them back to utf8 - lestrrat
110 0           $archive->addString(
111             Encode::encode_utf8($c->subreq( '/print', { path => $page->path } )),
112             $prefix . $page->path . "/index.html"
113             );
114             }
115 0           my $fh = IO::Scalar->new( \$c->res->{body} );
116 0           $archive->writeToFileHandle($fh);
117 0           $c->cache->set( $prefix, $c->res->body );
118             }
119 0           $c->res->headers->header( "Content-Type" => 'archive/zip' );
120 0           $c->res->headers->header( "Content-Disposition" => "attachment; filename=$prefix.zip" );
121 35     35   496259 }
  35         103  
  35         182  
122              
123             =head1 AUTHOR
124              
125             Marcus Ramberg <mramberg@cpan.org>
126              
127             =head1 LICENSE
128              
129             This library is free software. You can redistribute it and/or modify
130             it under the same terms as Perl itself.
131              
132             =cut
133              
134             1;