update dev300-m58
[ooovba.git] / solenv / bin / cwsattach.pl
blobfadf758bf436d3a4ece3dce952dbdc7f683ceb44
2 eval 'exec perl -wS $0 ${1+"$@"}'
3 if 0;
4 #*************************************************************************
6 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
7 #
8 # Copyright 2008 by Sun Microsystems, Inc.
10 # OpenOffice.org - a multi-platform office productivity suite
12 # $RCSfile: cwsattach.pl,v $
14 # $Revision: 1.3 $
16 # This file is part of OpenOffice.org.
18 # OpenOffice.org is free software: you can redistribute it and/or modify
19 # it under the terms of the GNU Lesser General Public License version 3
20 # only, as published by the Free Software Foundation.
22 # OpenOffice.org is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 # GNU Lesser General Public License version 3 for more details
26 # (a copy is included in the LICENSE file that accompanied this code).
28 # You should have received a copy of the GNU Lesser General Public License
29 # version 3 along with OpenOffice.org. If not, see
30 # <http://www.openoffice.org/license.html>
31 # for a copy of the LGPLv3 License.
33 #*************************************************************************
35 # cwsattach.pl - attach files to CWS
38 use strict;
39 use Getopt::Long;
40 use Cwd;
42 #### module lookup
43 my @lib_dirs;
44 BEGIN {
45 if ( !defined($ENV{SOLARENV}) ) {
46 die "No environment found (environment variable SOLARENV is undefined)";
48 push(@lib_dirs, "$ENV{SOLARENV}/bin/modules");
49 push(@lib_dirs, "$ENV{COMMON_ENV_TOOLS}/modules") if defined($ENV{COMMON_ENV_TOOLS});
51 use lib (@lib_dirs);
53 use Cws;
55 #### script id #####
57 ( my $script_name = $0 ) =~ s/^.*\b(\w+)\.pl$/$1/;
59 my $script_rev;
60 my $id_str = ' $Revision: 1.3 $ ';
61 $id_str =~ /Revision:\s+(\S+)\s+\$/
62 ? ($script_rev = $1) : ($script_rev = "-");
64 print STDERR "$script_name -- version: $script_rev\n";
66 #### global #####
68 my $is_debug = 1; # enable debug
69 my $opt_master = ''; # option: master workspace
70 my $opt_child = ''; # option: child workspace
71 my $opt_mime_type = ''; # option: mime type
74 #### main #####
76 my $arg_file = parse_options();
77 attach_cws($arg_file);
78 exit(0);
80 #### subroutines ####
82 sub attach_cws
84 my $filename = shift;
85 # get master and child workspace
86 my $masterws = $opt_master ? uc($opt_master) : $ENV{WORK_STAMP};
87 my $childws = $opt_child ? $opt_child : $ENV{CWS_WORK_STAMP};
89 if ( !defined($masterws) ) {
90 print_error("Can't determine master workspace environment.\n"
91 . "Please initialize environment with setsolar ...", 1);
94 if ( !defined($childws) ) {
95 print_error("Can't determine child workspace environment.\n"
96 . "Please initialize environment with setsolar ...", 1);
99 my $cws = Cws->new();
100 $cws->child($childws);
101 $cws->master($masterws);
103 my $mime_type = $opt_mime_type ? $opt_mime_type : find_mime_type($filename);
105 no strict;
107 if ( is_valid_cws($cws) ) {
108 #print "CWS is valid filename=" . $filename . " mime_type=" . $mime_type . "\n";
109 open(DATA,"<$filename") || die "can't open filename";
110 $data="";
111 while(<DATA>) {
112 $data.=$_;
114 my $result=$cws->save_attachment($filename,$mime_type,$data);
115 } else {
116 print STDERR "cws is not valid";
118 exit(0)
122 sub find_mime_type
124 my $filename = shift;
125 $filename=~/(.*)\.(.*$)/;
126 my $ext=$2;
127 my $fmime='';
129 if ( defined($ext) ) {
130 open(MIME,"< $ENV{SOLARENV}/inc/mime.types")|| die "can not open mimetype file";
131 while (<MIME>) {
132 my @a=split();
133 my $iscomment=0;
134 if ( /(\s*\#).*/ ) {
135 $iscomment=1;
136 } else {
137 $iscomment=0;
139 if ( $iscomment eq 0 && $#a >= 1 && $fmime eq '' ) {
140 my $i=1;
141 for ($i=1; $i<=$#a; $i++) {
142 if ( $a[$i] eq $ext ) {
143 $fmime=$a[0];
150 if ( $fmime eq '' ) {
151 $fmime="application/octet-stream";
153 return $fmime;
157 sub is_valid_cws
159 my $cws = shift;
161 my $masterws = $cws->master();
162 my $childws = $cws->child();
163 # check if we got a valid child workspace
164 my $id = $cws->eis_id();
165 if ( !$id ) {
166 print_error("Child workspace '$childws' for master workspace '$masterws' not found in EIS database.", 2);
168 print_message("Master workspace '$masterws', child workspace '$childws':");
169 return 1;
172 sub parse_options
174 # parse options and do some sanity checks
175 my $help = 0;
176 my $success = GetOptions('h' => \$help, 'm=s' => \$opt_master, 'c=s'=> \$opt_child, 't=s'=> \$opt_mime_type);
177 if ( $help || !$success || $#ARGV < 0 ) {
178 usage();
179 exit(1);
182 return $ARGV[0];
185 sub print_message
187 my $message = shift;
189 print STDERR "$script_name: ";
190 print STDERR "$message\n";
191 return;
194 sub print_error
196 my $message = shift;
197 my $error_code = shift;
199 print STDERR "$script_name: ";
200 print STDERR "ERROR: $message\n";
202 if ( $error_code ) {
203 print STDERR "\nFAILURE: $script_name aborted.\n";
204 exit($error_code);
206 return;
209 sub usage
211 print STDERR "Usage: cwsattach [-h] [-m master] [-c child] [-t mimetype] filename\n";
212 print STDERR "\n";
213 print STDERR "Attach files to CWS in EIS database\n";
214 print STDERR "\n";
215 print STDERR "Options:\n";
216 print STDERR "\t-h\t\thelp\n";
217 print STDERR "\t-m master\toverride MWS specified in environment\n";
218 print STDERR "\t-c child\toverride CWS specified in environment\n";
219 print STDERR "\t-t mimetype\texplicitly set mime type\n";
220 print STDERR "Examples:\n";
221 print STDERR "\tcwsattach barfoo.html\n";
222 print STDERR "\tcwsattach -t text bar.cxx\n";
223 print STDERR "\tcwsattach -t text/rtf foo.rtf\n";