Dobrica Pavlinušić's Weblog / Blog

Of course it does, it's get and post requests which your browser does to server. And if you need to modify in bulk records in your web application (Koha in our example) you might wonder about writing a script which does job for you.

It's not really hard. WWW::Mechanize provides us with web browser scriptable in perl and following scripts logs in into Koha's interanet and edit items specified in file:

#!/usr/bin/perl

use warnings;
use strict;

use WWW::Mechanize;
use Data::Dump qw(dump);

# we will use %d and %s to insert values from file
my $url_template = 'https://localhost:8443/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=%d';

our ( $user, $passwd );
require 'config.pl'; # edit $user and $password in config.pl file

my $login_url = 'https://localhost:8443'; # Koha intranet

my $mech = WWW::Mechanize->new( autocheck => 1 );


warn "# login $login_url\n";
$mech->get( $login_url );

$mech->submit_form(
	fields => {
		userid => $user,#!/usr/bin/perl

use warnings;
use strict;

use WWW::Mechanize;
use Data::Dump qw(dump);

# we will use %d and %s to insert values from file
my $url_template = 'https://localhost:8443/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=%d';

our ( $user, $passwd );
require 'config.pl'; # edit $user and $password in config.pl file

my $login_url = 'https://localhost:8443'; # Koha intranet

my $mech = WWW::Mechanize->new( autocheck => 1 );


warn "# login $login_url\n";
$mech->get( $login_url );

$mech->submit_form(
	fields => {
		userid => $user,
		password => $passwd,
	},
);

sub modify_field; # declare later

while( <> ) {
	chomp;
	my @v = split(/\s+/,$_);
	warn "<< ",dump(@v),$/;

	my $url = sprintf $url_template, @v;
	warn "# url $url\n";
	$mech->get( $url );

	my $form = $mech->form_number( 1 ); # XXX 1st form

	# XXX edit fields

	modify_field $form => 'tag_008_subfield_00' => sub { s/^(.{24}).(.+)/$1d$2/ };

	$mech->submit;
}

exit;

# magic to find field name by partial match from beginning
sub modify_field {
	my ( $form, $field, $coderef ) = @_;

	my @inputs = $form->inputs;
	my ( $name, $value ) = map { $_->name, $_->value } grep { defined $_->name && $_->name =~ /^\Q$field\E/ } $form->inputs;
	die "can't find $field in ", $mech->dump_forms unless $name && $value;

	$_ = $value; $coderef->($value);
	my $new = $_;

	if ( $value eq $new ) {
		warn "WARNING: $name not changed [$value]\n" if $value eq $new;
		return;
	}

	warn "$name\n\tOLD: $value\n\tNEW: $new\n";

	$mech->field( $name, $new );
}

sub modify_field; # declare later

while( <> ) {
	chomp;
	my @v = split(/\s+/,$_);
	warn "<< ",dump(@v),$/;

	my $url = sprintf $url_template, @v;
	warn "# url $url\n";
	$mech->get( $url );

	my $form = $mech->form_number( 1 ); # XXX 1st form

	# XXX edit fields

	modify_field $form => 'tag_008_subfield_00' => sub { s/^(.{24}).(.+)/$1d$2/ };

	$mech->submit;
}

exit;

# magic to find field name by partial match from beginning
sub modify_field {
	my ( $form, $field, $coderef ) = @_;

	my @inputs = $form->inputs;
	my ( $name, $value ) = map { $_->name, $_->value } grep { defined $_->name && $_->name =~ /^\Q$field\E/ } $form->inputs;
	die "can't find $field in ", $mech->dump_forms unless $name && $value;

	$_ = $value; $coderef->($value);
	my $new = $_;

	if ( $value eq $new ) {
		warn "WARNING: $name not changed [$value]\n" if $value eq $new;
		return;
	}

	warn "$name\n\tOLD: $value\n\tNEW: $new\n";

	$mech->field( $name, $new );
}

Interesting part is modify_field which tries to find field with specified prefix, since Koha adds unique numbers to all field names in edit form.

This script proved to be very useful for us, and hopefully it might be useful for other users of Koha also.