git.rot13.org Git - koha-eprints/blob - koha-mech.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use WWW::Mechanize;
   7 use Data::Dump qw(dump);
   8 use XML::Simple;
   9
  10 my $intranet = 'http://ffzg.koha-dev.rot13.org:8080/';
  11 # we will use %d and %s to insert values
  12 my $url_template = $intranet . '/cgi-bin/koha/cataloguing/addbiblio.pl?biblionumber=%d';
  13
  14 my $koha_conf = XMLin('/etc/koha/sites/ffzg/koha-conf.xml');
  15
  16 my $user = $koha_conf->{config}->{user};
  17 my $passwd = $koha_conf->{config}->{pass};
  18
  19 my $mech = WWW::Mechanize->new( autocheck => 1 );
  20
  21
  22 warn "# login $intranet\n";
  23 $mech->get( $intranet );
  24
  25 $mech->submit_form(
  26         fields => {
  27                 userid => $user,
  28                 password => $passwd,
  29         },
  30 );
  31
  32 sub modify_field; # declare later
  33
  34 while( <> ) {
  35         chomp;
  36         my @v = split(/\s+/,$_);
  37         warn "<< ",dump(@v),$/;
  38
  39         my $url = sprintf $url_template, @v;
  40         warn "# url $url\n";
  41         $mech->get( $url );
  42
  43 #       my $form = $mech->form_number( 1 ); # XXX 1st form
  44         my $form = $mech->form_name( 'f' );
  45
  46         # tag_856_subfield_u_276192_219337 - add url
  47         modify_field $form => 'tag_856_subfield_u' => sub { return "http://10.60.0.82/snz/$v[1]/" };
  48
  49         $mech->submit;
  50
  51 }
  52
  53 exit;
  54
  55 # magic to find field name by partial match from beginning
  56 sub modify_field {
  57         my ( $form, $field, $coderef ) = @_;
  58
  59         my @inputs = $form->inputs;
  60         my ( $name, $value ) = map { $_->name, $_->value } grep { defined $_->name && $_->name =~ /^\Q$field\E/ } @inputs;
  61         die "can't find $field in ", $mech->dump_forms unless $name;
  62
  63         if ( $value && $value !~ m{/snz/} ) {
  64                 warn "SKIP: $name has [$value]\n";
  65                 return;
  66         }
  67
  68         my $new = $coderef->($value);
  69
  70         if ( $value eq $new ) {
  71                 warn "WARNING: $name not changed [$value]\n" if $value eq $new;
  72                 return;
  73         }
  74
  75         warn "$name\n\tOLD: $value\n\tNEW: $new\n";
  76
  77         $mech->field( $name, $new );
  78 }
  79