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

package COBISS;

use warnings;
use strict;

use WWW::Mechanize;
use MARC::Record;

binmode STDOUT, ':utf8';

my $cobiss_marc21 = {
        '010' => { a => [ '020', 'a' ] },
         200  => {
                        a => [  245 , 'a' ],
                        f => [  245 , 'f' ],
        },
         205  => { a => [  250 , 'a' ] },
         210  => {
                a => [  250 , 'a' ],
                c => [  260 , 'b' ],
                d => [  260 , 'c' ],
        },
        215 => {
                a => [  300 , 'a' ],
                c => [  300 , 'b' ],
                d => [  300 , 'c' ],
        },
        700 => {
                a => [  100 , 'a' ],
        },
};

our $mech = WWW::Mechanize->new();
our $hits;

sub diag {
        print "# ", @_, $/;
}

# Koha Z39.50 query:
#
# Bib-1 @and @and @and @and @and @and @and @or
# @attr 1=8 isbn-issn 
# @attr 1=7 isbn-issn 
# @attr 1=4 title 
# @attr 1=1003 author 
# @attr 1=16 dewey 
# @attr 1=21 subject-holding 
# @attr 1=12 control-no 
# @attr 1=1007 standard-id 
# @attr 1=1016 any

our $usemap = {
        8               => 'BN',        # FIXME check
        7               => 'SN',        # FIXME check
        4               => 'TI',
        1003    => 'TI',
        16              => 'CU',
        21              => 'SU',
#       12              => '',
#       1007    => '',
#       1016    => '',

};

sub usemap {
        my $f = shift || die;
        $usemap->{$f};
}

sub search {
        my ( $self, $query ) = @_;

        die "need query" unless defined $query;

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

diag "get $url";

        $mech->get( $url );

diag "got session";

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

diag "switch to advanced form (select)";

        $mech->follow_link( url_regex => qr/mode=3/ );

diag "submit search $query";

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

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

diag "got $hits results, get first one";

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

diag "in COMARC format";

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


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

        my $comarc;

        if ( $mech->content =~ m{<pre>\s*(.+?(\d+)\.\s+ID=(\d+).+?)\s*</pre>}s ) {

                my $comarc = $1;
                my $nr = $2;
                my $id = $3;

diag "fetch_marc $nr [$id]";

                $comarc =~ s{</?b>}{}gs;
                $comarc =~ s{<font[^>]*>}{<s>}gs;
                $comarc =~ s{</font>}{<e>}gs;

                open(my $out, '>:utf8', "comarc/$id");
                print $out $comarc;
                close($out);

                print $comarc;

                my $marc = MARC::Record->new;

                foreach my $line ( split(/[\r\n]+/, $comarc) ) {

                        if ( $line !~ s{^(\d\d\d)([01 ])([01 ])}{} ) {
                                diag "SKIP: $line";
                        } else {
                                $line .= "<eol>";

                                our @f = ( $1, $2, $3 );
                                sub sf { push @f, @_; }
                                $line =~ s{<s>(\w)<e>([^<]+)\s*}{sf($1, $2)}ges;
                                diag "f:", join('|', @f), " left: |$line|";
                                $marc->add_fields( @f );
                        }
                }

                open(my $out, '>:utf8', "marc/$id");
                print $out $marc->as_usmarc;
                close($out);

                diag $marc->as_formatted;

                $nr++;
                $mech->follow_link( url_regex => qr/rec=$nr/ );

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

}

1;
1	package COBISS;
2
3	use warnings;
4	use strict;
5
6	use WWW::Mechanize;
7	use MARC::Record;
8
9	binmode STDOUT, ':utf8';
10
11	my $cobiss_marc21 = {
12	'010' => { a => [ '020', 'a' ] },
13	200 => {
14	a => [ 245 , 'a' ],
15	f => [ 245 , 'f' ],
16	},
17	205 => { a => [ 250 , 'a' ] },
18	210 => {
19	a => [ 250 , 'a' ],
20	c => [ 260 , 'b' ],
21	d => [ 260 , 'c' ],
22	},
23	215 => {
24	a => [ 300 , 'a' ],
25	c => [ 300 , 'b' ],
26	d => [ 300 , 'c' ],
27	},
28	700 => {
29	a => [ 100 , 'a' ],
30	},
31	};
32
33	our $mech = WWW::Mechanize->new();
34	our $hits;
35
36	sub diag {
37	print "# ", @_, $/;
38	}
39
40	# Koha Z39.50 query:
41	#
42	# Bib-1 @and @and @and @and @and @and @and @or
43	# @attr 1=8 isbn-issn
44	# @attr 1=7 isbn-issn
45	# @attr 1=4 title
46	# @attr 1=1003 author
47	# @attr 1=16 dewey
48	# @attr 1=21 subject-holding
49	# @attr 1=12 control-no
50	# @attr 1=1007 standard-id
51	# @attr 1=1016 any
52
53	our $usemap = {
54	8 => 'BN', # FIXME check
55	7 => 'SN', # FIXME check
56	4 => 'TI',
57	1003 => 'TI',
58	16 => 'CU',
59	21 => 'SU',
60	# 12 => '',
61	# 1007 => '',
62	# 1016 => '',
63
64	};
65
66	sub usemap {
67	my $f = shift \|\| die;
68	$usemap->{$f};
69	}
70
71	sub search {
72	my ( $self, $query ) = @_;
73
74	die "need query" unless defined $query;
75
76	my $url = 'http://cobiss.izum.si/scripts/cobiss?ukaz=GETID&lani=en';
77
78	diag "get $url";
79
80	$mech->get( $url );
81
82	diag "got session";
83
84	$mech->follow_link( text_regex => qr/union/ );
85
86	diag "switch to advanced form (select)";
87
88	$mech->follow_link( url_regex => qr/mode=3/ );
89
90	diag "submit search $query";
91
92	$mech->submit_form(
93	fields => {
94	'SS1' => $query,
95	},
96	);
97
98	$hits = 0;
99	if ( $mech->content =~ m{hits:\s<b>\s(\d+)\s*</b>}s ) {
100	$hits = $1;
101	} else {
102	diag "get't find results in ", $mech->content;
103	return;
104	}
105
106	diag "got $hits results, get first one";
107
108	$mech->follow_link( url_regex => qr/ukaz=DISP/ );
109
110	diag "in COMARC format";
111
112	$mech->follow_link( url_regex => qr/fmt=13/ );
113	}
114
115
116	sub fetch_marc {
117	my ($self) = @_;
118
119	my $comarc;
120
121	if ( $mech->content =~ m{<pre>\s(.+?(\d+)\.\s+ID=(\d+).+?)\s</pre>}s ) {
122
123	my $comarc = $1;
124	my $nr = $2;
125	my $id = $3;
126
127	diag "fetch_marc $nr [$id]";
128
129	$comarc =~ s{</?b>}{}gs;
130	$comarc =~ s{<font[^>]*>}{<s>}gs;
131	$comarc =~ s{</font>}{<e>}gs;
132
133	open(my $out, '>:utf8', "comarc/$id");
134	print $out $comarc;
135	close($out);
136
137	print $comarc;
138
139	my $marc = MARC::Record->new;
140
141	foreach my $line ( split(/[\r\n]+/, $comarc) ) {
142
143	if ( $line !~ s{^(\d\d\d)([01 ])([01 ])}{} ) {
144	diag "SKIP: $line";
145	} else {
146	$line .= "<eol>";
147
148	our @f = ( $1, $2, $3 );
149	sub sf { push @f, @_; }
150	$line =~ s{<s>(\w)<e>([^<]+)\s*}{sf($1, $2)}ges;
151	diag "f:", join('\|', @f), " left: \|$line\|";
152	$marc->add_fields( @f );
153	}
154	}
155
156	open(my $out, '>:utf8', "marc/$id");
157	print $out $marc->as_usmarc;
158	close($out);
159
160	diag $marc->as_formatted;
161
162	$nr++;
163	$mech->follow_link( url_regex => qr/rec=$nr/ );
164
165	return $marc->as_usmarc;
166	} else {
167	die "can't fetch COMARC format from ", $mech->content;
168	}
169
170	}
171
172	1;