From 9a70321da3bc11b37e16eaa9d6b57860e4cccd01 Mon Sep 17 00:00:00 2001
From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Wed, 27 May 2015 19:28:18 +0200
Subject: [PATCH] edit biblio records in koha using WWW::Mechanize

---
 koha-mech.pl | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100755 koha-mech.pl

diff --git a/koha-mech.pl b/koha-mech.pl
new file mode 100755
index 0000000..1fc6f0e
--- /dev/null
+++ b/koha-mech.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use WWW::Mechanize;
+use Data::Dump qw(dump);
+use XML::Simple;
+
+my $intranet = 'http://ffzg.koha-dev.rot13.org:8080/';
+# we will use %d and %s to insert values
+my $url_template = $intranet . '/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=%d';
+
+my $koha_conf = XMLin('/etc/koha/sites/ffzg/koha-conf.xml');
+
+my $user = $koha_conf->{config}->{user};
+my $passwd = $koha_conf->{config}->{pass};
+
+my $mech = WWW::Mechanize->new( autocheck => 1 );
+
+
+warn "# login $intranet\n";
+$mech->get( $intranet );
+
+$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
+	my $form = $mech->form_name( 'f' );
+
+	# tag_856_subfield_u_276192_219337 - add url
+	modify_field $form => 'tag_856_subfield_u' => sub { return "http://10.60.0.82/snz/$v[1]/" };
+
+	$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/ } @inputs;
+	die "can't find $field in ", $mech->dump_forms unless $name;
+
+	if ( $value && $value !~ m{/snz/} ) {
+		warn "SKIP: $name has [$value]\n";
+		return;
+	}
+
+	my $new = $coderef->($value);
+
+	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 );
+}
+
-- 
2.20.1