Level 1

8 points

Script to replace XML attribute value in multiple elements?

Forgive my ignorance, maybe this is simple but... I have an XML file containing info on multiple clips listed as follows:

</video>

</clip>

<clip name="CLIP 2".... etc.

Every clip (could be 4, could be 100) has the same "audio lane" attributes (1,2,3), and the same "role" attributes (dialogue). all other attributes are different for each clip in the XML.

What I'd like to do is, for each audio lane in every clip in the XML, change the the "role" attribute, and leave everything else alone. In a perfect world, I'd have a dialog pop up the listed the audio lanes, and a text box to enter the text I'd like to replace the existing role attribute in every instance of each lane. So all the audio lanes for every clip would change. Using etc Edit, Text Wrangler... something like that? I'd end up with something like the following:

If the role attributes were all different, then I could just do a find and replace for the attributes, but since; they're the same for every audio lane, I'm clueless. Knowing that I'm clueless, I'm guessing there's a way to do this? I can do it manually, but if I had, say 100 clips in the XML, it'd be nice to automate it somehow. Thanks!

OS X Yosemite (10.10.4)

Posted on Jul 14, 2015 11:09 AM

24 replies

CAIV Author

Level 1

8 points

Aug 1, 2015 2:11 AM in response to Hiroto

Hi,

It has been very well received, thank you again! All I did was change the file type (xml to fcpxml) add and modify some dialogs, add a pretty icon, write some instructions, and wrap it up in an app. The heavy lifting is all you.

Yes, your summary -- "every audio element with attribute lane="L" has attributes role="ROLE_X" and name="ROLE_X" for specified lane-role mapping L => ROLE_X." -- is correct. And I think that if there is an existing "name" attribute in any "audio" elements, it should be preserved, as "name" does not exist unless a user has intentionally renamed the element before exporting xml.

Please only do this if you have spare time, you've been a huge help and I hesitate to ask. The toughest thing for me, is that I can "read" the script and see exactly what it's doing, but have just started into Perl tutorials and am honestly just at the print "hello world" stage. :-)

If you're interested, here's a link to the script in it's current form. Thanks!

Hiroto

Level 5

7,467 points

Aug 1, 2015 5:10 PM in response to CAIV

Hello

Here's the revised script in its original form. Only the last "do shell script" part along with its relevant comment has been changed.

And please do not hesitate to ask. It's always my pleasure to handcraft this sort of script especially when it helps good people. 🙂

By the way I do like the cool icon of your applet.

Good luck and happy scripting!

Hiroto

set infile to (choose file of type {"xml"} with prompt "Choose input xml file")'s POSIX path set outfile to (choose file name default name "out.xml" with prompt "Specify output xml file name and location")'s POSIX path -- retrieve audio lane attribute values from the 1st /clip/video and/or /clip/audio element(s) in input file do shell script "perl -w <<'EOF' - " & infile's quoted form & " use strict; use XML::LibXML; local $, = qq(\\t); local $\\ = qq(\\n); my $parser = XML::LibXML->new(); my $doc = $parser->parse_file(shift); my ($rr, @rr); # clip/video/audio # extract lane attribute from //clip[video][1]/video/audio elements $rr = $doc->find( qq(//clip[video][1]/video/audio/\\@lane) ); @rr = sort { $b <=> $a } map { $_->value } @{$rr}; print 'video', @rr if @rr; # clip/audio and clip/audio/audio # add attribute lane='0' to //clip/audio elements $rr = $doc->find( qq(//clip/audio) ); for my $r (@{$rr}) { my $lane = $r->find( qq(\\@lane) ); if ($lane) { $lane->[0]->setValue('0'); } else { $r->addChild(XML::LibXML::Attr->new('lane', '0')); } } # etract lane attribute from //clip[audio][1]//* elemeents $rr = $doc->find( qq(//clip[audio][1]//\\@lane) ); @rr = sort { $b <=> $a } map { $_->value } @{$rr}; print 'audio', @rr if @rr; EOF" (* result is audio lane attributes for video and/or autio element(s) denoted by kind \t lane \t lane ... \n e.g., video -1 -2 -3 -4 audio 0 -1 -2 -3 *) set rr to result's paragraphs try set {astid0, AppleScript's text item delimiters} to {AppleScript's text item delimiters, tab} repeat with r in rr set r's contents to r's text items end repeat set AppleScript's text item delimiters to astid0 on error errs number errn set AppleScript's text item delimiters to astid0 error errs number errn end try (* rr is 2d array representation of audio lane attributes for video and audio e.g. {{"video", "-1", "-2", "-3", "-4"}, {"audio", "0", "-1", "-2", "-3"}} *) -- build lane => role mappings set aa to {} repeat with r in rr set clip_kind to r's item 1 set t to "Mappings for " & clip_kind & " clip" repeat set mappings to "" repeat with i in r's rest display dialog "Enter audio role for audio lane " & i default answer "" with title t set mappings to mappings & i & tab & result's text returned & linefeed end repeat try display dialog "audio lane -> audio role" & return & mappings with title t exit repeat end try end repeat (* mappings holds lane => role mappings of which each mapping is denoted by lane \t role \n e.g. -1 \t ROLE_A \n -2 \t ROLE_B \n -3 \t ROLE_C \n *) set aa's end to clip_kind set aa's end to mappings end repeat (* aa is flat list as {kind, mappings} or {kind, mappings, kind, mappings} *) -- edit the audio role attribute values, and add name attribute if not present, according to the mappings and yield output file set args to "" repeat with a in {infile} & aa set args to args & a's quoted form & space end repeat do shell script "perl -w <<'EOF' - " & args & " > " & outfile's quoted form & " # # ARGV = infile kind mappings kind mappings ... # use strict; use XML::LibXML; my $parser = XML::LibXML->new(); my $doc = $parser->parse_file(shift); # add attribute lane=\"0\" to //clip/audio elements my $rr = $doc->find( qq(//clip/audio) ); for my $r (@{$rr}) { my $lane = $r->find( qq(\\@lane) ); if ($lane) { $lane->[0]->setValue('0'); } else { $r->addChild(XML::LibXML::Attr->new('lane', '0')); } } while (my $kind = shift) { my %roles = (shift =~ /^(.+?)\\t(.+)$/omg); for my $k (keys %roles) { # set role attribute values according to lane-role mapings my $rr = $doc->find( qq(//clip/$kind/descendant-or-self::audio[\\@lane=\"$k\"]/\\@role) ); for my $r (@{$rr}) { $r->setValue($roles{$k}); } # set name attribute values according to lane-role mappings $rr = $doc->find( qq(//clip/$kind/descendant-or-self::audio[\\@lane=\"$k\"]) ); for my $r (@{$rr}) { my $name = $r->find( qq(\\@name) ); if ($name) { # $name->[0]->setValue($roles{$k}); # replace existing name attribute (currently commented out) } else { $r->addChild(XML::LibXML::Attr->new('name', $roles{$k})); } } } } print $doc->toString(0); EOF"

CAIV Author

Level 1

8 points

Aug 1, 2015 6:04 PM in response to Hiroto

Hi Hiroto,

As usual, it works perfectly. Thanks! I noticed you've commented out what I assume is the line that would replace the "name" attribute if they element already exists. Am I reading it correctly? Would it be too much trouble to have the script pause there and display a dialog saying "Replace existing Component Names?" with yes or no choices? Yes would replace them and no would leave them alone? (FYI, components are what the app calls the objects defined in the "audio" elements) I know how to do the dialog bit, but no idea what to do to the perl bit to tell it what to do... Either way, as always, Thank you!

Charlie

CAIV Author

Level 1

8 points

Aug 1, 2015 7:12 PM in response to CAIV

Oh.. This is probably goes without saying,, but if there are no "name" attributes then the dialog would of course not appear. I always feel I'm being unclear. :-) With this, there's nothing else the script could possibly do, so I won't have to bug you anymore. :-D Thanks so much Hiroto!

Hiroto

Level 5

7,467 points

Aug 2, 2015 4:25 PM in response to CAIV

Hello Charlie,

Here's a revision you may try. To present dialogue from Perl script, I invoked AppleScript via osascript in quoted execution in Perl. As far as I have tested under OS X 10.6.8, it works as intended. But later OSes might be different with regard to this sort of user interaction from command line... If it fails, let me know and I'll be exploring other ways.

Hope this may help.

Hiroto

set infile to (choose file of type {"xml"} with prompt "Choose input xml file")'s POSIX path set outfile to (choose file name default name "out.xml" with prompt "Specify output xml file name and location")'s POSIX path -- retrieve audio lane attribute values from the 1st /clip/video and/or /clip/audio element(s) in input file do shell script "perl -w <<'EOF' - " & infile's quoted form & " use strict; use XML::LibXML; local $, = qq(\\t); local $\\ = qq(\\n); my $parser = XML::LibXML->new(); my $doc = $parser->parse_file(shift); my ($rr, @rr); # clip/video/audio # extract lane attribute from //clip[video][1]/video/audio elements $rr = $doc->find( qq(//clip[video][1]/video/audio/\\@lane) ); @rr = sort { $b <=> $a } map { $_->value } @{$rr}; print 'video', @rr if @rr; # clip/audio and clip/audio/audio # add attribute lane='0' to //clip/audio elements $rr = $doc->find( qq(//clip/audio) ); for my $r (@{$rr}) { my $lane = $r->find( qq(\\@lane) ); if ($lane) { $lane->[0]->setValue('0'); } else { $r->addChild(XML::LibXML::Attr->new('lane', '0')); } } # etract lane attribute from //clip[audio][1]//* elemeents $rr = $doc->find( qq(//clip[audio][1]//\\@lane) ); @rr = sort { $b <=> $a } map { $_->value } @{$rr}; print 'audio', @rr if @rr; EOF" (* result is audio lane attributes for video and/or autio element(s) denoted by kind \t lane \t lane ... \n e.g., video -1 -2 -3 -4 audio 0 -1 -2 -3 *) set rr to result's paragraphs try set {astid0, AppleScript's text item delimiters} to {AppleScript's text item delimiters, tab} repeat with r in rr set r's contents to r's text items end repeat set AppleScript's text item delimiters to astid0 on error errs number errn set AppleScript's text item delimiters to astid0 error errs number errn end try (* rr is 2d array representation of audio lane attributes for video and audio e.g. {{"video", "-1", "-2", "-3", "-4"}, {"audio", "0", "-1", "-2", "-3"}} *) -- build lane => role mappings set aa to {} repeat with r in rr set clip_kind to r's item 1 set t to "Mappings for " & clip_kind & " clip" repeat set mappings to "" repeat with i in r's rest display dialog "Enter audio role for audio lane " & i default answer "" with title t set mappings to mappings & i & tab & result's text returned & linefeed end repeat try display dialog "audio lane -> audio role" & return & mappings with title t exit repeat end try end repeat (* mappings holds lane => role mappings of which each mapping is denoted by lane \t role \n e.g. -1 \t ROLE_A \n -2 \t ROLE_B \n -3 \t ROLE_C \n *) set aa's end to clip_kind set aa's end to mappings end repeat (* aa is flat list as {kind, mappings} or {kind, mappings, kind, mappings} *) -- edit the audio role attribute values, and add name attribute if not present, according to the mappings and yield output file set args to "" repeat with a in {infile} & aa set args to args & a's quoted form & space end repeat do shell script "perl -w <<'EOF' - " & args & " > " & outfile's quoted form & " # # ARGV = infile kind mappings kind mappings ... # use strict; use XML::LibXML; my $parser = XML::LibXML->new(); my $doc = $parser->parse_file(shift); # add attribute lane=\"0\" to //clip/audio elements my $rr = $doc->find( qq(//clip/audio) ); for my $r (@{$rr}) { my $lane = $r->find( qq(\\@lane) ); if ($lane) { $lane->[0]->setValue('0'); } else { $r->addChild(XML::LibXML::Attr->new('lane', '0')); } } my $replace = 0; while (my $kind = shift) { my %roles = (shift =~ /^(.+?)\\t(.+)$/omg); for my $k (keys %roles) { # set role attribute values according to lane-role mapings my $rr = $doc->find( qq(//clip/$kind/descendant-or-self::audio[\\@lane=\"$k\"]/\\@role) ); for my $r (@{$rr}) { $r->setValue($roles{$k}); } # set name attribute values according to lane-role mappings $rr = $doc->find( qq(//clip/$kind/descendant-or-self::audio[\\@lane=\"$k\"]) ); for my $r (@{$rr}) { my $name = $r->find( qq(\\@name) ); if ($name) { if ( ($replace ||= &ask()) == 1 ) { $name->[0]->setValue($roles{$k}); # replace existing name attribute } } else { $r->addChild(XML::LibXML::Attr->new('name', $roles{$k})); } } } } print $doc->toString(0); sub ask() { my $r = qx[osascript <<'ASCR' tell application \"System Events\" set bttns to {\"Replace\", \"Never\"} set p1 to process 1 whose frontmost = true activate set r to display dialog \"Replace existing Component Names?\" buttons bttns default button 2 if p1 exists then set p1's frontmost to true if r's button returned = bttns's item 1 then return 1 return 2 end tell ASCR]; chomp $r; return $r; } EOF"

CAIV Author

Level 1

8 points

Aug 2, 2015 5:37 PM in response to Hiroto

Hi Hiroto,

Unsurprisingly, it works great! :-) I've tested it on 10.10.4. Will check it on 10.10.11 soon and report back. My guess is it will be fine. Once again, thank you very much! Quite a few people will benefit from this! :-)

Best,

Charlie

CAIV Author

Level 1

8 points

Aug 3, 2015 8:46 AM in response to CAIV

Hi, just letting you know that it works fine in OS X 10.11 (beta) as well. Thank you!

Charlie

Hiroto

Level 5

7,467 points

Aug 3, 2015 5:32 PM in response to CAIV

Hello Charlie,

My pleasure! And thank you for updates. Good to know that this sort of script keeps working in recent OSes. Perl is a tried and true language and it won't easily fail. If something should fail eventually, it would be AppleScript and/or scriptable applications.

By the way, I noticed the last script has difficulties to display your cool icon in the dialogue shown by Perl script, for AppleScript via osascript has no knowledge about the icon path in applet bundle.

So... Here's another revision to have applet or script bundle display the icon in every dialogue including the one by osascript. I just obtained the icon path at the beginning of script and supplied it to every dispaly dialog command. Icon path is passed via command line argument in applescript -> perl -> osascript chain.

All the best,

Hiroto

(* Script is to be saved as applet or script bundle so that it has Contents/Resources/applet.icns. *) set iconfile to (path to me)'s POSIX path & "/Contents/Resources/applet.icns" set infile to (choose file of type {"xml"} with prompt "Choose input xml file")'s POSIX path set outfile to (choose file name default name "out.xml" with prompt "Specify output xml file name and location")'s POSIX path -- retrieve audio lane attribute values from the 1st /clip/video and/or /clip/audio element(s) in input file do shell script "perl -w <<'EOF' - " & infile's quoted form & " use strict; use XML::LibXML; local $, = qq(\\t); local $\\ = qq(\\n); my $parser = XML::LibXML->new(); my $doc = $parser->parse_file(shift); my ($rr, @rr); # clip/video/audio # extract lane attribute from //clip[video][1]/video/audio elements $rr = $doc->find( qq(//clip[video][1]/video/audio/\\@lane) ); @rr = sort { $b <=> $a } map { $_->value } @{$rr}; print 'video', @rr if @rr; # clip/audio and clip/audio/audio # add attribute lane='0' to //clip/audio elements $rr = $doc->find( qq(//clip/audio) ); for my $r (@{$rr}) { my $lane = $r->find( qq(\\@lane) ); if ($lane) { $lane->[0]->setValue('0'); } else { $r->addChild(XML::LibXML::Attr->new('lane', '0')); } } # etract lane attribute from //clip[audio][1]//* elemeents $rr = $doc->find( qq(//clip[audio][1]//\\@lane) ); @rr = sort { $b <=> $a } map { $_->value } @{$rr}; print 'audio', @rr if @rr; EOF" (* result is audio lane attributes for video and/or autio element(s) denoted by kind \t lane \t lane ... \n e.g., video -1 -2 -3 -4 audio 0 -1 -2 -3 *) set rr to result's paragraphs try set {astid0, AppleScript's text item delimiters} to {AppleScript's text item delimiters, tab} repeat with r in rr set r's contents to r's text items end repeat set AppleScript's text item delimiters to astid0 on error errs number errn set AppleScript's text item delimiters to astid0 error errs number errn end try (* rr is 2d array representation of audio lane attributes for video and audio e.g. {{"video", "-1", "-2", "-3", "-4"}, {"audio", "0", "-1", "-2", "-3"}} *) -- build lane => role mappings set aa to {} repeat with r in rr set clip_kind to r's item 1 set t to "Mappings for " & clip_kind & " clip" repeat set mappings to "" repeat with i in r's rest display dialog "Enter audio role for audio lane " & i default answer "" with title t with icon (iconfile as POSIX file) set mappings to mappings & i & tab & result's text returned & linefeed end repeat try display dialog "audio lane -> audio role" & return & mappings with title t with icon (iconfile as POSIX file) exit repeat end try end repeat (* mappings holds lane => role mappings of which each mapping is denoted by lane \t role \n e.g. -1 \t ROLE_A \n -2 \t ROLE_B \n -3 \t ROLE_C \n *) set aa's end to clip_kind set aa's end to mappings end repeat (* aa is flat list as {kind, mappings} or {kind, mappings, kind, mappings} *) -- edit the audio role attribute values, and add name attribute if not present, according to the mappings and yield output file set args to "" repeat with a in {iconfile, infile} & aa set args to args & a's quoted form & space end repeat do shell script "perl -w <<'EOF' - " & args & " > " & outfile's quoted form & " # # ARGV = iconfile infile kind mappings kind mappings ... # use strict; use XML::LibXML; my $icon = shift; # POSIX path of icon file (my $icon_quoted) = map { s/'/'\\\\''/og; q(').$_.q('); } ($icon); # quoted POSIX path for use in qx[] my $parser = XML::LibXML->new(); my $doc = $parser->parse_file(shift); # add attribute lane=\"0\" to //clip/audio elements my $rr = $doc->find( qq(//clip/audio) ); for my $r (@{$rr}) { my $lane = $r->find( qq(\\@lane) ); if ($lane) { $lane->[0]->setValue('0'); } else { $r->addChild(XML::LibXML::Attr->new('lane', '0')); } } my $replace = ''; while (my $kind = shift) { my %roles = (shift =~ /^(.+?)\\t(.+)$/omg); for my $k (keys %roles) { # set role attribute values according to lane-role mapings my $rr = $doc->find( qq(//clip/$kind/descendant-or-self::audio[\\@lane=\"$k\"]/\\@role) ); for my $r (@{$rr}) { $r->setValue($roles{$k}); } # set name attribute values according to lane-role mappings $rr = $doc->find( qq(//clip/$kind/descendant-or-self::audio[\\@lane=\"$k\"]) ); for my $r (@{$rr}) { my $name = $r->find( qq(\\@name) ); if ($name) { if ( ($replace ||= &ask()) == 1 ) { $name->[0]->setValue($roles{$k}); # replace existing name attribute } } else { $r->addChild(XML::LibXML::Attr->new('name', $roles{$k})); } } } } print $doc->toString(0); sub ask() { my $r = qx[osascript <<'ASCR' - $icon_quoted on run argv set iconf to argv's item 1 as POSIX file set bttns to {\"Replace\", \"Never\"} tell application \"System Events\" set p1 to process 1 whose frontmost = true activate set r to display dialog \"Replace existing Component Names?\" buttons bttns default button 2 with icon iconf if p1 exists then set p1's frontmost to true if r's button returned = bttns's item 1 then return 1 return 2 end tell end run ASCR]; chomp $r; return $r; } EOF"

CAIV Author

Level 1

8 points

Aug 5, 2015 2:01 PM in response to Hiroto

Hi Hiroto,

Just wanted to pass this message along from a TV Production company in the Netherlands who will be using this little free script. :-)

"Just wanted to send out a big THANK YOU for the app. This is going to be playing a major part in our workflow at Metronome Productions in the future."

This thread has been closed by the system or the community team. You may vote for any posts you find helpful, or search the Community for additional answers.

Script to replace XML attribute value in multiple elements?