Category: |
Utility Scripts |
Author/Contact Info |
Miguel D Velez |
Description: |
Simple PERL/TK program that reads from a textbox input lines that have a url at the begging and converts the urls into actual link files (with the name of url's domain). I did it because I had a file with a bunch of urls that I wanted to put in my "Favorite" folder. Any comments are welcome. |
#!/usr/bin/perl
#Url2Link v0.1 coded by Miguel D Velez <migueldvelez@msn.com>
use Tk;
my $mw = new MainWindow;
my $f = $mw->Frame->pack(-fill=>'x');
$mw->title( "Url2Link v0.1" );
$mw->geometry('+100+300');
$f->Label(-text=>'Url2Link v0.1') ->pack();
$f->Label(-text=>'by Miguel D Velez') ->pack();
my $report_variable = "Type in a list of URLs and press \"Process\" bu
+tton to beging.";
my $l = $mw->Frame->pack(-side=>bottom, -fill=>x, -ipadx=>10, -ipady=>
+3);
$l->Label(-textvariable=>\$report_variable, -relief=>groove) ->pack(-f
+ill=>both, -ipady=>3);
my $b = $mw->Frame->pack(-side=>bottom, -fill=>'x', -pady=>5);
$b->Button(
-text=>"Exit",
-relief=>groove,
-command=> sub { exit } ) ->pack(-side=>bottom, -fill=>x, -ipadx=>10,
+-ipady=>3);
$b->Button(
-text=>"Process",
-relief=>groove,
-command=> sub { &process } ) ->pack(-side=>bottom, -fill=>x, -ipadx=>
+10, -ipady=>3);
my $t = $mw->Frame->pack(-padx=>5);
my $txt_body = $t->Scrolled(Text,
-scrollbars=>e,
-background=>white,
-relief=>groove,
-width=>50,
-height=>15,
-wrap=>'word') ->pack();
MainLoop;
sub process {
my @url_list = split /\s+/, $txt_body->get("1.0", "end");
my $count = 0;
if (@url_list) {
my $mkdir = mkdir "Links";
if (! $mkdir) {
$report_variable = "Could not create \"Links\" folder in current direc
+tory. $!.";
} else {
$report_variable = "\"Links\" folder created.";
}
my $chdir = chdir "Links";
if (! $chdir) {
$report_variable = "Could not access \"Links\" folder in current direc
+tory. $!.";
}
foreach(@url_list) {
if ($_ =~ /^(http|https|ftp|ftps|w).+\.([a-zA-Z0-9_-]+)\..+/) {
open FILEOUT, "> \u$2.url";
print FILEOUT '[DEFAULT]'."\n";
print FILEOUT "BASEURL=$_"."\n";
print FILEOUT '[InternetShortcut]'."\n";
print FILEOUT "URL=$_"."\n";
print FILEOUT 'Modified=0'."\n";
close(FILEOUT);
++$count
} }
chdir "..";
$txt_body->delete( "1.0", "end" );
$report_variable = "Converted $count URLs to link files. Please check
+the \"Link\" folder.";
} else {
$report_variable = "User input is empty. Please type at least one URL
+in textbox.";
} }
|
Re: url2link
by PodMaster (Abbot) on Jan 12, 2003 at 10:58 UTC
|
Have you seen URI::Find? It's nice.
MJD says you
can't just make shit up and expect the computer to know what you mean, retardo!
** The Third rule of perl club is a statement of fact: pod is sexy.
|
| [reply] |
(jeffa) Re: url2link
by jeffa (Bishop) on Jan 12, 2003 at 20:11 UTC
|
Thank you for contributing code, but it's not very Perl-ish.
Let's make some changes, eh? (And what is up with multiple
closing braces on the last line --- did you not a receive a
syntax error like i did?)
First, your check for the "Links" directory is a bit
awkward, we shouldn't have to bail if the directory
already exists:
my $dir = 'Links';
if (-d $dir) {
chdir $dir or die "can't chdir: $!";
}
else {
mkdir $dir or die "can't mkdir: $!";
}
but why even do that? All you need to do is create the
dir if id doesn't exist, and then use that dir name when
you write to files. This prevents having to chdir
(something i try to avoid). Next, why waste RAM with an
array when you loop on the file handle?
open FILEIN, "urls.txt" or die "Could not open file $!";
while(<FILEIN>) {
chomp;
...
}
As you will see in a little while however, my version will
need to 'slurp' the the whole file into a scalar. Also,
this code screams out to me "Use a Getopt
module!!", but i'll leave that as an exercise. ;)
Next, pull in the URI::Find,
Config::IniHash and File::Basename CPAN
modules to ease our burden. At this point, however, the
skeleton of your script changes, so here is my version
complete:
use strict;
use warnings;
use URI::Find;
use Config::IniHash;
use File::Basename;
use vars qw( @FOUND );
my $dir = 'Links';
my $file = 'urls.txt';
unless (-d $dir) {
mkdir $dir or die "can't mkdir: $!";
}
open FILEIN, $file or die "can't open $file: $!";
my $urls = do {local $/; <FILEIN>};
my $finder = URI::Find->new(\&found);
$finder->find(\$urls);
for (@FOUND) {
my $hash = {
DEFAULT => { BASEURL => $_ },
InternetShortcut => { URL => $_, Modified => 0 },
};
my $file = basename($_,'.*');
$file =~ s/(\.\w+)+/\.url/;
WriteINI("$dir/\u$file", $hash);
}
sub found {
my($uri, $orig_uri) = @_;
push @FOUND,$orig_uri;
}
jeffa
L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)
| [reply] [d/l] [select] |
|
The basename + substitution business doesn't seem to make any sense. The doc says basename quotes any metacharacters in the suffix(es), so that line is looking for a literal dot star at the end of the filename - rather unlikely, even if we have a URL to begin with. The substitution will replace the first repeated sequence of one dot followed by any number of word characters by .url (whose dot needs no quoting since it's on the right hand side of the substitution anyway). That sequence does not necessarily have to be what terminates the string. Taking a ponderous guess at the purpose of the hooha, I bid URI.
And for some more Perlishness, use the diamond operator instead of explicitly opening a file. With lots fewer temporaries:
use strict;
use warnings;
use URI;
use URI::Find;
use Config::IniHash;
use File::Basename;
use File::Spec::Functions qw(catfile);
my $dir = 'Links';
unless (-d $dir) {
mkdir $dir or die "can't mkdir($dir): $!";
}
URI::Find->new(\do {local $/; <> })->find(sub {
my($uri, $orig_uri) = @_;
WriteINI(catfile($dir, uc URI->new($uri)->host), {
DEFAULT => { BASEURL => $uri },
InternetShortcut => { URL => $uri, Modified => 0 },
});
});
Makeshifts last the longest. | [reply] [d/l] |
|
| [reply] |
|
|
|
Thank you for the comments and suggestions, however I was already starting to work on a similar version that uses the TK module. I would look to your code carefully to examined it in more details later. Thank you.
| [reply] |
Re: url2link
by m_dv (Initiate) on Jan 12, 2003 at 05:28 UTC
|
| [reply] |
|
|