← Back to branch summary

~mc.../inkscape/inkscape

« back to all changes in this revision

Viewing changes to share/extensions/SpSVG.pm

  • Committer: mental
  • Date: 2006-01-16 02:36:01 UTC
  • Revision ID: mental@users.sourceforge.net-20060116023601-wkr0h7edl5veyudq
moving trunk for module inkscape

Show diffs side-by-side

added added

removed removed

Lines of Context:
share/extensions/SpSVG.pm
 
1
#!/usr/bin/perl -w
 
2
#
 
3
# SpSVG
 
4
# 
 
5
# Perl module for sodipodi extensions
 
6
#
 
7
# This is a temporary hack that provides the following:
 
8
#   * Some standard getopts (help, i/o, ids)
 
9
#   * A way to exit that produces the error codes outlined in
 
10
#     the extension specs (SpSVG::error)
 
11
#   * A method that takes a function as its arguments and passes
 
12
#     each specified element ('--id=foo --id=bar', 'ids=fooz,baaz',
 
13
#     and so forth) as plain text to the function. The function is 
 
14
#     expected to return the processed version of this text.
 
15
#     
 
16
# TODO:
 
17
#
 
18
#   * Write POD
 
19
#   * Exit with a friendly message if XML::XQL isn't installed
 
20
#   * Decide how to implement the module interface
 
21
#   * Move from XML::XQL to SVG/SVG::Parser (see below)
 
22
#   * Make the process method more efficient (again, see below)
 
23
#
 
24
# Authors: Daniel Goude (goude@dtek.chalmers.se)
 
25
#
 
26
 
 
27
package SpSVG; # Think of a better name
 
28
use strict;
 
29
#use Carp;
 
30
use Exporter;
 
31
use Getopt::Long;
 
32
#use Data::Dumper; # For debugging
 
33
 
 
34
# From the SVG.pm documentation (actually 
 
35
# http://roasp.com/tutorial/tutorial6.shtml):
 
36
#
 
37
# > Currently, version 2.0 of SVG.pm does not internally support DOM
 
38
# > traversiong functionality such as getting the children,siblings,or
 
39
# > parent of an element, so the interaction capability between SVG::Parser
 
40
# > and SVG is limited to manipulations of a known image. The next version
 
41
# > of SVG will support all these and more key functions which will make
 
42
# > SVG::Parser extremely useful.
 
43
#
 
44
# I plan to replace the /XML::XQL(::DOM)?/ code as soon as this is
 
45
# fixed.
 
46
 
 
47
#use SVG;
 
48
#use SVG::Parser;
 
49
 
 
50
use XML::XQL;
 
51
use XML::XQL::DOM;
 
52
 
 
53
use vars qw(@ISA @EXPORT $VERSION);
 
54
 
 
55
$VERSION = 1.02; # fixme: use SpSVG 1.01 doesn't raise exception.
 
56
@ISA = qw(Exporter);
 
57
 
 
58
# Symbols 
 
59
@EXPORT = qw(
 
60
 
 
61
); 
 
62
 
 
63
sub new {
 
64
    my $self = {
 
65
        status   => make_status(),
 
66
        name     => '',      # Name of script
 
67
        usage    => '',      # Usage string
 
68
        opt_help => [],      # Used for --help
 
69
        
 
70
        ids     => [],       # Array of ids that will be iterated over 
 
71
                             # in process()
 
72
        svg     => '',       # SVG document object
 
73
        
 
74
    };
 
75
    bless $self;
 
76
}
 
77
 
 
78
sub parse {
 
79
    my $self = shift;
 
80
    
 
81
    my $infile = $self->{'opts'}->{'file'};
 
82
 
 
83
    my $xml;
 
84
    {
 
85
        local $/=undef;
 
86
        if ($infile) {
 
87
            open (IN, $infile) or 
 
88
                $self->error('IO_ERR', "Can't open $infile: $!\n");
 
89
            $xml = <IN>;
 
90
            close IN or 
 
91
                $self->error('IO_ERR', "Can't close $infile: $!\n");
 
92
        } else {
 
93
            $xml = <>;
 
94
        }
 
95
    }
 
96
 
 
97
 
 
98
    $self->{'parser'} = new XML::DOM::Parser;
 
99
    my $parser = $self->{'parser'};
 
100
    my $svg = $parser->parse($xml) ||
 
101
            $self->error('INPUT_ERR', "Couldn't parse input: $!.");
 
102
    $self->{'svg'} = $svg;
 
103
}
 
104
 
 
105
# Return SVG document as a string
 
106
sub get {
 
107
    my $self = shift;
 
108
    my $string =  $self->{'svg'}->toString;
 
109
    
 
110
}
 
111
 
 
112
# Print to $outfile|STDOUT
 
113
sub dump {
 
114
    my $self = shift;
 
115
    my $outfile = $self->{'opts'}->{'output'};
 
116
    if ($outfile) {
 
117
        open(OUT, ">$outfile") or 
 
118
            $self->error('IO_ERR', "Can't open $outfile for writing: $!\n");
 
119
        print OUT $self->get;
 
120
        close OUT or $self->error('IO_ERR', "Can't close $outfile: $!\n");
 
121
    } else {
 
122
        print $self->get;
 
123
    }
 
124
}
 
125
 
 
126
sub process_ids {
 
127
    my $self = shift;
 
128
    my $func = shift;
 
129
 
 
130
    my @ids = @{$self->{'ids'}};
 
131
 
 
132
    # Apply a user supplied function to each id
 
133
    foreach my $id (@ids) {
 
134
        my $svg = $self->{'svg'};
 
135
        #warn "ID: $id\n";
 
136
        my @nodes = $svg->xql("//*[\@id = '$id']") or
 
137
            $self->error('NOOP_ERR', "Couldn't find element $id.");
 
138
        my $node = shift @nodes; # Ids are unique
 
139
                                 # fixme: Add more checking.
 
140
 
 
141
        # Call the user function on the node identified by $id
 
142
        my $new_node = $func->($node->toString);
 
143
    
 
144
        # Replace the comment with user generated SVG
 
145
        my $parent = $node->getParentNode;
 
146
        my $comment = $svg->createComment('SpSVG');
 
147
        $parent->replaceChild($comment, $node);
 
148
        my $output =  $self->{'svg'}->toString;
 
149
        $output =~ s/<!--SpSVG-->/$new_node/;
 
150
 
 
151
        # Here the whole (new) document is parsed. Probably VERY inefficient,
 
152
        # but at least you get syntax checking for free..
 
153
        $self->{'svg'} = $self->{'parser'}->parse($output);
 
154
        #print $self->{'svg'}->toString;
 
155
    }
 
156
 
 
157
    
 
158
} 
 
159
 
 
160
# Exit status codes
 
161
sub make_status {
 
162
    my $self = shift;
 
163
    my %status = (
 
164
        0 => ["SUCCESS", "Extension exited gracefully"],
 
165
        1 => ["GEN_FAIL", "General failure"],
 
166
        2 => ["MEM_ERR", "Memory error"],
 
167
        3 => ["IO_ERR", "File I/O error"],
 
168
        4 => ["MATH_ERR", "Math error"],
 
169
        5 => ["INPUT_ERR", "Input not understood (not valid SVG)"],
 
170
        6 => ["NOOP_ERR", "Could not operate on any objects in this " . 
 
171
            "data stream"],
 
172
        7 => ["ARG_ERR", "Incorrect script arguments"]
 
173
    );
 
174
 
 
175
    # Generate error subs dynamically
 
176
    foreach my $exit_code (sort keys %status) {
 
177
        eval "sub $status{$exit_code}[0] { $exit_code; }";
 
178
        die $@ if $@;
 
179
    }
 
180
    return \%status;
 
181
 
 
182
}
 
183
 
 
184
# Create an option array suitable for Getopt::Long
 
185
sub make_opt_vals {
 
186
    my $self = shift;
 
187
    my @opt_desc = @_;
 
188
    my @opt_vals;
 
189
    my @opt_help = @{$self->{'opt_help'}};
 
190
    foreach (@opt_desc) {
 
191
        my %h = %$_;
 
192
        foreach my $key (keys %h) {
 
193
            #print "Key : $h{$key}\n";
 
194
            if ($key eq 'opt') {
 
195
                push @opt_vals, $h{'opt'};
 
196
            } elsif ($key eq 'desc') {
 
197
                my $option = $h{'opt'};
 
198
                $option =~ s/([^=]+)=.+/$1/;
 
199
                $option =~ s/([^|]+)/(length "$1" > 1 ? '--' : '-') . "$1"/eg;
 
200
                push @opt_help, [$option, $h{'desc'}];
 
201
            }
 
202
        }
 
203
    }
 
204
    $self->{'opt_help'} = \@opt_help;
 
205
    return @opt_vals;
 
206
}
 
207
 
 
208
# Parse command line options
 
209
sub get_opts {
 
210
    my $self = shift;
 
211
    my @user_opt_desc = @_;
 
212
   
 
213
    my @opt_desc = (
 
214
        {
 
215
            opt => 'help|h',
 
216
            desc => 'Display this help and exit.',
 
217
        },
 
218
        
 
219
        {
 
220
            opt => 'version|v',
 
221
            desc => 'Print version and exit.',
 
222
        },           
 
223
        
 
224
        {
 
225
            opt => 'file|F=s',
 
226
            desc => 'Input file (default: STDIN).',
 
227
        },            
 
228
        
 
229
        {
 
230
            opt => 'output|o=s',
 
231
            desc => 'Output file (default: STDOUT).',
 
232
        },
 
233
        
 
234
        {
 
235
            opt => 'id=s@',
 
236
            desc => 'svg id to operate on (can be multiple).',
 
237
        },           
 
238
        
 
239
        {   
 
240
            opt => 'ids=s',
 
241
            desc => 'Comma-separated list of svg ids to operate on.',
 
242
        },           
 
243
    );
 
244
 
 
245
    # Create option arrays for Getopt::Long
 
246
    my @opt_vals = $self->make_opt_vals(@opt_desc);
 
247
    my @user_opt_vals = $self->make_opt_vals(@user_opt_desc);
 
248
    
 
249
    # Append user options 
 
250
    foreach (@user_opt_vals) {
 
251
        push @opt_vals, $_;
 
252
    }
 
253
    
 
254
    # Where the parsed options are stored
 
255
    my %opts;
 
256
 
 
257
    #exit 0;
 
258
 
 
259
    # Parse all options
 
260
    GetOptions(\%opts, @opt_vals) or usage();    
 
261
 
 
262
    # Handle comma-separated 'ids=foo,bar'
 
263
    my @ids = @{$opts{'id'}} if $opts{'id'};
 
264
    if (exists $opts{'ids'} && $opts{'ids'} =~ /[\w\d_]+(,[\w\d_]+)*/) {
 
265
        push (@ids, split(/,/, $opts{'ids'}));
 
266
    }
 
267
 
 
268
    # Display usage etc. (and exit)
 
269
    exists $opts{'version'} && $self->version();
 
270
    exists $opts{'help'} && $self->usage(); 
 
271
 
 
272
    # Save id values for later processing 
 
273
    $self->{'ids'} = \@ids;
 
274
    
 
275
    # Save options
 
276
    $self->{'opts'} = \%opts;
 
277
 
 
278
    # Return the options to script
 
279
    return %opts;
 
280
}
 
281
 
 
282
# Exit with named exit status
 
283
sub error {
 
284
    my $self = shift;
 
285
    my $error_name = shift;
 
286
    my $script_error_msg = shift || '';
 
287
   
 
288
    my %status = %{$self->{'status'}};
 
289
 
 
290
    foreach (keys %status) {
 
291
        if ($status{$_}[0] eq $error_name) {
 
292
            $! = $_; # Set exit status
 
293
 
 
294
            # Commented out; let sodipodi handle the error code instead
 
295
            #my $msg =  ($status{$_}->[1] . ": $script_error_msg");
 
296
            
 
297
            my $msg =  "$script_error_msg";
 
298
            die $msg;
 
299
        }
 
300
    }
 
301
    
 
302
    # Will not be reached unless an improper error_name is given
 
303
    $! = 255; # Exit status 
 
304
    warn "Illegal error code '$error_name' called from script\n";
 
305
}
 
306
 
 
307
# Some accessor methods
 
308
sub set_usage {
 
309
    my $self = shift;
 
310
    my $usage = shift || die "No usage string supplied!\n";
 
311
    $self->{'usage'} = $usage;
 
312
}
 
313
 
 
314
sub set_name {
 
315
    my $self = shift;
 
316
    my $name = shift || die "No script name supplied!\n";
 
317
    $self->{'name'} = $name;
 
318
}
 
319
 
 
320
# Print usage and exit
 
321
sub usage {
 
322
    my $self = shift;
 
323
    print "Usage: $self->{'name'} OPTIONS FILE\n";
 
324
    print $self->{'usage'};
 
325
    
 
326
    my @opt_help = @{$self->{'opt_help'}};
 
327
    foreach (@opt_help) {
 
328
        print pad($_->[0]) . $_->[1] . "\n";
 
329
    }
 
330
 
 
331
    exit ARG_ERR(); 
 
332
}
 
333
 
 
334
sub pad {
 
335
    my $string = shift;
 
336
    my $width = '20';
 
337
    return $string . ' ' x ($width - length($string));
 
338
}
 
339
 
 
340
# Print version
 
341
sub version {
 
342
    print "Uses SpSVG version $VERSION\n";
 
343
    exit ARG_ERR();
 
344
}
 
345
 
 
346
# End of module; return something true
 
347
1;
 
348
 
 
349
__END__
 
350
 
 
351
DOCUMENTATION HERE