home *** CD-ROM | disk | FTP | other *** search
/ Chip 2011 November / CHIP_2011_11.iso / Programy / Narzedzia / Inkscape / Inkscape-0.48.2-1-win32.exe / share / extensions / SpSVG.pm < prev    next >
Encoding:
Perl POD Document  |  2011-07-08  |  9.1 KB  |  352 lines
  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
  352.