View | Details | Raw Unified | Return to bug 25252
Collapse All | Expand All

(-)a/misc/export2collectionhq.pl (-1 / +97 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/env perl
2
3
#
4
# Copyright 2012 PTFS Europe Ltd
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along with
17
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18
# Suite 330, Boston, MA  02111-1307 USA
19
20
use strict;
21
use warnings;
22
use FindBin;
23
use lib "$FindBin::Bin/../..";
24
use Carp;
25
use C4::Context;
26
use C4::Auth;
27
use C4::Output;
28
use C4::Biblio;    # GetMarcBiblio GetXmlBiblio
29
use C4::Koha;      # GetItemTypes
30
use Net::FTP;
31
32
unless ( chdir '/tmp' ) {
33
    croak 'Unable to cd to /tmp';
34
}
35
36
my $filename = get_filename();
37
38
write_file($filename);
39
40
transfer_file($filename);
41
42
sub write_file {
43
    my $export_filename = shift;
44
    my $dbh             = C4::Context->dbh;
45
46
    my $query =
47
      'SELECT biblioitems.biblionumber FROM biblioitems WHERE biblionumber >0 ';
48
49
    my $sth = $dbh->prepare($query);
50
    $sth->execute();
51
52
    open my $fh, '>:encoding(utf8)', $export_filename
53
      or croak "Cannot open $export_filename : $!";
54
55
    while ( my ($biblionumber) = $sth->fetchrow_array ) {
56
        #my $marc_record = GetMarcBiblio($biblionumber,1);
57
        my $marc_record = GetMarcBiblio( { biblionumber => $biblionumber,embed_items =>1 } );
58
        if ($marc_record) {
59
            print {$fh} $marc_record->as_usmarc();
60
        }
61
    }
62
    if ( !close $fh ) {
63
        croak "Writing to $export_filename failed on close";
64
    }
65
    return;
66
}
67
68
sub get_filename {
69
    my @abbr  = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
70
    my @tm    = localtime();
71
    my $month = $tm[4];
72
    my $year  = $tm[5] - 100;
73
    my $name  = 'export' . $abbr[$month] . $year;
74
    $name .= '.mrc';
75
76
    # will need to add a directory & unique date id to file
77
    return $name;
78
}
79
80
sub transfer_file {
81
    my $marc_file = shift;
82
    my $remote    = 'ftp.emea.collectionhq.com';
83
    my $username  = q{INSERT USERNAME HERE};
84
    my $password = q{INSERT PASSWORD HERE};
85
86
    my $ftp = Net::FTP->new( $remote, Debug => 0 )
87
      or croak "Cannot connect to CollectionHQ $@";
88
89
    $ftp->login( $username, $password )
90
      or croak 'Cannot login to CollectionHQ ', $ftp->message;
91
    $ftp->binary();
92
    $ftp->put($marc_file);
93
94
    $ftp->quit;
95
96
    return;
97
}

Return to bug 25252