1 | # This document processor saves a document in the
|
---|
2 | # archives directory of a collection
|
---|
3 |
|
---|
4 |
|
---|
5 | package docsave;
|
---|
6 |
|
---|
7 | use arcinfo;
|
---|
8 | use docproc;
|
---|
9 | use util;
|
---|
10 |
|
---|
11 |
|
---|
12 | sub BEGIN {
|
---|
13 | @ISA = ('docproc');
|
---|
14 | }
|
---|
15 |
|
---|
16 | sub new {
|
---|
17 | my ($class, $collection, $archive_info, $verbosity) = @_;
|
---|
18 | my $self = new docproc ();
|
---|
19 |
|
---|
20 | $self->{'collection'} = $collection;
|
---|
21 | $self->{'archive_info'} = $archive_info;
|
---|
22 | $self->{'verbosity'} = $verbosity;
|
---|
23 |
|
---|
24 | # set a default for the archive directory
|
---|
25 | $self->{'archive_dir'} = "$ENV{'GSDLHOME'}/collect/$self->{'collection'}/archives";
|
---|
26 |
|
---|
27 | return bless $self, $class;
|
---|
28 | }
|
---|
29 |
|
---|
30 | sub setarchivedir {
|
---|
31 | my $self = shift (@_);
|
---|
32 | my ($archive_dir) = @_;
|
---|
33 |
|
---|
34 | $self->{'archive_dir'} = $archive_dir;
|
---|
35 | }
|
---|
36 |
|
---|
37 | sub process {
|
---|
38 | my $self = shift (@_);
|
---|
39 | my ($doc_obj) = @_;
|
---|
40 |
|
---|
41 | my $archive_dir = $self->{'archive_dir'};
|
---|
42 | my $OID = $doc_obj->get_OID();
|
---|
43 | $OID = "NULL" unless defined $OID;
|
---|
44 |
|
---|
45 | # get the document's directory.
|
---|
46 | my $doc_info = $self->{'archive_info'}->get_info($OID);
|
---|
47 | my $doc_dir = "";
|
---|
48 | if (defined $doc_info && scalar(@$doc_info) >= 1) {
|
---|
49 | # this OID already has an assigned directory, use the
|
---|
50 | # same one.
|
---|
51 | $doc_dir = $doc_info->[0];
|
---|
52 | $doc_dir =~ s/\/?doc\.gml$//;
|
---|
53 |
|
---|
54 | } else {
|
---|
55 | # have to get a new document directory
|
---|
56 | my $doc_dir_rest = $OID;
|
---|
57 | my $doc_dir_num = 0;
|
---|
58 | do {
|
---|
59 | $doc_dir .= "/" if $doc_dir_num > 0;
|
---|
60 | if ($doc_dir_rest =~ s/^(.{1,8})//) {
|
---|
61 | $doc_dir .= $1;
|
---|
62 | $doc_dir_num++;
|
---|
63 | }
|
---|
64 | } while ($doc_dir_rest ne "" &&
|
---|
65 | (-d "$archive_dir/$doc_dir.dir" ||
|
---|
66 | ($self->{'archive_info'}->size() >= 1024 && $doc_dir_num < 2)));
|
---|
67 | $doc_dir .= ".dir";
|
---|
68 | }
|
---|
69 |
|
---|
70 | &util::mk_all_dir ("$archive_dir/$doc_dir");
|
---|
71 |
|
---|
72 | # copy all the associated files, add this information as metadata
|
---|
73 | # to the document
|
---|
74 | my @assoc_files = ();
|
---|
75 | foreach $assoc_file (@{$doc_obj->get_assoc_files()}) {
|
---|
76 | if (-e $assoc_file->[0]) {
|
---|
77 | &util::cp ($assoc_file->[0], "$archive_dir/$doc_dir/$assoc_file->[1]");
|
---|
78 | $doc_obj->add_metadata ($doc_obj->get_top_section(),
|
---|
79 | "gsdlassocfile",
|
---|
80 | "$assoc_file->[1]:$assoc_file->[2]");
|
---|
81 | } else {
|
---|
82 | print STDERR "docsave::process couldn't copy the associated file " .
|
---|
83 | "$assoc_file->[0] to $archive_dir/$doc_dir/$assoc_file->[1]\n"
|
---|
84 | }
|
---|
85 | }
|
---|
86 |
|
---|
87 | # save this document
|
---|
88 | if (!open (OUTDOC, ">$archive_dir/$doc_dir/doc.gml")) {
|
---|
89 | print STDERR "docsave::process could not write to file " .
|
---|
90 | "$archive_dir/$doc_dir/doc.gml\n";
|
---|
91 | return;
|
---|
92 | }
|
---|
93 | $doc_obj->output_section('docsave::OUTDOC', $doc_obj->get_top_section());
|
---|
94 | close OUTDOC;
|
---|
95 |
|
---|
96 | # store reference in the archive_info
|
---|
97 | $self->{'archive_info'}->add_info($OID,
|
---|
98 | "$doc_dir/doc.gml");
|
---|
99 |
|
---|
100 | }
|
---|
101 |
|
---|
102 |
|
---|
103 | 1;
|
---|