Szerkesztő:GumiBot/code81

A(z) 81. kódú hibát javító kódrészlet

sub fix_81 {	# Reference tag in article double
    my ($error_code, $title_str, $text_str) = @_;
    my @references; # = (   {
                    #           content => $content,
                    #           name    => $name,
                    #           key     => $key,
                    #           group   => $group,
                    #           set     => $set,
                    #           pos     => $pos,
                    #           len     => $len,
                    #       }, ...
                    #   )
    my %references; # = ( $group => {
                    #           list => [ $ref, ... (a fenti tomb elemei)],
                    #           set_by_name => { $name => $set, ...},
                    #           set_by_key => { $key => $set, ...},
                    #           sets => { $set => [ $ref, ...],...} ...),
                    #       },...
                    #   )

    while ($text_str =~ m|<ref((\s+\w+=("?)[^">]+\3)*)>(.*?)</ref>|gs) {
        my ($pos, $attribs, $content, $len) =
            (pos($text_str), $1, $4, length($&));
        $pos -= $len;
        if ($content =~ m|<ref[^>]*>|) {    # false hit
            pos($text_str) = $pos + length($attribs);
            next;
        }
        my $name = my $nquot = '';
        if ($attribs =~ m|name=("?)([^">]+)\1|) {
            $name = $2;
            $nquot = $1;
            $nquot or $name =~ s/\s*$//;
        }
        my $group;
        my $gquot = '';
        if ($attribs =~ m|group=("?)([^">]+)\1|) {
            $group = $2;
            $gquot = $1;
        }
        (my $key = lc $content) =~ s|[^\w:/\[\].]||g;
        $key = md5_base64($utf8->encode($key));
        $name ||= "auto_$key";
        my $ref = {
            'pos'   => $pos,
            content => $content,
            name    => $name,
            group   => $group,
            len     => $len,
            key     => $key,
            nquot   => $nquot,
            gquot   => $gquot,
        };
        push(@references, $ref);
        push(@{$references{$group}->{list}}, $ref);
    }
    pos($text_str) = 0;
    while ($text_str =~ m|<ref((\s+\w+=("?)[^">]+\3)+) */>|gs) {
        my ($pos, $attribs, $len) = (pos($text_str), $1, length($&));
        $pos -= $len;
        my $name = my $nquot = '';
        if ($attribs =~ m|name=("?)([^">]+)\1|) {
            $name = $2;
            $nquot = $1;
            $nquot or $name =~ s/\s*$//;
        }
        my $group = $2 if $attribs =~ m|group=("?)([^">]+)\1|;
        next unless $name;      # Hibas <reference/> tag. Felejtos
        my $ref = {
            'pos'   => $pos,
            name    => $name,
            nquot   => $nquot,
            group   => $group,
            len     => $len,
        };
        push(@references, $ref);
        push(@{$references{$group}->{list}}, $ref);
    }
    # Hatulrol elore sorbarakjuk oket
    @references = sort {$b->{'pos'} <=> $a->{'pos'}} @references;

    # Szetvalogatjuk az azonos referenciakat
    my $newset = 0;
    while (my ($group, $g) = each %references) {
        foreach my $ref (@{$g->{list}}) {
            my $name = $ref->{name};
            my $key = $ref->{key};
            my $set;
            if ($name and exists $g->{set_by_name}->{$name}) {
                $set = $g->{set_by_name}->{$name};
            }
            elsif ($key and exists $g->{set_by_key}->{$key}) {
                $set = $g->{set_by_key}->{$key};
            }
            else {
                $set = $newset++;
                $g->{set_by_key}->{$key}   = $set if $key;
                $g->{set_by_name}->{$name} = $set if $name;
            }
            $ref->{set} = $set;
            push(@{$g->{sets}->{$set}}, $ref);
        }
    }

    # Minden setben megkeressuk a legjobb cimet,
    my $count = 0;
    while (my ($group, $g) = each %references) {
        while (my ($set, $s) = each %{$g->{sets}}) {
            my $firstref;
            my $name;
            my $content;
            if (scalar @$s == 1) {          # a maganyosakat nem bantjuk
                $s->[0]->{name} = undef if $s->[0]->{name} =~ /^auto_/;
                next;
            }
            foreach my $ref (@$s) {
                $name ||= $ref->{name};         # a semminel barmi jobb
                $name = $ref->{name} if $name =~ /^auto_/;  # az auto_-nal is
                $content ||= $ref->{content};
            }
            $name or next;                      # fatalis hiba
            foreach my $ref (@$s) {
                $ref->{name} = $name;
                $ref->{nquot} ||= '"' unless $name =~ /^[\da-z]+$/i;
                $count++ if $ref->{content} and !$content;
                $ref->{content} = $content;
                $content = undef;
            }
        }
    }

    $count or return ('Nincs duplikalt referencia');

    # Vegul megtortenik a behelyettesites.
    foreach my $ref (@references) {     # emlekezz! hatulrol elore
        my $name = $ref->{name} or next;
        my $nquot = $ref->{nquot};
        my $group = $ref->{group};
        my $gquot = $ref->{gquot};
        my $gdesc = $group ? " group=$gquot$group$gquot" : '';

        my $replacement;
        if ($ref->{content}) {
            $replacement = qq{<ref name=$nquot$name$nquot$gdesc>$ref->{content}</ref>};
        }
        else {
            $replacement = qq{<ref name=$nquot$name$nquot$gdesc/>};
        }

        substr($text_str, $ref->{pos}, $ref->{len}) = $replacement;
    }
    my $summary_str = $latin2->decode(
        "Bot: $count referencia összevonva. (Hibakód: $error_code)"
    );

    return ($summary_str, $count, $text_str);
}