view release on metacpan or  search on metacpan

Site.pm  view on Meta::CPAN

                               : do { no strict 'refs';
                                      bless [\%{"$class\::FIELDS"}], $class };
    my $file = $_[0] or (warn(ERROR_SITE_NEEDED), return);

    (%{$self} = %{$file}, return $self) if UNIVERSAL::isa($file, 'HASH');

    unless (-e $file) {
        if (-e "$_[0].xml") {
            $file = "$_[0].xml";
        }
        elsif (-e "$_[0].fmt") {
            $file = "$_[0].fmt";
        }
        elsif (-e "$_[0].tt2") {
            $file = "$_[0].tt2";
        }
        else {
            foreach my $inc (@INC) {
                last if -e ($file = $inc . PATH_SITE . $_[0]);
                last if -e ($file = $inc . PATH_SITE . "$_[0].xml");
                last if -e ($file = $inc . PATH_SITE . "$_[0].fmt");
                last if -e ($file = $inc . PATH_SITE . "$_[0].tt2");
            }
        };
    }

    die(ERROR_FILE_NEEDED . $file) if !(-e $file);

    $self->parse($file);
    $self->{tempdata} = '';

    return $self;
}

# ---------------------------------------
# Subroutine geturl($self, $query, $hits)
# ---------------------------------------
sub geturl {
    my $self = shift;
    my $url  = $self->{url}{start};

    $url =~ s|_QUERY_|$_[0]|g;
    $url =~ s|_HITS_|$_[1]|g;
    $url =~ s|\${\s*query\s*}|$_[0]|g;
    $url =~ s|\${\s*hits\s*}|$_[1]|g;

    return $url;
}

# ------------------------------
# Subroutine parse($self, $file)
# ------------------------------
sub parse {
    my $self = shift;
    open(local *SITEFILE, $_[0]);

    if ($_[0] =~ m|\.xml$|i) { # XML descriptor
        local $/;
        my $content = <SITEFILE>;

        my $xml_cdata_re = '(<!\[CDATA\[)?\015?\012?(.*?)\015?\012?(]]>)?';

        $self->{id} = $1 if $content =~ m|<site id="(.*?)">|i;

        foreach my $tag (qw/charset score expression template proc/) {
            $self->{$tag} = $2 if $content =~ m|<$tag>$xml_cdata_re</$tag>|is;
        }

        foreach my $tag (qw/url var name info/) {
            $self->{$tag}{lc($1)} = $3 while
                $content =~ s|<$tag \w+="(.*?)">$xml_cdata_re</$tag>||is;
        }

        if ($content =~ m|<category>(.*?)</category>|i) {
            $self->{category} = [ split(',', $1) ];
        }
    }
    elsif ($_[0] =~ m|(?:.*[/\\])?(.*?)(?:\.fmt)$|i) { # Inforia Quest
        $self->{id} = $1;

        chomp($self->{name}{'en-us'} = <SITEFILE>);
        if ($self->{name}{'en-us'} =~ s|\((.+)\)||) {
            $self->{info}{'en-us'} = $1;
        }

        chomp($self->{url}{start} = <SITEFILE>);
        if ($self->{url}{start} =~ m|_START_\d+_\d+_|) {
            $self->{url}{more}  = $self->{url}{start};
            $self->{url}{start} =~ s|_START_\d+_(\d+)_|$1|;
        }

        while (chomp($_ = <SITEFILE>)) {
            (m|^---|) ? do {
                last;
            } :
            (m|^\w+://|) ? do {
                $self->{url}{backup} = $_;
            } :
            (m|^MORE\t(.+)|) ? do {
                $self->{url}{more} = $1;
            } :
            (m|^PROC\t(.+)|) ? do {
                $self->{proc} = $1;
            } :
            (m|^VAR\t(.+)|) ? do {
                $self->{var}{$1} = <SITEFILE> . $1 . <SITEFILE>;
                $self->{var}{$1} =~ s|[\t\015\012]||g;
            } :
            (m|^SCORE\t(.+)|) ? do {
                $self->{score} = $1;
                $self->{score} =~ s|\bx\b|_SCORE_|ig;
                $self->{score} =~ s|\by\b|_RANK_|ig;
            } :
            (m|^CHARSET\t(.+)|) ? do {
                $self->{charset} = CHARSET_MAP->{uc($1)};
            } :
            (m|^CHT\t(.+)|) ? do {
                $self->{name}{'zh-tw'} = $1;
                $self->{info}{'zh-tw'} = $self->{info}{'en-us'};
            } :
            (m|^CHS\t(.+)|) ? do {
                $self->{name}{'zh-cn'} = $1;
                $self->{info}{'zh-cn'} = $self->{info}{'en-us'};
            } :
            (m|^EXPR\t(.+)|) ? do {
                $self->{expression} = $1;
            } :
            (m|^TYPE\t(.+)|) ? do {
                $self->{category} = $1;
            } : undef;
        }