viewvc.cgi/Z3950-HTML-Scraper/COBISS.pm

package COBISS;

use warnings;
use strict;

use WWW::Mechanize;

sub search {

        my $url = 'http://cobiss.izum.si/scripts/cobiss?ukaz=GETID&lani=en';

warn "# get $url\n";

        my $mech = WWW::Mechanize->new();
        $mech->get( $url );

warn "# got session\n";

        $mech->follow_link( text_regex => qr/union/ );

warn "# submit search\n";

        $mech->submit_form(
                fields => {
                        'SS1' => 'Krleza',
                },
        );

        my $hits = 1;
        if ( $mech->content =~ m{hits:\s*<b>\s*(\d+)\s*</b>}s ) {
                $hits = $1;
        } else {
                warn "get't find results in ", $mech->content;
        }

warn "# got $hits results, get first one\n";

        $mech->follow_link( url_regex => qr/ukaz=DISP/ );

warn "# in COMARC format\n";

        $mech->follow_link( url_regex => qr/fmt=13/ );

        my $comarc;

        if ( $mech->content =~ m{<pre>\s*(.+1\..+?)\s*</pre>}s ) {
                my $comarc = $1;
                $comarc =~ s{</?b>}{}gs;
                $comarc =~ s{<(/?font)[^>]*>}{<sf>}gs;

                print $comarc;

                return $comarc;
        } else {
                die "can't fetch COMARC format from ", $mech->content;
        }

}

1;
1	dpavlin	1	package COBISS;
2
3			use warnings;
4			use strict;
5
6			use WWW::Mechanize;
7
8			sub search {
9
10			my $url = 'http://cobiss.izum.si/scripts/cobiss?ukaz=GETID&lani=en';
11
12			warn "# get $url\n";
13
14			my $mech = WWW::Mechanize->new();
15			$mech->get( $url );
16
17			warn "# got session\n";
18
19			$mech->follow_link( text_regex => qr/union/ );
20
21			warn "# submit search\n";
22
23			$mech->submit_form(
24			fields => {
25			'SS1' => 'Krleza',
26			},
27			);
28
29			my $hits = 1;
30			if ( $mech->content =~ m{hits:\s<b>\s(\d+)\s*</b>}s ) {
31			$hits = $1;
32			} else {
33			warn "get't find results in ", $mech->content;
34			}
35
36			warn "# got $hits results, get first one\n";
37
38			$mech->follow_link( url_regex => qr/ukaz=DISP/ );
39
40			warn "# in COMARC format\n";
41
42			$mech->follow_link( url_regex => qr/fmt=13/ );
43
44			my $comarc;
45
46			if ( $mech->content =~ m{<pre>\s(.+1\..+?)\s</pre>}s ) {
47			my $comarc = $1;
48			$comarc =~ s{</?b>}{}gs;
49			$comarc =~ s{<(/?font)[^>]*>}{<sf>}gs;
50
51			print $comarc;
52
53			return $comarc;
54			} else {
55			die "can't fetch COMARC format from ", $mech->content;
56			}
57
58			}
59
60			1;