需要更新Perl脚本...不熟悉Perl

Question

好吧..。我们在Exchange中有一个通讯录，它被导出到一个XML文件中...被我们的内部网使用的。用于我们的关联目录。发生了一些事情，导致了一系列事件，导致XML得到更新。

显然，我们的Squirrel Mail服务器使用Perl脚本将该XML转换为global.abook。

我不精通Perl，但一般的想法似乎很容易理解:遍历XML，为每个人提取“昵称”、全名、电子邮件和头衔并放入global.abook。

我确信旧的XML文件没有Root\XSD:Schema和Root\DataRoot布局。不确定最好的更新格式是什么。

Perl脚本：

#!/usr/bin/perl
use strict;

use XML::Parser;
use Data::Dumper;

my $url = 'http://intranet.mycompany.org/directory/directory.xml';
my $output = '/var/lib/squirrelmail/prefs/global.gabook';

my $file = "curl -sS '$url' |";
my $parser = new XML::Parser(Style => 'Tree');
my $tree = $parser->parsefile($file)->[1];

sub extract {
        my ($string, $record) = @_;
        for (my $i = 0; $i < @{$record}.''; $i++) {
                if ($record->[$i] eq $string) {
                        return $record->[$i + 1][2];
                }
        }
        return undef;
}

open FILE, "> $output"
        or die "Couldn't open: $!";
for (my $i = 4; $i < @{$tree}.''; $i += 4) {
        my $record = $tree->[$i];
        my $full = &extract('DisplayName', $record);
        my $title = &extract('JobTitle', $record);
        my $email = &extract('EMailDisplayName', $record);
        next unless($email);
        my $nickname;
        # Nickname is the first part of the email address
        if ($email =~ /^(\w+)\@/) {
                $nickname = $1;
        }
        print FILE "$nickname|$full||$email|$title" . "\n";
}
close FILE

XML文件：

<?xml version="1.0" standalone="yes"?>
<root xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:od="urn:schemas-microsoft-com:officedata">
  <xsd:schema>
  ...
  </xsd:schema>
  <dataroot xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" generated="2011-07-12T14:14:13">
    <ROW>
      <DisplayName>John Doe</DisplayName>
      <FirstName>John</FirstName>
      <LastName>Doe</LastName>
      <JobTitle>I.D. 10 Technologist</JobTitle>
      <Company>My Company</Company>
      <Department>Administration</Department>
      <FileAs>Doe, John</FileAs>
      <BusinessPhone>(800) 867-5309</BusinessPhone>
      <EMailAddress>jdoe@mycompany.org</EMailAddress>
      <EMailAddressType>SMTP</EMailAddressType>
      <EMailDisplayName>jdoe@mycompany.org</EMailDisplayName>
      <Initials>J.D.</Initials>
      <Private>0</Private>
    </ROW>
    <ROW>
      ...
    </ROW>
  </dataroot>
</root>

所需的文本文件：

jdoe|John Doe||jdoe@atlanticgeneral.org|I.D. 10 Technician
...
...

Answer 1

这是你要找的东西吗？

use strict;
use warnings;
use XML::Simple;
use LWP::Simple;


my $url = 'http://intranet.mycompany.org/directory/directory.xml';
my $outfile = '/var/lib/squirrelmail/prefs/global.gabook';


my $xml = get( $url );
my $structure = XMLin( $xml );

open my $out_fh, '>', $outfile or die $!;
foreach my $row ( @{ $structure->{dataroot}{ROW} } ) {
    next unless exists $row->{FileAs} and defined $row->{FileAs};
    my( $email, $name, $title ) = map{
        warn "Warning: $_ is undefined for $row->{FileAs}."
            unless exists $row->{$_} and defined $row->{$_};
        $row->{$_} || '';
    } qw/ EMailAddress DisplayName JobTitle /;
    my $nick;
    if( $email =~ m/^([^@]+)@/ ) {
        $nick = $1;
    } else {
        $nick = '';
        warn "Warning: No nickname for $row->{FileAs}.";
    }
    print $out_fh "$nick|$name||$email|$title\n";
}

close $out_fh or die $!;

如果您的XML不是非常复杂，那么XML::Simple是一个简单的解决方案。而且，当您可以从curl内部使用LWP::Simple时，我认为在shell中使用Perl没有太大的需求。不过，如果您愿意，可以很容易地修改上面的代码，使其与原始脚本的依赖关系更接近。我使用的LWP::Simple可以被您的curl所取代。

我添加了屏幕警告和默认行为，在特定字段不包含任何内容或不存在的情况下。例如，如果给定行缺少EMailAddress，您将收到几条有关这方面的警告。但是默认的空字符串将被插入到该列位置，以便正常恢复。如果您认为这样的问题足够严重，您可以将warns更改为die。

我还跳过任何没有定义FileAs标记的行，前提是至少必须存在一个标记才能使记录有效。你可以根据需要修改它，但我会保留一些优雅的“如果它不是有效记录”的代码，以防万一。

Answer 2

XML：：解析器是相当神秘的。我使用XML::LibXML。

#!/usr/bin/perl
use strict;

use XML::LibXML               qw( );
use XML::LibXML::XPathContext qw( );

my $xml = <<'__EOI__';
<?xml version="1.0" standalone="yes"?>
<root xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:od="urn:schemas-microsoft-com:officedata">
  <xsd:schema>
  ...
  </xsd:schema>
  <dataroot xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" generated="2011-07-12T14:14:13">
    <ROW>
      <DisplayName>John Doe</DisplayName>
      <FirstName>John</FirstName>
      <LastName>Doe</LastName>
      <JobTitle>I.D. 10 Technologist</JobTitle>
      <Company>My Company</Company>
      <Department>Administration</Department>
      <FileAs>Doe, John</FileAs>
      <BusinessPhone>(800) 867-5309</BusinessPhone>
      <EMailAddress>jdoe@mycompany.org</EMailAddress>
      <EMailAddressType>SMTP</EMailAddressType>
      <EMailDisplayName>jdoe@mycompany.org</EMailDisplayName>
      <Initials>J.D.</Initials>
      <Private>0</Private>
    </ROW>
  </dataroot>
</root>
__EOI__

sub get_text { map $_->textContent, @_ }

my $parser = XML::LibXML->new();
my $doc = $parser->parse_string($xml);
my $root = $doc->documentElement();

for my $row ($root->findnodes('/root/dataroot/ROW')) {
   my ($name)  = get_text( $row->findnodes('DisplayName') );
   my ($title) = get_text( $row->findnodes('JobTitle') );
   my ($email) = get_text( $row->findnodes('EMailDisplayName') );

   if (!defined($name) || !defined($title) || !defined($email)) {
      warn("Bad record\n");
      next;
   }

   my ($nick) = $email =~ /^([^@]*)/;

   print("$nick|$name||$email|$title\n");
}