home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 Mobile / Chip_Mobile_2001.iso / palm / tools / remoteco / remoteco.exe / clipboard.pl < prev    next >
Encoding:
Perl Script  |  1999-03-11  |  3.1 KB  |  123 lines
  1. #!/usr/local/bin/perl
  2.  
  3. open (IN, "<$ARGV[0]") || die ("Can't open input file '$ARGV[0]'\n");
  4. open (OUT, ">$ARGV[1]") || die ("Can't open output file '$ARGV[1]'\n");
  5.  
  6. # Parse the HTML clipboard format used by IE 4.0
  7. # Set $url = URL of page (overriden by BASE element if it exists)
  8. #     $fragment = selected part of the HTML
  9. while (<IN>) {
  10.    /SourceURL:([^\r\n]+)/ && ($source_url = $1);
  11.    /<[Bb][Aa][Ss][Ee]\s+[^>]+[Hh][Rr][Ee][Ff]="?([^">]+)"?>"/ && ($base_url=$1);
  12.  
  13.    
  14.    if (m@<[Tt][Ii][Tt][Ll][Ee]>(.*)</[Tt][Ii][Tt][Ll][Ee]>@) {
  15.      $title = $1;
  16.    } elsif (m@<[Tt][Ii][Tt][Ll][Ee]>@) {
  17.      $title = $';
  18.      $intitle = 1;
  19.    } elsif (m@</[Tt][Ii][Tt][Ll][Ee]>@) {
  20.      $title .= $`;
  21.      $intitle = 0;
  22.    } else {
  23.      $title .= $_ if ($intitle);
  24.    }
  25.  
  26.  
  27.    if (/<!--StartFragment-->(.*)<!--EndFragment-->/) {
  28.      $fragment = $1;
  29.    } elsif (/<!--StartFragment-->/) {
  30.      $fragment = $';
  31.      $infrag = 1;
  32.    } elsif (/<!--EndFragment-->/) {
  33.      $fragment .= $`;
  34.      $infrag = 0;
  35.    } else {
  36.      $fragment .= $_ if ($infrag);
  37.    }
  38. }
  39.  
  40. $base_url = $source_url unless (defined ($base_url));
  41.  
  42. # Print source as title/URL pair
  43. $title = $source_url unless (defined ($title));
  44. $title = &cleanup ($title);
  45. print OUT "From: $title\n$source_url\n";
  46.  
  47. #print STDERR "url = $url\n";
  48. #print STDERR "fragment = $fragment\n";
  49.  
  50. $_ = $fragment;
  51.  
  52.  
  53. # Loop through all links of the form <A>...</A>
  54. while (m@<[Aa]\W[^>]*[Hh][Rr][Ee][Ff]="?([^">]+)"?[^>]*>(([^<]|<[^/]|</[^Aa]|</[Aa][^>])*)</[Aa]>@) {
  55.  
  56.     $_ = $';        # Next iteration of loop starts after this match
  57.  
  58.     # Convert link to an absolute URL
  59.     $href = &relative ($base_url, $1);
  60.  
  61.     # Clean up link text (between <A> and </A>)
  62.     $text = &cleanup ($2, $href);
  63.  
  64.     # Print the text/URL pair
  65.     print OUT "$text\n$href\n";
  66. }
  67.  
  68.  
  69. # Convert $href (relative to $base) into an absolute URL
  70. sub relative {
  71.     local ($base, $href) = @_;
  72.  
  73.     if ($href =~ /^http:|^ftp:|^file:|^mailto:|^gopher:|^https:/) {
  74.         # Absolute reference
  75.         return $href;
  76.     } elsif ($href =~ m@^/@) {
  77.         # Global reference to same host
  78.         $base =~ m@^[^/\\]*[/\\]+[^/\\]*/@;
  79.         return $& . substr ($href, 1);
  80.     } else {
  81.         # Local reference to same directory
  82.         $base =~ m@[^/\\]*$@;
  83.         return $` . $href;
  84.     }
  85. }
  86.  
  87. # Clean up text
  88. sub cleanup {
  89.     local ($_, $url) = @_;
  90.     local ($original) = $_;
  91.  
  92.     # Strip out all tags except <A> and </A>
  93.     s@<[Bb][Rr]>@ @g;
  94.     s@</?[^>]*>@@g;
  95.  
  96.     if (!/\w/) {
  97.         # if no text left, it's probably an image.  Try to find an ALT tag.
  98.         if ($original =~ m@<[Ii][Mm][Gg][^>]*[Aa][Ll][Tt]="([^"]+)"[^>]*>@        # double-quoted ALT attribute
  99.             || $original =~ m@<[Ii][Mm][Gg][^>]*[Aa][Ll][Tt]='([^']+)'[^>]*>@    # single-quoted ALT attribute
  100.             || $original =~ m@<[Ii][Mm][Gg][^>]*[Aa][Ll][Tt]=([^ >]+)[^>]*>@    # unquoted ALT attribute
  101.             ) {
  102.             $_ = "Image [$1]";
  103.         } else {
  104.             $_ = "Image [$href]";
  105.         }
  106.     }
  107.  
  108.     # Replace common entities
  109.     s@"@\"@g;
  110.     s@&@&@g;
  111.     s@<@<@g;
  112.     s@>@>@g;
  113.     s@ @ @g;
  114.  
  115.     # Delete weird chars inserted by IE4
  116.     tr/\xC2\xA0/ /;    
  117.  
  118.     # Compress whitespace
  119.     tr/ \t\r\n/ /s;    
  120.  
  121.     return $_;
  122. }
  123.