eliminating unwanted substrings?

JaDe

unread,

Jan 29, 1996, 3:00:00 AM1/29/96

to

In days of yore (15 Jan 1996 16:44:40 GMT)
Ken Firestone (ke...@clark.net) proclaimed:

:I am trying to remove some substrings from a string delimited by a
:newline at its end. The string looks something like this:

:This is the string <co a substring with one or more words> and here is
:the rest of the string\n

:I am trying to get rid of the stuff between the "<co" and the ">".
:There may be several such substrings in the string, and the "<co" and
:">" should go too. Any ideas for a simple way to do this? or a
:complicated way?

This is essentially the same as "how do I remove the
HTML or SGML tags (markup) from a file"?

I'm not a perl hack (yet). Although I've answered this
question before -- in this newsgroup no less.

There are two ways I can think of to do this. One
is to try 'lynx -dump' (assuming that this actually
*is* an HTML file that you're working with). I'll
just leave you with this example and say no more
about that:

lynx -dump foo.html > foo.txt

The other way is using awk (perl fans should find this
trivial to translate -- even without a2p):

Just to change each occurence given that each tag is
contained wholly on a given line (record) would be
fairly simple. There is one little pitfall which I
will illustrate:

The pattern (regex): <.*> in awk would
unfortunately be over zealous as it would match
everthing from the beginning of the first tag
on a line to the end of the last tag. This wold
be bad in cases like:

<u>Underlined</U><b>Bold</b>

(awk uses a "maximal munch" regex globber).

So you want to use something more like this:

<[^>]+> as your regex. This pattern reads something
like: 'it starts with an open angle bracket, and
includes at least one character other than a close
angle bracket, and continues through the first close
angle bracket'

So the simple program:

awk '{ gsub(/<[^>]+>/,""); print }'

. . . does *mostly* what you want.

Something very similar to this would probably work in
perl. Also I thought I read (in the Camel or Lama book)
about some way to force perl to use "minimal" munch. I'd
appreciate a reminder from the rest of the audience.

Now about the term *mostly*

This doesn't account for situations where the open angle is
on one line (record) and the closer is on another. We might
use some odd RS value to trick awk into reading in the
whole file as a single record -- but we might also bomb out
without enough memory -- and this is inelegant in any event).

It also doesn't account for cases where the <> pattern might
appear inside of a quoted attribute like:

<FORM action="/cgi-bin/foo">
< INPUT name="<bad name>" value="<bad value>">

(NOT RECOMMENDED HTML!!!)

To get around these issue is a bit more complicated.

Just dealing with the multi-line issue isn't too bad...
you create a separate pattern where you match:

/<[^>]*$/ {
# this pattern means a tag spans to the next line
tagspans = 1
gsub ( /<[^>]*$/,"")
}

tagspans && /^[^>]*>/ {
# this pattern means I've found the end of a
# record spanning tag
tagspans = 0
gsub (/^[^>]*>/,"")
}

# I'm in a tag -- so don't print any lines until
# I find a close to this tag:
tagspans { next }

# Are original code goes here -- (protected
# from record spanning tags by the previous lines)

{ gsub( /<[^>]*>/,""); print }

This is essentially building crude "state machine" (I'm
inside of a spanned tag or I'm not).

To solve the more subtle (and less like to occur in practice)
problem you would build (code) a more sophisticated state
machine.

I won't go into that much detail here. Probably it's not
worth it to your project. The one-liner I originally
presented will probably clear over 80% of your documents --
the longer one just above will probably give reasonable
results for over 95% (conservatively).

Naturally I'm only *guessing* that you're dealing with
SGML or HTML files. In any event you may find that your
file format has some subtle quoting or syntactic/semantic
elements that your simple problem statement didn't cover.

Ultimately, if you wanted to produce a commercially viable
program to do this job (and still assuming that you aren't
talking about a truly simply file structure that has none
of the warts I've anticipated) you'd have to write a
parser -- possibly resorting to yacc/bison and lex/flex.

Again that probably isn't worth it if you're just trying to
do a simple filter and don't mind hand checking and touching
up the results.

I personally use 'lynx -dump'

If anyone feels inclined to show me the perl equivalents to
the awk I've presented -- I'll be happy to read it.

I *am* slowly learning perl -- that's why I read this
newsgroup. I just can't bear to see a simple question like
this go ignored.

:Thanks.

You're welcome.

--
/> JaDe | Star <\
/< \|/ >\
*[/////|:::====================- --*-- -=====================:::|\\\\\]*
\< /|\ >/
\> jade...@netcom.com | star...@netcom.com </

Abigail

unread,

Jan 29, 1996, 3:00:00 AM1/29/96

to

In <jadestarD...@netcom.com> jade...@netcom.com (JaDe) writes:

++ I personally use 'lynx -dump'

Note that 'lynx -dump' formats the text. This may not always be wanted.
It will also display "alt" values inside <img> tags.

++ If anyone feels inclined to show me the perl equivalents to
++ the awk I've presented -- I'll be happy to read it.

#!/usr/bin/perl -w

undef $/; # No record separator.
$document = <>; # Read in document from stdin.

$document =~ s/< # Opening bracket.
([^>'"]* | # No >, ' or "
("[^"]*") | # A section between double quotes.
('[^']*') # A section between single quotes.
)* # Repeat as often as you want.
> # Closing bracket.
//gsx; # Change it to void.
# Flags mean: g: globally
# s: single line (treat newline
# as every other
# character.
# x: extended regexp.
print $document;
exit (0);
__END__

Alternatively, a oneliner which changes the file(s):

perl -pi -0777 -w -e 's/<([^>'"]*|("[^"]*")|('[^']*'))*>//gs;' file1 file2 ...

Note that the programs won't deal with <! correctly.

Abigail

Julian Bean

unread,

Feb 1, 1996, 3:00:00 AM2/1/96

to

In article <jadestarD...@netcom.com> jade...@netcom.com (JaDe) writes:
>
>In days of yore (15 Jan 1996 16:44:40 GMT)
>Ken Firestone (ke...@clark.net) proclaimed:
>
>:I am trying to remove some substrings from a string delimited by a
>:newline at its end. The string looks something like this:
>
>:This is the string <co a substring with one or more words> and here is
>:the rest of the string\n
>
>:I am trying to get rid of the stuff between the "<co" and the ">".
>:There may be several such substrings in the string, and the "<co" and
>:">" should go too. Any ideas for a simple way to do this? or a
>:complicated way?
>

[jadestar's clever but rather long discussion deleted]

I would have said:

$string =~ s/<co[^>]*>//g;

I.e. delete all substring of the form <co[anything except a '>']>

Jules

Tom Christiansen

unread,

Feb 2, 1996, 3:00:00 AM2/2/96

to

[courtesy cc of this posting sent to cited author et al. via email]

In comp.lang.perl.misc, abi...@mars.ic.iaf.nl (Abigail) writ:

[perl code to remove html tags...]

:#!/usr/bin/perl -w

:undef $/; # No record separator.
:$document = <>; # Read in document from stdin.
:
:$document =~ s/< # Opening bracket.
: ([^>'"]* | # No >, ' or "
: ("[^"]*") | # A section between double quotes.
: ('[^']*') # A section between single quotes.
: )* # Repeat as often as you want.
: > # Closing bracket.
: //gsx; # Change it to void.
: # Flags mean: g: globally
: # s: single line (treat newline
: # as every other
: # character.
: # x: extended regexp.
:print $document;
:exit (0);
:__END__

That one says to me: "matches null string many times at /tmp/b line 12.".
That's due to the nested stars. I guess I can live with that.

This version here, however, shaves 15-25% off the run-time and is
potentially more legible, although it still has the nested (a*)* problem.
The speed-up is probably mostly due to using (?:...) for group that
doesn't cause a backreferences. It might also be the stingy matching.

#!/usr/bin/perl -0777 -p
s{ < # Opening angle bracket.
(?: [^>'"]* # No >, ' or "
| ".*?" # A section between double quotes.
| '.*?' # A section between single quotes.
)+ # Repeat as often as you want.
> # Closing angle bracket.
}{}gsx; # Change it to void.

:Alternatively, a oneliner which changes the file(s):

:
:perl -pi -0777 -w -e 's/<([^>'"]*|("[^"]*")|('[^']*'))*>//gs;' file1 file2 ...

Your one-liner, even if you do manage to get if through the shell, does
tend to dump core. Probably all the nested stars blowing your stack.

Note that comments aside, it also doesn't deal with entities, which is
problematic. Given an appropriate definition of %entity, this will do
nearly do it:

s/&(\w+);?/$entity{$1}/g;

:Note that the programs won't deal with <! correctly.

I'm not sure what you want mean by correctly. Since the goal is to
expunge the tags from the source and comments are just tags, to get rid of
the comments and other "interesting" backup markup tags, like <!DOCTYPE>.
this should be good enough:

s/<!.*?>//gs;

Ah, I see now. This ISN'T good enough: You might have markup tags nested
within the comment and the embedded markup might improperly terminate the
comment. Assuming that comments may not nidificate, a more proper comment
parser might go something like

s/<!(--.*?--\s*)*>//s;

If you'd actually like to pull out the comments, here's
something that does that:

#!/usr/bin/perl -n0777
$little = $big = 0;
while ( m{<!((?:--.*?--\s*)*)>}gs ) {
$big++;
unless (length ($comment = $1)) {
printf "Comment $big/0: <<BLANK>>\n";
next;
}
$little = 0;
while ( $comment =~ s/\s*--\s*(.*?)\s*--\s*//s ) {
printf "Comment %d/%d: %s\n", $big, ++$little, $1;
}
}
__END__
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<HEAD>
<TITLE>HTML Comment Example</TITLE>


<!>
</HEAD>
<BODY>
<p> <!- not a comment, just regular old data characters ->

Anyway, here's my striphtml program.

--tom

#!/usr/bin/perl -p0777
#
#########################################################
# striphtml ("striff tummel")
# tch...@perl.com
# version 1.0; Thu 01 Feb 1996 1:53:31pm MST
#########################################################
#
# how to strip out html comments and tags and transform
# entities in just three -- count 'em three -- substitutions;
# sed and awk eat your heart out. :-)
#
# as always, translations from this nacré rendition into
# more characteristically marine, herpetoid, titillative,
# or indonesian idioms are welcome for the furthering of
# comparitive cyberlinguistic studies.
#
#########################################################

require 5.001; # for nifty embedded regexp comments

#########################################################
# first we'll shoot all the 
#########################################################

s{ <! # comments begin with a `<!'
# followed by 0 or more comments;
( # not suppose to have any white space here
# just a quick start;
-- # each comment starts with a `--'
.*? # and includes all text up to and including
-- # the *next* occurrence of `--'
\s* # and may have trailing while space
# (albeit not leading white space XXX)
)* # repetire ad libitum
> # up to a `>'
}{}gsx; # mutate into nada, nothing, and niente

#########################################################
# next we'll remove all the <tags>
#########################################################

s{ < # opening angle bracket

(?: # Non-backreffing grouping paren
[^>'"] * # 0 or more things that are neither > nor ' nor "
| # or else
".*?" # a section between double quotes (stingy match)
| # or else
'.*?' # a section between single quotes (stingy match)
) + # repetire ad libitum
# hm.... are null tags <> legal? XXX
> # closing angle bracket
}{}gsx; # mutate into nada, nothing, and niente

#########################################################
# finally we'll translate all &valid; HTML 2.0 entities
#########################################################

s{ (
& # an entity starts with a semicolon
( \w+ ) # and has alphanumunders up to a semi
;? # a semi terminates AS DOES ANYTHING ELSE (XXX)
)
} {

$entity{$2} # if it's a known entity use that
|| # but otherwise
$1 # leave what we'd found; NO WARNINGS (XXX)

}gex; # execute replacement -- that's code not a string

#########################################################
# but wait! load up the %entity mappings enwrapped in
# a BEGIN that the last might be first, and only execute
# once, since we're in a -p "loop"; awk is kinda nice after all.
#########################################################

BEGIN {

%entity = (

lt => '<', #a less-than
gt => '>', #a greater-than
amp => '&', #a nampersand
quot => '"', #a (verticle) double-quote

nbsp => chr 160, #no-break space
iexcl => chr 161, #inverted exclamation mark
cent => chr 162, #cent sign
pound => chr 163, #pound sterling sign CURRENCY NOT WEIGHT
curren => chr 164, #general currency sign
yen => chr 165, #yen sign
brvbar => chr 166, #broken (vertical) bar
sect => chr 167, #section sign
uml => chr 168, #umlaut (dieresis)
copy => chr 169, #copyright sign
ordf => chr 170, #ordinal indicator, feminine
laquo => chr 171, #angle quotation mark, left
not => chr 172, #not sign
shy => chr 173, #soft hyphen
reg => chr 174, #registered sign
macr => chr 175, #macron
deg => chr 176, #degree sign
plusmn => chr 177, #plus-or-minus sign
sup2 => chr 178, #superscript two
sup3 => chr 179, #superscript three
acute => chr 180, #acute accent
micro => chr 181, #micro sign
para => chr 182, #pilcrow (paragraph sign)
middot => chr 183, #middle dot
cedil => chr 184, #cedilla
sup1 => chr 185, #superscript one
ordm => chr 186, #ordinal indicator, masculine
raquo => chr 187, #angle quotation mark, right
frac14 => chr 188, #fraction one-quarter
frac12 => chr 189, #fraction one-half
frac34 => chr 190, #fraction three-quarters
iquest => chr 191, #inverted question mark
Agrave => chr 192, #capital A, grave accent
Aacute => chr 193, #capital A, acute accent
Acirc => chr 194, #capital A, circumflex accent
Atilde => chr 195, #capital A, tilde
Auml => chr 196, #capital A, dieresis or umlaut mark
Aring => chr 197, #capital A, ring
AElig => chr 198, #capital AE diphthong (ligature)
Ccedil => chr 199, #capital C, cedilla
Egrave => chr 200, #capital E, grave accent
Eacute => chr 201, #capital E, acute accent
Ecirc => chr 202, #capital E, circumflex accent
Euml => chr 203, #capital E, dieresis or umlaut mark
Igrave => chr 204, #capital I, grave accent
Iacute => chr 205, #capital I, acute accent
Icirc => chr 206, #capital I, circumflex accent
Iuml => chr 207, #capital I, dieresis or umlaut mark
ETH => chr 208, #capital Eth, Icelandic
Ntilde => chr 209, #capital N, tilde
Ograve => chr 210, #capital O, grave accent
Oacute => chr 211, #capital O, acute accent
Ocirc => chr 212, #capital O, circumflex accent
Otilde => chr 213, #capital O, tilde
Ouml => chr 214, #capital O, dieresis or umlaut mark
times => chr 215, #multiply sign
Oslash => chr 216, #capital O, slash
Ugrave => chr 217, #capital U, grave accent
Uacute => chr 218, #capital U, acute accent
Ucirc => chr 219, #capital U, circumflex accent
Uuml => chr 220, #capital U, dieresis or umlaut mark
Yacute => chr 221, #capital Y, acute accent
THORN => chr 222, #capital THORN, Icelandic
szlig => chr 223, #small sharp s, German (sz ligature)
agrave => chr 224, #small a, grave accent
aacute => chr 225, #small a, acute accent
acirc => chr 226, #small a, circumflex accent
atilde => chr 227, #small a, tilde
auml => chr 228, #small a, dieresis or umlaut mark
aring => chr 229, #small a, ring
aelig => chr 230, #small ae diphthong (ligature)
ccedil => chr 231, #small c, cedilla
egrave => chr 232, #small e, grave accent
eacute => chr 233, #small e, acute accent
ecirc => chr 234, #small e, circumflex accent
euml => chr 235, #small e, dieresis or umlaut mark
igrave => chr 236, #small i, grave accent
iacute => chr 237, #small i, acute accent
icirc => chr 238, #small i, circumflex accent
iuml => chr 239, #small i, dieresis or umlaut mark
eth => chr 240, #small eth, Icelandic
ntilde => chr 241, #small n, tilde
ograve => chr 242, #small o, grave accent
oacute => chr 243, #small o, acute accent
ocirc => chr 244, #small o, circumflex accent
otilde => chr 245, #small o, tilde
ouml => chr 246, #small o, dieresis or umlaut mark
divide => chr 247, #divide sign
oslash => chr 248, #small o, slash
ugrave => chr 249, #small u, grave accent
uacute => chr 250, #small u, acute accent
ucirc => chr 251, #small u, circumflex accent
uuml => chr 252, #small u, dieresis or umlaut mark
yacute => chr 253, #small y, acute accent
thorn => chr 254, #small thorn, Icelandic
yuml => chr 255, #small y, dieresis or umlaut mark
);

####################################################
# now fill in all the numbers to match themselves
####################################################
for $chr ( 0 .. 255 ) {
$entity{ '#' . $chr } = ord $chr;
}
}

#########################################################
# premature finish lest someone clip my signature
#########################################################

__END__

--
Tom Christiansen Perl Consultant, Gamer, Hiker tch...@mox.perl.com
If you happen to be one of the fretful minority who can do creative work,
never force an idea; you'll abort it if you do. Be patient and you'll give
birth to it when the time is ripe. Learn to wait. --Lazarus Long