| Lines 1-6
          
      
      
        Link Here | 
        
          | 1 | #!/usr/bin/perl | 1 | #!/usr/bin/perl | 
        
          | 2 |  | 2 |  | 
        
          | 3 | # Copyright 2000-2002 Katipo Communications | 3 | # Copyright 2000-2002 Katipo Communications | 
            
              |  |  | 4 | # Copyright 2017 Rijksmuseum | 
        
          | 4 | # | 5 | # | 
        
          | 5 | # This file is part of Koha. | 6 | # This file is part of Koha. | 
        
          | 6 | # | 7 | # | 
  
    | Lines 17-37
          
      
      
        Link Here | 
        
          | 17 | # You should have received a copy of the GNU General Public License | 18 | # You should have received a copy of the GNU General Public License | 
        
          | 18 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | 19 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | 
        
          | 19 |  | 20 |  | 
          
            
              | 20 | use strict; | 21 | use Modern::Perl; | 
            
              | 21 | use warnings; |  |  | 
            
              | 22 | use C4::Output; | 
            
              | 23 | use C4::Auth; | 
        
          | 24 | use CGI qw ( -utf8 ); | 22 | use CGI qw ( -utf8 ); | 
            
              | 25 | use C4::Context; |  |  | 
            
              | 26 | use C4::Biblio; | 
        
          | 27 |  | 23 |  | 
            
              |  |  | 24 | use Koha::Database; | 
            
              | 25 | use C4::Auth; | 
            
              | 26 | use C4::Biblio; | 
            
              | 27 | use C4::Output; | 
            
              | 28 | use Koha::BiblioFrameworks; | 
            
              | 29 | use Koha::Caches; | 
            
              | 30 | use Koha::MarcSubfieldStructures; | 
        
          | 28 |  | 31 |  | 
        
          | 29 | my $input       = new CGI; | 32 | my $input       = new CGI; | 
            
              | 30 | my $tablename   = $input->param('tablename'); |  |  | 
            
              | 31 | $tablename      = "biblio" unless ($tablename); | 
            
              | 32 | my $kohafield   = $input->param('kohafield'); | 
            
              | 33 | my $op          = $input->param('op'); | 
            
              | 34 | my $script_name = 'koha2marclinks.pl'; | 
        
          | 35 |  | 33 |  | 
        
          | 36 | my ( $template, $borrowernumber, $cookie ) = get_template_and_user ( | 34 | my ( $template, $borrowernumber, $cookie ) = get_template_and_user ( | 
        
          | 37 |     { | 35 |     { | 
  
    | Lines 44-164
          my ( $template, $borrowernumber, $cookie ) = get_template_and_user (
      
      
        Link Here | 
        
          | 44 |     } | 42 |     } | 
        
          | 45 | ); | 43 | ); | 
        
          | 46 |  | 44 |  | 
          
            
              | 47 | if ($op) { | 45 | my $schema = Koha::Database->new->schema; | 
            
              | 48 |     $template->param( |  |  | 
            
              | 49 |         script_name => $script_name, | 
            
              | 50 |         $op         => 1 | 
            
              | 51 |     );    # we show only the TMPL_VAR names $op | 
            
              | 52 | } | 
            
              | 53 | else { | 
            
              | 54 |     $template->param( | 
            
              | 55 |         script_name => $script_name, | 
            
              | 56 |         else        => 1 | 
            
              | 57 |     );    # we show only the TMPL_VAR names $op | 
            
              | 58 |     $op = q{}; | 
            
              | 59 | } | 
            
              | 60 |  | 
            
              | 61 | my $dbh = C4::Context->dbh; | 
        
          | 62 | my $cache = Koha::Caches->get_instance(); | 46 | my $cache = Koha::Caches->get_instance(); | 
        
          | 63 |  | 47 |  | 
          
            
              | 64 | ################## ADD_FORM ################################## | 48 | # Update data before showing the form | 
            
              | 65 | # called by default. Used to create form to add or  modify a record | 49 | my $no_upd; | 
            
              | 66 | if ( $op eq 'add_form' ) { |  |  | 
            
              | 67 |     my $sth = | 
            
              | 68 |       $dbh->prepare( | 
            
              | 69 | "select tagfield,tagsubfield,liblibrarian as lib,tab from marc_subfield_structure where kohafield=? AND frameworkcode=''" | 
            
              | 70 |       ); | 
            
              | 71 |     $sth->execute( $tablename . "." . $kohafield ); | 
            
              | 72 |     my ( $defaulttagfield, $defaulttagsubfield, $defaultliblibrarian ) = | 
            
              | 73 |       $sth->fetchrow; | 
        
          | 74 |  | 50 |  | 
          
            
              | 75 |     for ( my $i = 0 ; $i <= 9 ; $i++ ) { | 51 | if( $input->param('add_field') ) { | 
            
              | 76 |         my $sth2 = | 52 |     # add a mapping to all frameworks | 
            
              | 77 |           $dbh->prepare( | 53 |     my ($kohafield, $tag, $sub) = split /,/, $input->param('add_field'), 3; | 
            
              | 78 | "select tagfield,tagsubfield,liblibrarian as lib,tab from marc_subfield_structure where tagfield like ? AND frameworkcode=''" | 54 |     Koha::MarcSubfieldStructures->search({ tagfield => $tag, tagsubfield => $sub })->update({ kohafield => $kohafield }); | 
            
              | 79 |           ); |  |  | 
            
              | 80 |         $sth2->execute("$i%"); | 
            
              | 81 |         my @marcarray; | 
            
              | 82 |         push @marcarray, " "; | 
            
              | 83 |         while ( my ( $field, $tagsubfield, $liblibrarian ) = | 
            
              | 84 |             $sth2->fetchrow_array ) | 
            
              | 85 |         { | 
            
              | 86 |             push @marcarray, "$field $tagsubfield - $liblibrarian"; | 
            
              | 87 |         } | 
            
              | 88 |         my $marclist = { | 
            
              | 89 |             values  => \@marcarray, | 
            
              | 90 |             default => "$defaulttagfield $defaulttagsubfield - $defaultliblibrarian", | 
            
              | 91 |         }; | 
            
              | 92 |         $template->param( "marclist$i" => $marclist ); | 
            
              | 93 |     } | 
            
              | 94 |     $template->param( | 
            
              | 95 |         tablename => $tablename, | 
            
              | 96 |         kohafield => $kohafield | 
            
              | 97 |     ); | 
        
          | 98 |  | 55 |  | 
          
            
              | 99 |     # END $OP eq ADD_FORM | 56 | } elsif( $input->param('remove_field') ) { | 
            
              | 100 | ################## ADD_VALIDATE ################################## | 57 |     # remove a mapping from all frameworks | 
            
              | 101 |     # called by add_form, used to insert/modify data in DB | 58 |     my ($tag, $sub) = split /,/, $input->param('remove_field'), 2; | 
            
              | 102 | } | 59 |     Koha::MarcSubfieldStructures->search({ tagfield => $tag, tagsubfield => $sub })->update({ kohafield => undef }); | 
            
              | 103 | elsif ( $op eq 'add_validate' ) { |  |  | 
        
          | 104 |  | 60 |  | 
          
            
              | 105 |     #----- empty koha field : | 61 | } else { | 
            
              | 106 |     $dbh->do( | 62 |     $no_upd = 1; | 
            
              | 107 | "update marc_subfield_structure set kohafield='' where kohafield='$tablename.$kohafield'" | 63 | } | 
            
              | 108 |     ); |  |  | 
        
          | 109 |  | 64 |  | 
          
            
              | 110 |     #---- reload if not empty | 65 | # Clear the cache when needed | 
            
              | 111 |     my @temp = split / /, $input->param('marc'); | 66 | unless( $no_upd ) { | 
            
              | 112 |     $dbh->do( | 67 |     for( qw| default_value_for_mod_marc- MarcSubfieldStructure- | ) { | 
            
              | 113 | "update marc_subfield_structure set kohafield='$tablename.$kohafield' where tagfield='$temp[0]' and tagsubfield='$temp[1]'" | 68 |         $cache->clear_from_cache($_); | 
            
              | 114 |     ); | 69 |     } | 
            
              | 115 |     # We could get a list of all frameworks and do them one-by-one, or zap | 70 | } | 
            
              | 116 |     # everything. |  |  | 
            
              | 117 |     $cache->flush_all(); | 
            
              | 118 |     print $input->redirect("/cgi-bin/koha/admin/koha2marclinks.pl?tablename=$tablename"); | 
            
              | 119 |     exit; | 
        
          | 120 |  | 71 |  | 
          
            
              | 121 |     # END $OP eq ADD_VALIDATE | 72 | # Build/Show the form | 
            
              | 122 | ################## DEFAULT ################################## | 73 | my $dbix_map = { | 
            
              |  |  | 74 |     # Koha to MARC mappings are found in only three tables | 
            
              | 75 |     biblio => 'Biblio', | 
            
              | 76 |     biblioitems => 'Biblioitem', | 
            
              | 77 |     items => 'Item', | 
            
              | 78 | }; | 
            
              | 79 | my @cols; | 
            
              | 80 | foreach my $tbl ( sort keys %{$dbix_map} ) { | 
            
              | 81 |     push @cols, | 
            
              | 82 |         map { "$tbl.$_" } $schema->source( $dbix_map->{$tbl} )->columns; | 
        
          | 123 | } | 83 | } | 
          
            
              | 124 | else {    # DEFAULT | 84 | my $kohafields = Koha::MarcSubfieldStructures->search({ | 
            
              | 125 |     my $sth = | 85 |     frameworkcode => q{}, | 
            
              | 126 |       $dbh->prepare( | 86 |     kohafield => { '>', '' }, | 
            
              | 127 | q|select tagfield,tagsubfield,liblibrarian,kohafield from marc_subfield_structure where kohafield is not NULL and kohafield != ''| | 87 | }); | 
            
              | 128 |       ); | 88 | my @loop_data; | 
            
              | 129 |     $sth->execute; | 89 | foreach my $col ( @cols ) { | 
            
              | 130 |     my %fields; | 90 |     my $found; | 
            
              | 131 |     while ( ( my $tagfield, my $tagsubfield, my $liblibrarian, my $kohafield ) = | 91 |     foreach my $row ( $kohafields->search({ kohafield => $col }) ) { | 
            
              | 132 |         $sth->fetchrow ) { | 92 |         $found = 1; | 
            
              | 133 |         $fields{$kohafield}->{tagfield}     = $tagfield; | 93 |         push @loop_data, { | 
            
              | 134 |         $fields{$kohafield}->{tagsubfield}  = $tagsubfield; | 94 |             kohafield    => $col, | 
            
              | 135 |         $fields{$kohafield}->{liblibrarian} = $liblibrarian; | 95 |             tagfield     => $row->tagfield, | 
            
              |  |  | 96 |             tagsubfield  => $row->tagsubfield, | 
            
              | 97 |             liblibrarian => $row->liblibrarian, | 
            
              | 98 |             readonly     => $col =~ /\.(biblio|biblioitem|item)number$/, | 
            
              | 99 |         }; | 
        
          | 136 |     } | 100 |     } | 
            
              |  |  | 101 |     push @loop_data, { | 
            
              | 102 |             kohafield    => $col, | 
            
              | 103 |             readonly     => $col =~ /\.(biblio|biblioitem|item)number$/, | 
            
              | 104 |     } if !$found; | 
            
              | 105 | } | 
        
          | 137 |  | 106 |  | 
          
            
              | 138 |   #XXX: This might not work. Maybe should use a DBI call instead of SHOW COLUMNS | 107 | $template->param( | 
            
              | 139 |     my $sth2 = $dbh->prepare("SHOW COLUMNS from $tablename"); | 108 |     loop       => \@loop_data, | 
            
              | 140 |     $sth2->execute; | 109 | ); | 
        
          | 141 |  | 110 |  | 
            
              | 142 |     my @loop_data = (); |  |  | 
            
              | 143 |     while ( ( my $field ) = $sth2->fetchrow_array ) { | 
            
              | 144 |         my %row_data;    # get a fresh hash for the row data | 
            
              | 145 |         $row_data{tagfield} = $fields{ $tablename . "." . $field }->{tagfield}; | 
            
              | 146 |         $row_data{tagsubfield} = | 
            
              | 147 |           $fields{ $tablename . "." . $field }->{tagsubfield}; | 
            
              | 148 |         $row_data{liblibrarian} = | 
            
              | 149 |           $fields{ $tablename . "." . $field }->{liblibrarian}; | 
            
              | 150 |         $row_data{kohafield} = $field; | 
            
              | 151 |         $row_data{edit} = | 
            
              | 152 | "$script_name?op=add_form&tablename=$tablename&kohafield=$field"; | 
            
              | 153 |         push( @loop_data, \%row_data ); | 
            
              | 154 |     } | 
            
              | 155 |     my $tablenames = { | 
            
              | 156 |         values  => [ 'biblio', 'biblioitems', 'items' ], | 
            
              | 157 |         default => $tablename, | 
            
              | 158 |     }; | 
            
              | 159 |     $template->param( | 
            
              | 160 |         loop      => \@loop_data, | 
            
              | 161 |         tablename => $tablenames, | 
            
              | 162 |     ); | 
            
              | 163 | }    #---- END $OP eq DEFAULT | 
        
          | 164 | output_html_with_http_headers $input, $cookie, $template->output; | 111 | output_html_with_http_headers $input, $cookie, $template->output; |