view release on metacpan or  search on metacpan

lib/XML/TMX/Writer.pm  view on Meta::CPAN

    defined($options{srcencoding}) and $o{'o-encoding'} = $options{srcencoding};
    defined($options{id})          and $o{'creationid'} = $options{id};

    $self->_startTag(0, 'tmx', 'version' => 1.4)->_nl;
    $self->_startTag(1, 'header', %o)->_nl;

    $self->_write_props(2, $options{'-prop'}) if defined $options{'-prop'};
    $self->_write_notes(2, $options{'-note'}) if defined $options{'-note'};

    $self->_indent(1)->_endTag('header')->_nl;

    $self->_startTag(0,'body')->_nl->_nl;
}

sub _write_props {
    my ($self, $indent, $props) = @_;
    return unless ref($props) eq "HASH";
    for my $key (sort keys %$props) {
        if (ref($props->{$key}) eq "ARRAY") {
            for my $val (@{$props->{$key}}) {
                if ($key eq "_") {
                    $self->_startTag($indent, 'prop');
                } else {
                    $self->_startTag($indent, prop => (type => $key));
                }
                $self->_characters($val);
                $self->_endTag('prop')->_nl;
            }
        } else {
            if ($key eq "_") {
                $self->_startTag($indent, 'prop');
            } else {
                $self->_startTag($indent, prop => (type => $key));
            }
            $self->_characters($props->{$key});
            $self->_endTag('prop')->_nl;
        }
    }
}

sub _write_notes {
    my ($self, $indent, $notes) = @_;
    return unless ref($notes) eq "ARRAY";
    for my $p (@{$notes}) {
        $self->_startTag($indent, 'note');
        $self->_characters($p);
        $self->_endTag('note')->_nl;
    }
}


sub add_tu {
    my $self = shift;
    my %tuv = @_;
    my %prop = ();
    my @note = ();
    my %opt;

    my $verbatim = 0;
    my $cdata = 0;

    if (exists($tuv{-raw})) {
        # value already includes <tu> tags, hopefully, at least!
        # so we will not mess with it.
        $self->_write($tuv{-raw});
        return;
    }

    for my $key (qw'id datatype segtype srclang creationid creationdate changedate changeid') {
        if (exists($tuv{$key})) {
            $opt{$key} = $tuv{$key};
            delete $tuv{$key};
        }
    }
    if (defined($tuv{srcencoding})) {
        $opt{'o-encoding'} = $tuv{srcencoding};
        delete $tuv{srcencoding};
    }
    $verbatim++            if defined $tuv{-verbatim};
    delete $tuv{-verbatim} if exists  $tuv{-verbatim};

    if (defined($tuv{"-prop"})) {
        %prop = %{$tuv{"-prop"}};
        delete $tuv{"-prop"};
    }
    if (defined($tuv{"-note"})) {
        @note = @{$tuv{"-note"}};
        delete $tuv{"-note"};
    }
    if (defined($tuv{"-n"})) {
        $opt{id}=$tuv{"-n"};
        delete $tuv{"-n"};
    }

    $self->_startTag(0,'tu', %opt)->_nl;

    ### write the prop s <prop type="x-name">problemas 23</prop>
    $self->_write_props(3, \%prop);
    $self->_write_notes(3, \@note);

    for my $lang (sort keys %tuv) {
        my $cdata = 0;
        $self->_startTag(1, 'tuv', 'xml:lang' => $lang);
        if (ref($tuv{$lang}) eq "HASH") {
            $cdata++ if defined($tuv{$lang}{-iscdata});
            delete($tuv{$lang}{-iscdata}) if exists($tuv{$lang}{-iscdata});

            $self->_write_props(2, $tuv{$lang}{-prop}) if exists $tuv{$lang}{-prop};
            $self->_write_notes(2, $tuv{$lang}{-note}) if exists $tuv{$lang}{-note};
            $tuv{$lang} = $tuv{$lang}{-seg} || "";
        }
        $self->_startTag(0, 'seg');
        if ($verbatim) {
            $self->_write($tuv{$lang});
        } elsif ($cdata) {
            $self->_write("<![CDATA[");
            $self->_write($tuv{$lang});
            $self->_write("]]>");
        } else {
            $self->_characters($tuv{$lang});
        }
        $self->_endTag('seg');
        $self->_endTag('tuv')->_nl;
    }
    $self->_endTag('tu')->_nl->_nl;
}



sub end_tmx {
    my $self = shift();
    $self->_endTag('body')->_nl;
    $self->_endTag('tmx')->_nl;
    close($self->{OUTPUT});
}


sub _write {
    my $self = shift;
    print {$self->{OUTPUT}} @_;
    return $self;
}

sub _nl {
    my $self = shift;
    $self->_write("\n");
}

sub _startTag {
  my ($self, $indent, $tagName, %attributes) = @_;
  my $attributes = "";
  $attributes = " ".join(" ",map {"$_=\"$attributes{$_}\""} sort keys %attributes) if %attributes;
  $self->_indent($indent)->_write("<$tagName$attributes>");
}

sub _indent {
    my ($self, $indent) = @_;
    $indent = "  " x $indent;
    $self->_write($indent);
}

sub _characters {
    my ($self, $text) = @_;

    $text = "" unless defined $text;
    $text =~ s/\n/ /g;
    $text =~ s/  +/ /g;
    $text =~ s/&/&amp;/g;
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    $text =~ s!&lt;(b|emph)&gt;(.+?)&lt;/\1&gt;!<$1>$2</$1>!gs;

    $self->_write($text);
}