Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

shmem's scratchpad

by shmem (Canon)
on Mar 09, 2006 at 10:35 UTC ( #535366=scratchpad: print w/ replies, xml ) Need Help??

For Lady_Aleena - well, didn't know about choroba's scratchpad which contains the same stuff with minimal style changes
use strict; use warnings; my $element = pop; # 'something'; my @attributes; my %eq = ( script => ['defer'], label => ['for'], area => ['nohref'], head => ['profile'], option => ['selected'], param => ['valuetype'], table => ['border','cellpadding','cellspacing','frame','rules', +'summary'], object => ['archive','classid','codebase','codetype','data','dec +lare','standby'], select => ['multiple'], input => ['checked','maxlength'], frame => ['noresize'], a => [qw(onblur onfocus )], label => [qw(onblur onfocus )], area => [qw(onblur onfocus )], button => [qw(onblur onfocus )], select => [qw(onblur onfocus onchange multiple size + )], input => [qw(onblur onfocus onchange size onselect rea +donly checked maxlength )], textarea => [qw(onblur onfocus onchange onselect rea +donly )], iframe => ['frameborder','longdesc','marginheight','marginwidth' +,'scrolling'], frame => ['frameborder','longdesc','marginheight','marginwidth' +,'scrolling','noresize'], ); my %matches = ( '(?:meta)' => ['content' +,'http-equiv','scheme'], '^(?:body|frameset)$' => ['onload', +'onunload'], '^(?:a|area)$' => ['coords', +'shape'], '^(?:a|link)$' => ['hreflang +','rel','rev'], '(?:a|area|base|link)' => ['href'], '(?:a|area|base|link|form)' => ['target'] +, '(?:a|area|button|input|label|legend|textarea)' => ['accesske +y'], '(?:a|area|button|input|object|select|textarea)' => ['tabindex +'], '(?:a|link|script)' => ['charset' +], '(?:a|link|button|input|object|param|script|style)' => ['type'], '^(?:del|ins)$' => ['cite','d +atetime'], '^(?:col|colgroup|tbody|td|tfoot|th|thead|tr)$' => ['align',' +char','charoff','valign'], '^(?:td|th)$' => ['abbr','a +xis','colspan','headers','rowspan','scope'], '(?:col|colgroup)' => ['span'], '^(?:input|select)$' => ['size'], '^(?:form|input)$' => ['accept'] +, '^(?:image|area|input)$' => ['alt'], '^(?:button|input|optgroup|option|select|textarea)$' => ['disabled +'], '^(?:iframe|img|object)$' => ['height'] +, '^(?:img|input)$' => ['ismap'], '^(?:option|optgroup:)$' => ['label'], '^(?:style|link|form)$' => ['media'], '^(?:a|button|form|frame|iframe|img|input|object|map|param|meta|se +lect|textarea)$' => ['name'], '^(?:input|frame|iframe|img|script)$' => ['src'], '^(?:img|input|object)$' => ['usemap'] +, '^(?:input|option|param|button|li)$' => ['value'], '^(?:iframe|img|object|table|col|colgroup)$' => ['width'], ); my %non_matches = ( '^(?:base|basefont|head|html|meta|param|script|title|style)$' + => ['class','style'], '^(?:applet|base|basefont|bdo|br|frame|iframe|frameset|param|scrip +t)$' => ['dir'], '^(?:base|head|html|meta|script|style|title)$' + => ['id'], '^(?:applet|base|basefont|br|frame|frameset|iframe|param|script)$' + => ['lang'], '^(?:base|basefont|head|html|meta|param|script|title)$' + => ['title'], '^(?:applet|base|basefont|bdo|br|font|frame|frameset|head|html|ifr +ame|isindex|meta|param|script|style|title)$' => ['onclick','ondblclick','onkeydown','onkeypress','onkeyup', +'onmousedown', 'onmousemove','onmouseout','onmouseover','onmouseup' ], ); push @attributes, @{$eq{$element}} if exists $eq{$element}; $element =~ qr{$_} and push @attributes, @{$matches{$_}} for keys %mat +ches; $element !~ qr{$_} and push @attributes, @{$non_matches{$_}} for keys +%non_matches; print join("\n",sort @attributes);

foo.pl

#!/usr/bin/perl use strict; my $pat = shift; my $p; { my (%s, %i); my $d = my $c = 1; # our regexp will be inside parens, so first back +ref is 2 $p = join ( "", map { if($s{$_}++){ "\\".$i{$_} } else{ $i{$_}=++$c; $c>$d+1 ? '(?!'.join('|',map{"\\".abs}-$c+1..-$d-1).")(\\w)" : + "(\\w)"; } } split//,$pat ); } print '(',$p,")\n"; open my $fh, '<', shift; my %s; while (<$fh>) { my @l = (); while (/\b($p)\b/g) { push @l, $1 unless $s{$1}++; } print join (", ",@l), $/ if @l; }

try: perl foo.pl fusselkerl /usr/share/dict/words

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (15)
As of 2014-04-17 14:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (449 votes), past polls