Jabber-Lite

 view release on metacpan or  search on metacpan

lib/Jabber/Lite.pm  view on Meta::CPAN

	# $self->debug( "toStr starting\n") if( $dval );
	if( ! $usefh ){
		$retstr = "<" . $self->name();
	}else{
		print $fh "<" . $self->name();
	}

	# See if this is actually processing instructions etc.
	if( $self->name() =~ /^\[CDATA\[/ ){
		if( ! $usefh ){
			$retstr .= $self->{'_cdata'} . "]]";
		}else{
			print $fh $self->{'_cdata'} . "]]";
		}
		$doend = 1;
	}elsif( $self->name() =~ /^\!/ ){
		$mustend = 1;

		# doctype stuff is special.  When we see the
		# pattern '\[\s*\]' within, that means that we
		# insert, at that point, the 'next' subtag object,
		# and so forth.  Annoying stuff.
		my $tstr = "";

lib/Jabber/Lite.pm  view on Meta::CPAN

				# of the string received in case we received the
				# '/' during the previous call.
				# We send it back if we did.
				if( $self->{'_name'} =~ /^\!\-\-(.*)$/s ){
					# Start processing a comment.
					$curstatus = "comment";
					$self->{'_name'} = '!--';
					$str = $1 . $str;

				}elsif( $self->{'_name'} =~ /^(\!\[CDATA\[)(.*)$/ ){
					$curstatus = "cdata";
					$self->{'_name'} = $1;
					$str = $2 . $str;

				}elsif( $self->{'_name'} =~ /\/$/s ){
					# Possible start of '/>' .  Send it back.
					# If its actually 'sdlfk//sdf', it'll be
					# properly parsed next time.
					chop( $self->{'_name'} );
					$str = '/' . $str;
					$curstatus = "name";

lib/Jabber/Lite.pm  view on Meta::CPAN

					# We've got a space.  The name has been 
					# completed.
					$curstatus = "attribs";

					# See if this is special stuff.
					if( $self->{'_name'} =~ /^\!/ ){
						$curstatus = "doctype";
					}elsif( $self->{'_name'} =~ /^\?/s ){
						$curstatus = "processinginstructions";
					}elsif( $self->{'_name'} =~ /^(\!\[CDATA\[)(.*)$/ ){
						$curstatus = "cdata";
						$self->{'_name'} = $1;
						$str = $2 . $str;
					}

				}elsif( ! defined( $str ) ){
					$str = "";
				}

				$self->debug( " ($curstatus) Remaining is $str X\n" ) if( $dval );

lib/Jabber/Lite.pm  view on Meta::CPAN

			if( $curstatus eq "attribs" ){
				if( $self->{'_name'} =~ /^\!\-\-(.*)$/s ){
					# Start processing a comment.
					$curstatus = "comment";
					$str = $1 . $str;
				}elsif( $self->{'_name'} =~ /^\!/ ){
					$curstatus = "doctype";
				}elsif( $self->{'_name'} =~ /^\?/s ){
					$curstatus = "processinginstructions";
				}elsif( $self->{'_name'} =~ /^(\!\[CDATA\[)(.*)$/ ){
					$curstatus = "cdata";
					$self->{'_name'} = $1;
					$str = $2 . $str;
				}
			}

			# Finally, check for a valid name.
			if( $curstatus ne "name" ){
				if( $self->{'_name'} !~ /^[A-Za-z][A-Za-z0-9\-\_\:\.]*$/ ){
					if( $self->{'_name'} !~ /^(\?|\!)(\S+)/ ){
						# Invalid XML!
						$retval = -2;
						$retstr = $str;
						return( $retval, $retstr );
					}
				}
			}
		}

		# The string is (or is now) text that is stuff with the doctype
		# declaration.
		if( $curstatus =~ /^(doctype|processinginstructions|cdata)/ ){
			my $strlength = ( length( $str ) - 1 );

			my $loop = -1;
			my $stillgoing = 1;
			my $prevquery = -5;

			while( $loop < $strlength && $stillgoing ){
				$loop++;
				my $thischar = substr( $str, $loop, 1 );
				if( $curstatus eq "doctype" ){

lib/Jabber/Lite.pm  view on Meta::CPAN

							$curstatus = "complete";
							$stillgoing = 0;
						}
						next;
					}elsif( $thischar eq '?' ){
						$prevquery = '?';
						$self->{'_processinginstructions'} .= $thischar;
					}else{
						$self->{'_processinginstructions'} .= $thischar;
					}
				}elsif( $curstatus eq "cdata" ){
					if( $thischar eq '>' ){
						$self->{'_cdata'} .= $thischar;
						# See if this is the end pattern?
						if( $self->{'_cdata'} =~ /\]\]>$/s ){
							chomp( $self->{'_processinginstructions'} );
							chomp( $self->{'_processinginstructions'} );
							chomp( $self->{'_processinginstructions'} );
							$curstatus = "complete";
							$stillgoing = 0;
						}
					}else{
						$self->{'_cdata'} .= $thischar;
					}
				}
			}

			# Supply the remaining text to return.
			if( $loop < $strlength ){
				# Remember that $loop is the character that we
				# have read, and $strlength has been decremented
				# already.  So adding 1 to $loop is ok.
				$str = substr( $str, ( $loop + 1 ) );