C4/OAI/Utility.pm

   1 #  ---------------------------------------------------------------------
   2 #   Utility routines for cleaning and formatting XML related to OAI
   3 #    v1.1
   4 #    January 2002
   5 #  ------------------+--------------------+-----------------------------
   6 #   Hussein Suleman  |   hussein@vt.edu   |    www.husseinsspace.com
   7 #  ------------------+--------------------+-+---------------------------
   8 #   Department of Computer Science          |        www.cs.vt.edu
   9 #     Digital Library Research Laboratory   |       www.dlib.vt.edu
  10 #  -----------------------------------------+-------------+-------------
  11 #   Virginia Polytechnic Institute and State University   |  www.vt.edu
  12 #  -------------------------------------------------------+-------------
  13
  14
  15 package C4::OAI::Utility;
  16
  17
  18 # constructor [create mapping for latin entities to Unicode]
  19 sub new
  20 {
  21    my $classname = shift;
  22
  23    my $self = { XMLindent => '   ' };
  24
  25    my @upperentities = qw (nbsp iexcl cent pound curren yen brvbar sect
  26                            uml copy ordf laquo not 173 reg macr deg plusmn
  27                            sup2 sup3 acute micro para middot cedil supl
  28                            ordm raquo frac14 half frac34 iquest Agrave
  29                            Aacute Acirc Atilde Auml Aring AElig Ccedil
  30                            Egrave Eacute Ecirc Euml Igrave Iacute Icirc
  31                            Iuml ETH Ntilde Ograve Oacute Ocirc Otilde Ouml
  32                            times Oslash Ugrave Uacute Ucirc Uuml Yacute
  33                            THORN szlig agrave aacute acirc atilde auml
  34                            aring aelig ccedil egrave eacute ecirc euml
  35                            igrave iacute icirc iuml eth ntilde ograve
  36                            oacute ocirc otilde ouml divide oslash ugrave
  37                            uacute ucirc uuml yacute thorn yuml);
  38    $upperentities[12] = '#173';
  39
  40    $self->{'hashentity'} = {};
  41    for ( my $i=0; $i<=$#upperentities; $i++ )
  42    {
  43       my $key = '&'.$upperentities[$i].';';
  44       $self->{'hashentity'}->{$key}=$i+160;
  45    }
  46
  47    $self->{'hashstr'} = (join (';|', @upperentities)).';';
  48
  49    bless $self, $classname;
  50    return $self;
  51 }
  52
  53
  54 # clean XML version one - for paragraphs
  55 sub pclean
  56 {
  57    my ($self, $t) = @_;
  58    return undef if (! defined $t);
  59    # make ISOlat1 entities into Unicode character entities
  60    $t =~ s/&($self->{'hashstr'})/sprintf ("&#x%04X;", $self->{'hashentity'}->{$&})/geo;
  61    # escape non-XML-encoded ampersands (including from other characters sets)
  62    $t =~ s/&(?!((#[0-9]*)|(#x[0-9]*)|(amp)|(lt)|(gt)|(apos)|(quot));)/&amp;/go;
  63    # convert extended ascii into Unicode character entities
  64    $t =~ s/[\xa0-\xff]/'&#'.ord ($&).';'/geo;
  65    # remove extended ascii that doesnt translate into ISO8859/1
  66    $t =~ s/[\x00-\x08\x0B\x0C\x0E-\x1f\x80-\x9f]//go;
  67    # make tags delimiters into entities
  68    $t =~ s/</&lt;/go;
  69    $t =~ s/>/&gt;/go;
  70    # convert any whitespace containing lf or cr into a single cr
  71    $t =~ s/(\s*[\r\n]\s+)|(\s+[\r\n]\s*)/\n/go;
  72    # convert multiples spaces/tabs into a single space
  73    $t =~ s/[ \t]+/ /go;
  74    # kill leading and terminating spaces
  75    $t =~ s/^[ ]+(.+)[ ]+$/$1/;
  76    return $t;
  77 }
  78
  79
  80 # clean XML version two - for single-line streams
  81 sub lclean
  82 {
  83    my ($self, $t) = @_;
  84    return undef if (! defined $t );
  85    # make ISOlat1 entities into Unicode character entities
  86    $t =~ s/&($self->{'hashstr'})/sprintf ("&#x%04X;", $self->{'hashentity'}->{$&})/geo;
  87    # escape non-XML-encoded ampersands (including from other characters sets)
  88    $t =~ s/&(?!((#[0-9]*)|(#x[0-9]*)|(amp)|(lt)|(gt)|(apos)|(quot));)/&amp;/go;
  89    # convert extended ascii into Unicode character entities
  90    $t =~ s/[\xa0-\xff]/'&#'.ord ($&).';'/geo;
  91    # remove extended ascii that doesnt translate into ISO8859/1
  92    $t =~ s/[\x00-\x08\x0B\x0C\x0E-\x1f\x80-\x9f]//go;
  93    # make tags delimiters into entities
  94    $t =~ s/</&lt;/go;
  95    $t =~ s/>/&gt;/go;
  96    # flatten whitespace
  97    $t =~ s/[\s\t\r\n]+/ /go;
  98    # kill leading and terminating spaces
  99    $t =~ s/^[ ]+(.+)[ ]+$/$1/;
 100    return $t;
 101 }
 102
 103
 104 # remove newlines and carriage returns
 105 sub straighten
 106 {
 107    my ($self, $t) = @_;
 108    # eliminate all carriage returns and linefeeds
 109    $t =~ s/[\t\r\s\n]+/ /go;
 110    return $t;
 111 }
 112
 113
 114 # convert a data structure in Perl to XML
 115 #  format of $head:
 116 #  {
 117 #    tag1 => [
 118 #              [
 119 #                { attr1 => val1, attr2 => val2, ... },
 120 #                { children }
 121 #              ],
 122 #              [
 123 #                { attr1 => val1, attr2 => val2, ... },
 124 #                "text string"
 125 #              ],
 126 #              { children },
 127 #              "text string"
 128 #            ],
 129 #    tag2 => { children },
 130 #    tag3 => "text string",
 131 #    mdorder => [ "tag1", "tag2", "tag3" ]
 132 #  }
 133 #
 134 sub FormatXML
 135 {
 136    my ($self, $head, $indent) = @_;
 137    $indent .= $self->{'XMLindent'};
 138    my ($key, $i, $j, $buffer, @orderedkeys);
 139    $buffer = '';
 140    if (exists ($head->{'mdorder'}))
 141    { @orderedkeys = @{$head->{'mdorder'}}; }
 142    else
 143    { @orderedkeys = keys %$head; }
 144    foreach $key (@orderedkeys)
 145    {
 146       if ((exists ($head->{$key})) && (ref ($head->{$key}) eq 'ARRAY'))
 147       {
 148          foreach $i (@{$head->{$key}})
 149          {
 150             if (ref ($i) eq 'ARRAY')
 151             {
 152                my $atthash = $$i[0];
 153                my $childhash = $$i[1];
 154
 155                $buffer .= "$indent<$key";
 156                foreach $j (keys %$atthash)
 157                {
 158                   $buffer .= " $j=\"$atthash->{$j}\"";
 159                }
 160                $buffer .= ">\n";
 161
 162                if (ref ($childhash) eq 'HASH')
 163                {
 164                   $buffer .= $self->FormatXML ($childhash, $indent);
 165                }
 166                else
 167                {
 168                   $buffer .= "$indent$childhash\n";
 169                }
 170
 171                $buffer .= "$indent</$key>\n";
 172             }
 173             elsif (ref ($i) eq 'HASH')
 174             {
 175                my $nestedbuffer = $self->FormatXML ($i, $indent);
 176                if ($nestedbuffer ne '')
 177                {
 178                   $buffer .= "$indent<$key>\n$nestedbuffer$indent</$key>\n";
 179                }
 180             }
 181             else
 182             {
 183                $buffer .= "$indent<$key>$i</$key>\n";
 184             }
 185          }
 186       }
 187       elsif ((exists ($head->{$key})) && (ref ($head->{$key}) eq 'HASH'))
 188       {
 189          my $nestedbuffer = $self->FormatXML ($head->{$key}, $indent);
 190          if ($nestedbuffer ne '')
 191          {
 192             $buffer .= "$indent<$key>\n$nestedbuffer$indent</$key>\n";
 193          }
 194       }
 195       elsif ((exists ($head->{$key})) && ($head->{$key} ne ''))
 196       {
 197          $buffer .= "$indent<$key>$head->{$key}</$key>\n";
 198       }
 199    }
 200    $buffer;
 201 }
 202
 203
 204 1;