view release on metacpan or  search on metacpan

lib/CFDI/Parser/XML.pm  view on Meta::CPAN

=cut

sub parse(_){
  my $file = shift;
  die "file required$/" unless defined $file;
  local $_ = '';
  die "cannot access file $file$/" unless -e $file && -r _;
  open(XML,'<:encoding(UTF-8)',$file) or die "cannot open file $file as UTF-8: $!$/";
  my ($t,$squote,$dquote,$cmntOpen,$char,$buf,@tokns,$dec,$hasTags) = (0,0,0,0);
  local $SIG{__DIE__} = sub {close XML or warn "cannot close file $file: $!$/"};
  my ($chars,$buffer,$BOM);
  die "file required$/" unless defined $file;
  die "cannot access file $file$/" unless -e $file && -r _;
  $chars = sysread XML,$buffer,1;
  die "error reading first char$/" unless defined $chars;
  die "file $file is empty$/" unless $chars;
  $BOM = 65279 == ord $buffer ? 1 : 0;
  local $_;
  # RD1: $chars = sysread XML,$buffer,1;
  # die "error reading file $file$/" unless defined $chars;
  # die "parsing error at: $_$/" unless $chars;
  # $_ .= $buffer;
  # goto RD1 if -1 == index $_,'>';
  # die "declaration error: $_$/" unless s/^<\?xml($qr_at*)\?>//s;
  # $attr = $1;
  # push @attr,$1,substr$2,1,-1 while defined $attr && $attr=~s/\s*($qr_na)\s*=\s*($qr_va)\s*//;
  # exists $n{$_} ? die "attribute '$_' is not unique$/" : $n{$_}++ for grep ++$i%2, @attr;

lib/CFDI/Parser/XML.pm  view on Meta::CPAN

  # die "bad xml 1.0 declaration$/" if grep !/^(?:version|encoding|standalone)$/, keys %attr;
  # if(exists $attr{version}){
  #   if(!defined $attr{version} || $attr{version} ne '1.0'){
  #     die "xml version 1.0 only$/"}}
  # if(exists $attr{standalone}){
  #   if(!defined $attr{standalone} || $attr{standalone} !~ /^(?:yes|no)$/){
  #     die "standalone error declaration$/"}}
  # if(exists $attr{encoding}){
  #   die "encoding error declaration$/" if !defined $attr{encoding} || $attr{encoding} !~ m!^UTF[-_ /]?8$!i}
  # $dec = bless \@attr,DECLARATION;
  my ($buffer2,$buffer1) = ($BOM ? '' : $buffer);
  while(length($buffer2) || ($char = sysread XML,$buffer1,$BUFLEN) || length){
    if(length $buffer2){
      $char = 0;
    }elsif($char){
      $buffer2 = $buffer1;
      undef $buffer1;
    }else{
      s/^\s*|\s*$//;
      $_ = "<$_" if $t;
      die "parsing error: $_$/" if length;