File Coverage

blib/lib/Web/Sitemap.pm
Criterion Covered Total %
statement 27 104 25.9
branch 0 40 0.0
condition 0 34 0.0
subroutine 9 22 40.9
pod 0 3 0.0
total 36 203 17.7


line stmt bran cond sub pod time code
1             package Web::Sitemap;
2              
3             our $VERSION = '0.902';
4              
5             =head1 NAME
6            
7             Web::Sitemap - Simple way to generate sitemap files with paging support
8              
9             =cut
10              
11             =head1 SYNOPSIS
12            
13             Each instance of the class Web::Sitemap is manage of one index file.
14             Now it always use Gzip compress.
15              
16              
17             use Web::Sitemap;
18            
19             my $sm = Web::Sitemap->new(
20             output_dir => '/path/for/sitemap',
21            
22             ### Options ###
23              
24             temp_dir => '/path/to/tmp',
25             loc_prefix => 'http://my_doamin.com',
26             index_name => 'sitemap',
27             file_prefix => 'sitemap.',
28            
29             # mark for grouping urls
30             default_tag => 'my_tag',
31            
32            
33             # add inside , and appropriate namespace (Google standard)
34             mobile => 1,
35            
36             # add appropriate namespace (Google standard)
37             images => 1,
38            
39             # additional namespaces (scalar or array ref) for
40             namespace => 'xmlns:some_namespace_name="..."',
41            
42             # location prefix for files-parts of the sitemap (default is loc_prefix value)
43             file_loc_prefix => 'http://my_doamin.com',
44              
45             # specify data input charset
46             charset => 'utf8',
47              
48             move_from_temp_action => sub {
49             my ($temp_file_name, $public_file_name) = @_;
50            
51             # ...some action...
52             #
53             # default behavior is
54             # File::Copy::move($temp_file_name, $public_file_name);
55             }
56              
57             );
58              
59             $sm->add(\@url_list);
60            
61              
62             # When adding a new portion of URL, you can specify a label for the file in which these will be URL
63            
64             $sm->add(\@url_list1, tag => 'articles');
65             $sm->add(\@url_list2, tag => 'users');
66            
67              
68             # If in the process of filling the file number of URL's will exceed the limit of 50 000 URL or the file size is larger than 10MB, the file will be rotate
69              
70             $sm->add(\@url_list3, tag => 'articles');
71              
72            
73             # After calling finish() method will create an index file, which will link to files with URL's
74              
75             $sm->finish;
76              
77             =cut
78              
79 1     1   17112 use strict;
  1         2  
  1         28  
80 1     1   3 use warnings;
  1         1  
  1         24  
81 1     1   624 use bytes;
  1         11  
  1         4  
82              
83 1     1   819 use File::Temp;
  1         21506  
  1         65  
84 1     1   513 use File::Copy;
  1         2035  
  1         772  
85 1     1   1449055 use IO::Compress::Gzip qw/gzip $GzipError/;
  1         515851  
  1         120  
86 1     1   619 use Encode;
  1         7836  
  1         85  
87              
88 1     1   452 use Web::Sitemap::Url;
  1         2  
  1         75  
89              
90             use constant {
91 1         1240 URL_LIMIT => 50000,
92             FILE_SIZE_LIMIT => 10 * 1024 * 1024,
93             FILE_SIZE_LIMIT_MIN => 1024 * 1024,
94              
95             DEFAULT_FILE_PREFIX => 'sitemap.',
96             DEFAULT_TAG => 'tag',
97             DEFAULT_INDEX_NAME => 'sitemap',
98              
99             XML_HEAD => '',
100             XML_MAIN_NAMESPACE => 'xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"',
101             XML_MOBILE_NAMESPACE => 'xmlns:mobile="http://www.google.com/schemas/sitemap-mobile/1.0"',
102             XML_IMAGES_NAMESPACE => 'xmlns:image="http://www.google.com/schemas/sitemap-image/1.1"'
103              
104 1     1   5 };
  1         1  
105              
106              
107             sub new {
108 0     0 0   my ($class, %p) = @_;
109              
110             my $self = {
111             output_dir => $p{output_dir},
112             temp_dir => $p{temp_dir},
113            
114             loc_prefix => $p{loc_prefix} || '',
115             tags => {},
116            
117             url_limit => $p{url_limit} || URL_LIMIT,
118             file_size_limit => $p{file_size_limit} || FILE_SIZE_LIMIT,
119             file_prefix => $p{file_prefix} || DEFAULT_FILE_PREFIX,
120             file_loc_prefix => $p{file_loc_prefix} || $p{loc_prefix} || '',
121             default_tag => $p{default_tag} || DEFAULT_TAG,
122             index_name => $p{index_name} || DEFAULT_INDEX_NAME,
123             mobile => $p{mobile} || 0,
124             images => $p{images} || 0,
125             namespace => $p{namespace},
126             charset => $p{charset} || 'utf8',
127              
128             move_from_temp_action => $p{move_from_temp_action}
129 0   0       };
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
130              
131 0 0         if ($self->{file_size_limit} < FILE_SIZE_LIMIT_MIN) {
132 0           $self->{file_size_limit} = FILE_SIZE_LIMIT_MIN;
133             }
134              
135 0 0         if ($self->{namespace}) {
136 0 0         if (ref $self->{namespace} eq '') {
    0          
137 0           $self->{namespace} = [ $self->{namespace} ];
138             }
139             elsif (ref $self->{namespace} ne 'ARRAY') {
140 0           die 'namespace must be scalar or array ref!';
141             }
142             }
143              
144 0 0         unless ($self->{output_dir}) {
145 0           die 'output_dir expected!';
146             }
147            
148 0 0 0       if ($self->{temp_dir} and not -w $self->{temp_dir}) {
149 0           die sprintf "Can't write to temp_dir '%s' (error: %s)", $self->{temp_dir}, $!;
150             }
151              
152 0 0 0       if ($self->{move_from_temp_action} and ref $self->{move_from_temp_action} ne 'CODE') {
153 0           die 'move_from_temp_action must be code ref!';
154             }
155              
156 0           return bless $self, $class;
157             }
158              
159             sub add {
160 0     0 0   my ($self, $url_list, %p) = @_;
161            
162 0   0       my $tag = $p{tag} || DEFAULT_TAG;
163              
164 0 0         if (ref $url_list ne 'ARRAY') {
165 0           die __PACKAGE__.'::add($url_list): $url_list must be array ref';
166             }
167              
168 0           for my $url (@$url_list) {
169             my $data = (__PACKAGE__. '::Url')->new( $url,
170             mobile => $self->{mobile},
171             loc_prefix => $self->{loc_prefix},
172 0           )->to_xml_string;
173              
174 0 0         if ($self->_file_limit_near($tag, bytes::length $data)) {
175 0           $self->_next_file($tag);
176             }
177            
178 0           $self->_append_url($tag, $data);
179             }
180             }
181              
182             sub finish {
183 0     0 0   my ($self, %p) = @_;
184              
185 0 0         return unless keys %{$self->{tags}};
  0            
186              
187 0           my $index_temp_file_name = $self->_temp_file->filename;
188 0 0         open INDEX_FILE, '>' . $index_temp_file_name or die "Can't open file '$index_temp_file_name'! $!\n";
189              
190 0           print INDEX_FILE XML_HEAD;
191 0           printf INDEX_FILE "\n", XML_MAIN_NAMESPACE;
192              
193 0           while (my ($tag, $data) = each %{$self->{tags}}) {
  0            
194 0           $self->_close_file($tag);
195 0           for my $page (1 .. $data->{page}) {
196 0           printf INDEX_FILE "\n%s/%s", $self->{file_loc_prefix}, $self->_file_name($tag, $page);
197             }
198             }
199              
200 0           print INDEX_FILE "\n";
201 0           close INDEX_FILE;
202              
203             $self->_move_from_temp(
204             $index_temp_file_name,
205 0           $self->{output_dir}. '/'. $self->{index_name}. '.xml'
206             );
207             }
208              
209             sub _move_from_temp {
210 0     0     my ($self, $temp_file_name, $public_file_name) = @_;
211              
212             #printf "move %s -> %s\n", $temp_file_name, $public_file_name;
213              
214 0 0         if ($self->{move_from_temp_action}) {
215 0           $self->{move_from_temp_action}($temp_file_name, $public_file_name);
216             }
217             else {
218 0 0         File::Copy::move($temp_file_name, $public_file_name)
219             or die sprintf 'move %s -> %s error: %s', $temp_file_name, $public_file_name, $!;
220             }
221             }
222              
223             sub _file_limit_near {
224 0     0     my ($self, $tag, $new_portion_size) = @_;
225              
226 0 0         return 0 unless defined $self->{tags}->{$tag};
227              
228             #printf("tag: %s.%d; url: %d; gzip_size: %d (%d)\n",
229             # $tag,
230             # $self->{tags}->{$tag}->{page},
231             # $self->{tags}->{$tag}->{url_count},
232             # $self->{tags}->{$tag}->{file_size},
233             # $self->{file_size_limit}
234             #);
235              
236             return (
237             $self->{tags}->{$tag}->{url_count} >= $self->{url_limit}
238             ||
239 0   0       ($self->{tags}->{$tag}->{file_size} + $new_portion_size) >= ($self->{file_size_limit} - 200) # 200 - на закрывающие теги в конце файла (с запасом)
240             );
241             }
242              
243             sub _temp_file {
244 0     0     my ($self) = @_;
245              
246             return File::Temp->new(
247             UNLINK => 1,
248             $self->{temp_dir}
249             ? ( DIR => $self->{temp_dir} )
250 0 0         : ()
251             );
252             }
253              
254             sub _set_new_file {
255 0     0     my ($self, $tag) = @_;
256            
257 0           my $temp_file = $self->_temp_file;
258              
259 0           $self->{tags}->{$tag}->{page}++;
260 0           $self->{tags}->{$tag}->{url_count} = 0;
261 0           $self->{tags}->{$tag}->{file_size} = 0;
262 0 0         $self->{tags}->{$tag}->{file} = IO::Compress::Gzip->new($temp_file->filename)
263             or die "gzip failed: $GzipError\n";
264 0           $self->{tags}->{$tag}->{file}->autoflush;
265 0           $self->{tags}->{$tag}->{temp_file} = $temp_file;
266             #
267             # Не проверяем тут файл на превышение размера, потому что файл пустой,
268             # и врядли начальные теги превысят хотябы 1Мб
269             #
270             $self->_append(
271             $tag,
272             sprintf(
273             "%s\n",
274             XML_HEAD,
275             join(' ',
276             XML_MAIN_NAMESPACE,
277             $self->{mobile}
278             ? XML_MOBILE_NAMESPACE
279             : (),
280             $self->{images}
281             ? XML_IMAGES_NAMESPACE
282             : (),
283             $self->{namespace}
284 0 0         ? @{$self->{namespace}}
  0 0          
    0          
285             : ()
286             )
287             )
288             );
289             }
290              
291             sub _file_handle {
292 0     0     my ($self, $tag) = @_;
293            
294 0 0         unless (exists $self->{tags}->{$tag}) {
295 0           $self->_set_new_file($tag);
296             }
297              
298 0           return $self->{tags}->{$tag}->{file};
299             }
300              
301             sub _append {
302 0     0     my ($self, $tag, $data) = @_;
303              
304 0           $self->_file_handle($tag)->print(Encode::encode($self->{charset}, $data));
305 0           $self->{tags}->{$tag}->{file_size} += bytes::length $data;
306             }
307              
308             sub _append_url {
309 0     0     my ($self, $tag, $data) = @_;
310              
311 0           $self->_append($tag, $data);
312 0           $self->{tags}->{$tag}->{url_count}++;
313             }
314              
315             sub _next_file {
316 0     0     my ($self, $tag) = @_;
317              
318 0           $self->_close_file($tag);
319 0           $self->_set_new_file($tag);
320             }
321              
322             sub _close_file {
323 0     0     my ($self, $tag) = @_;
324              
325 0           $self->_append($tag, "\n");
326 0           $self->_file_handle($tag)->close;
327            
328             $self->_move_from_temp(
329             $self->{tags}->{$tag}->{temp_file}->filename,
330 0           $self->{output_dir}. '/'. $self->_file_name($tag)
331             );
332             }
333              
334             sub _file_name {
335 0     0     my ($self, $tag, $page) = @_;
336 0   0       return $self->{file_prefix}. $tag. '.'. ($page || $self->{tags}->{$tag}->{page}). '.xml.gz';
337             }
338              
339             1;
340              
341              
342             =head1 DESCRIPTION
343              
344             Also support for Google images format:
345              
346             my @img_urls = (
347            
348             # Foramt 1
349             {
350             loc => 'http://test1.ru/',
351             images => {
352             caption_format => sub {
353             my ($iterator_value) = @_;
354             return sprintf('Vasya - foto %d', $iterator_value);
355             },
356             loc_list => [
357             'http://img1.ru/',
358             'http://img2.ru'
359             ]
360             }
361             },
362              
363             # Foramt 2
364             {
365             loc => 'http://test11.ru/',
366             images => {
367             caption_format_simple => 'Vasya - foto',
368             loc_list => ['http://img11.ru/', 'http://img21.ru']
369             }
370             },
371              
372             # Format 3
373             {
374             loc => 'http://test122.ru/',
375             images => {
376             loc_list => [
377             { loc => 'http://img122.ru/', caption => 'image #1' },
378             { loc => 'http://img133.ru/', caption => 'image #2' },
379             { loc => 'http://img144.ru/', caption => 'image #3' },
380             { loc => 'http://img222.ru', caption => 'image #4' }
381             ]
382             }
383             }
384             );
385              
386              
387             # Result:
388              
389            
390            
391            
392             http://test1.ru/
393            
394             http://img1.ru/
395            
396            
397            
398             http://img2.ru
399            
400            
401            
402            
403             http://test11.ru/
404            
405             http://img11.ru/
406            
407            
408            
409             http://img21.ru
410            
411            
412            
413            
414             http://test122.ru/
415            
416             http://img122.ru/
417            
418            
419            
420             http://img133.ru/
421            
422            
423            
424             http://img144.ru/
425            
426            
427            
428             http://img222.ru
429            
430            
431            
432            
433              
434             =cut
435              
436             =head1 AUTHOR
437              
438             Mikhail N Bogdanov C<< >>
439              
440             =cut
441