File Coverage

blib/lib/WWW/Sitemap/Simple.pm

Criterion	Covered	Total	%
statement	83	83	100.0
branch	21	24	87.5
condition	5	8	62.5
subroutine	17	17	100.0
pod	6	6	100.0
total	132	138	95.6

package WWW::Sitemap::Simple;
use strict;
use warnings;
use Carp qw/croak/;
use Digest::MD5 qw/md5_hex/;
use IO::File;
use Class::Accessor::Lite (
    rw  => [qw/ urlset indent fatal /],
    ro  => [qw/ url /],
);

our $VERSION = '0.05';

my $DEFAULT_XMLNS  = 'http://www.sitemaps.org/schemas/sitemap/0.9';
my $DEFAULT_INDENT = "\t";
my @KEYS = qw/ loc lastmod changefreq priority /;

our $LIMIT_URL_COUNT = 50000;
our $LIMIT_URL_SIZE  = 10_485_760; # byte

sub new {
    my $class = shift;
    my %args  = @_;

    bless {
        urlset => {
            xmlns => $DEFAULT_XMLNS,
        },
        indent => $DEFAULT_INDENT,
        fatal  => 1,
        %args,
        url => +{},
    }, $class;
}

sub count {
    return scalar( keys %{$_[0]->url} );
}

sub add {
    my ($self, $url, $params) = @_;

    my $id = $self->get_id($url);

    return $id if exists $self->url->{$id};

    $self->url->{$id} = {
        %{$params || +{}},
        loc => $url,
    };

    if ($self->fatal && $self->count > $LIMIT_URL_COUNT) {
        croak "too many URL added: no more than $LIMIT_URL_COUNT URLs";
    }

    return $id;
}

sub add_params {
    my ($self, $id, $params) = @_;

    croak "key is not exists: $id" unless exists $self->url->{$id};

    for my $key (@KEYS) {
        $self->url->{$id}{$key} = $params->{$key} if exists $params->{$key};
    }
}

sub get_id {
    my ($self, $url) = @_;

    return md5_hex(__PACKAGE__ . $url);
}

sub write {
    my ($self, $file) = @_;

    my $xml = $self->_get_xml;

    if ($self->fatal && length $xml > $LIMIT_URL_SIZE) {
        croak "too large xml: no more than $LIMIT_URL_SIZE bytes";
    }

    $self->_write($file => $xml);
}

sub _write {
    my ($self, $file, $xml) = @_;

    if (!$file) {
        STDOUT->print($xml);
    }
    elsif (my $re = ref $file) {
        if ($re eq 'GLOB') {
            print $file $xml;
        }
        else {
            $file->print($xml);
        }
    }
    else {
        $self->_write_file($file, $xml);
    }
}

sub _write_file {
    my ($self, $file, $xml) = @_;

    my $fh;
    if ($file =~ m!\.gz$!i) {
        require IO::Zlib;
        IO::Zlib->import;
        $fh = IO::Zlib->new($file => 'wb9');
    }
    else {
        $fh = IO::File->new($file => 'w');
    }
    croak "Could not create '$file'" unless $fh;
    $fh->print($xml);
    $fh->close;
}

sub _get_xml {
    my $self = shift;

    my $indent = $self->{indent} || '';

    my $xml = $self->_write_xml_header;

    for my $id (
        sort { $self->url->{$a}{loc} cmp $self->url->{$b}{loc} } keys %{$self->url}
    ) {
        my $item = "$indent\n";
        for my $key (@KEYS) {
            if ( my $value = $self->url->{$id}{$key} ) {
                $item .= "$indent$indent<$key>$value\n";
            }
        }
        $xml .= "$item$indent\n";
    }

    $xml .= $self->_write_xml_footer;

    return $xml;
}

sub _write_xml_header {
    my ($self) = @_;

    my $urlset_attr = '';
    for my $key (sort keys %{$self->urlset}) {
        my $value = $self->urlset->{$key};
        $urlset_attr .= qq| $key="$value"|;
    }
    my $header = <<"_XML_";


_XML_
    return $header;
}

sub _write_xml_footer {
    my ($self) = @_;

    my $footer = <<"_XML_";

_XML_
    return $footer;
}

1;

__END__