source: gsdl/trunk/perllib/util.pm@ 14364

Last change on this file since 14364 was 14364, checked in by qq6, 17 years ago

delete require Win32::Hardlink
  • Property svn:keywords set to Author Date Id Revision
File size: 20.0 KB
Line 
1###########################################################################
2#
3# util.pm -- various useful utilities
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package util;
27
28BEGIN {
29 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
30 die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
31 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
32 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
33}
34use File::Copy;
35use File::Basename;
36
37# removes files (but not directories)
38sub rm {
39 my (@files) = @_;
40 my @filefiles = ();
41
42 # make sure the files we want to delete exist
43 # and are regular files
44 foreach my $file (@files) {
45 if (!-e $file) {
46 print STDERR "util::rm $file does not exist\n";
47 } elsif ((!-f $file) && (!-l $file)) {
48 print STDERR "util::rm $file is not a regular (or symbolic) file\n";
49 } else {
50 push (@filefiles, $file);
51 }
52 }
53
54 # remove the files
55 my $numremoved = unlink @filefiles;
56
57 # check to make sure all of them were removed
58 if ($numremoved != scalar(@filefiles)) {
59 print STDERR "util::rm Not all files were removed\n";
60 }
61}
62
63
64
65# recursive removal
66sub filtered_rm_r {
67 my ($files,$file_accept_re,$file_reject_re) = @_;
68
69 my @files_array = (ref $files eq "ARRAY") ? @$files : ($files);
70
71 # recursively remove the files
72 foreach my $file (@files_array) {
73 $file =~ s/[\/\\]+$//; # remove trailing slashes
74
75 if (!-e $file) {
76 print STDERR "util::filtered_rm_r $file does not exist\n";
77
78 } elsif ((-d $file) && (!-l $file)) { # don't recurse down symbolic link
79 # get the contents of this directory
80 if (!opendir (INDIR, $file)) {
81 print STDERR "util::filtered_rm_r could not open directory $file\n";
82 } else {
83 my @filedir = grep (!/^\.\.?$/, readdir (INDIR));
84 closedir (INDIR);
85
86 # remove all the files in this directory
87 map {$_="$file/$_";} @filedir;
88 &filtered_rm_r (\@filedir,$file_accept_re,$file_reject_re);
89
90 if (!defined $file_accept_re && !defined $file_reject_re) {
91 # remove this directory
92 if (!rmdir $file) {
93 print STDERR "util::filtered_rm_r couldn't remove directory $file\n";
94 }
95 }
96 }
97 } else {
98 next if (defined $file_reject_re && ($file =~ m/$file_reject_re/));
99
100 if ((!defined $file_accept_re) || ($file =~ m/$file_accept_re/)) {
101 # remove this file
102 &rm ($file);
103 }
104 }
105 }
106}
107
108
109# recursive removal
110sub rm_r {
111 my (@files) = @_;
112
113 # use the more general (but reterospectively written function
114 # filtered_rm_r function()
115
116 filtered_rm_r(\@files,undef,undef); # no accept or reject expressions
117}
118
119
120
121
122# moves a file or a group of files
123sub mv {
124 my $dest = pop (@_);
125 my (@srcfiles) = @_;
126
127 # remove trailing slashes from source and destination files
128 $dest =~ s/[\\\/]+$//;
129 map {$_ =~ s/[\\\/]+$//;} @srcfiles;
130
131 # a few sanity checks
132 if (scalar (@srcfiles) == 0) {
133 print STDERR "util::mv no destination directory given\n";
134 return;
135 } elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) {
136 print STDERR "util::mv if multiple source files are given the ".
137 "destination must be a directory\n";
138 return;
139 }
140
141 # move the files
142 foreach my $file (@srcfiles) {
143 my $tempdest = $dest;
144 if (-d $tempdest) {
145 my ($filename) = $file =~ /([^\\\/]+)$/;
146 $tempdest .= "/$filename";
147 }
148 if (!-e $file) {
149 print STDERR "util::mv $file does not exist\n";
150 } else {
151 rename ($file, $tempdest);
152 }
153 }
154}
155
156
157# copies a file or a group of files
158sub cp {
159 my $dest = pop (@_);
160 my (@srcfiles) = @_;
161
162 # remove trailing slashes from source and destination files
163 $dest =~ s/[\\\/]+$//;
164 map {$_ =~ s/[\\\/]+$//;} @srcfiles;
165
166 # a few sanity checks
167 if (scalar (@srcfiles) == 0) {
168 print STDERR "util::cp no destination directory given\n";
169 return;
170 } elsif ((scalar (@srcfiles) > 1) && (!-d $dest)) {
171 print STDERR "util::cp if multiple source files are given the ".
172 "destination must be a directory\n";
173 return;
174 }
175
176 # copy the files
177 foreach my $file (@srcfiles) {
178 my $tempdest = $dest;
179 if (-d $tempdest) {
180 my ($filename) = $file =~ /([^\\\/]+)$/;
181 $tempdest .= "/$filename";
182 }
183 if (!-e $file) {
184 print STDERR "util::cp $file does not exist\n";
185 } elsif (!-f $file) {
186 print STDERR "util::cp $file is not a plain file\n";
187 } else {
188 &File::Copy::copy ($file, $tempdest);
189 }
190 }
191}
192
193
194
195# recursively copies a file or group of files
196# syntax: cp_r (sourcefiles, destination directory)
197# destination must be a directory - to copy one file to
198# another use cp instead
199sub cp_r {
200 my $dest = pop (@_);
201 my (@srcfiles) = @_;
202
203 # a few sanity checks
204 if (scalar (@srcfiles) == 0) {
205 print STDERR "util::cp_r no destination directory given\n";
206 return;
207 } elsif (-f $dest) {
208 print STDERR "util::cp_r destination must be a directory\n";
209 return;
210 }
211
212 # create destination directory if it doesn't exist already
213 if (! -d $dest) {
214 my $store_umask = umask(0002);
215 mkdir ($dest, 0777);
216 umask($store_umask);
217 }
218
219 # copy the files
220 foreach my $file (@srcfiles) {
221
222 if (!-e $file) {
223 print STDERR "util::cp_r $file does not exist\n";
224
225 } elsif (-d $file) {
226 # make the new directory
227 my ($filename) = $file =~ /([^\\\/]*)$/;
228 $dest = &util::filename_cat ($dest, $filename);
229 my $store_umask = umask(0002);
230 mkdir ($dest, 0777);
231 umask($store_umask);
232
233 # get the contents of this directory
234 if (!opendir (INDIR, $file)) {
235 print STDERR "util::cp_r could not open directory $file\n";
236 } else {
237 my @filedir = readdir (INDIR);
238 closedir (INDIR);
239 foreach my $f (@filedir) {
240 next if $f =~ /^\.\.?$/;
241 # copy all the files in this directory
242 my $ff = &util::filename_cat ($file, $f);
243 &cp_r ($ff, $dest);
244 }
245 }
246
247 } else {
248 &cp($file, $dest);
249 }
250 }
251}
252
253# copies a directory and its contents, excluding subdirectories, into a new directory
254sub cp_r_toplevel {
255 my $dest = pop (@_);
256 my (@srcfiles) = @_;
257
258 # a few sanity checks
259 if (scalar (@srcfiles) == 0) {
260 print STDERR "util::cp_r no destination directory given\n";
261 return;
262 } elsif (-f $dest) {
263 print STDERR "util::cp_r destination must be a directory\n";
264 return;
265 }
266
267 # create destination directory if it doesn't exist already
268 if (! -d $dest) {
269 my $store_umask = umask(0002);
270 mkdir ($dest, 0777);
271 umask($store_umask);
272 }
273
274 # copy the files
275 foreach my $file (@srcfiles) {
276
277 if (!-e $file) {
278 print STDERR "util::cp_r $file does not exist\n";
279
280 } elsif (-d $file) {
281 # make the new directory
282 my ($filename) = $file =~ /([^\\\/]*)$/;
283 $dest = &util::filename_cat ($dest, $filename);
284 my $store_umask = umask(0002);
285 mkdir ($dest, 0777);
286 umask($store_umask);
287
288 # get the contents of this directory
289 if (!opendir (INDIR, $file)) {
290 print STDERR "util::cp_r could not open directory $file\n";
291 } else {
292 my @filedir = readdir (INDIR);
293 closedir (INDIR);
294 foreach my $f (@filedir) {
295 next if $f =~ /^\.\.?$/;
296
297 # copy all the files in this directory, but not directories
298 my $ff = &util::filename_cat ($file, $f);
299 if (-f $ff) {
300 &cp($ff, $dest);
301 #&cp_r ($ff, $dest);
302 }
303 }
304 }
305
306 } else {
307 &cp($file, $dest);
308 }
309 }
310}
311
312sub mk_dir {
313 my ($dir) = @_;
314
315 my $store_umask = umask(0002);
316 my $mkdir_ok = mkdir ($dir, 0777);
317 umask($store_umask);
318
319 if (!$mkdir_ok)
320 {
321 print STDERR "util::mk_dir could not create directory $dir\n";
322 return;
323 }
324}
325
326# in case anyone cares - I did some testing (using perls Benchmark module)
327# on this subroutine against File::Path::mkpath (). mk_all_dir() is apparently
328# slightly faster (surprisingly) - Stefan.
329sub mk_all_dir {
330 my ($dir) = @_;
331
332 # use / for the directory separator, remove duplicate and
333 # trailing slashes
334 $dir=~s/[\\\/]+/\//g;
335 $dir=~s/[\\\/]+$//;
336
337 # make sure the cache directory exists
338 my $dirsofar = "";
339 my $first = 1;
340 foreach my $dirname (split ("/", $dir)) {
341 $dirsofar .= "/" unless $first;
342 $first = 0;
343
344 $dirsofar .= $dirname;
345
346 next if $dirname =~ /^(|[a-z]:)$/i;
347 if (!-e $dirsofar)
348 {
349 my $store_umask = umask(0002);
350 my $mkdir_ok = mkdir ($dirsofar, 0777);
351 umask($store_umask);
352 if (!$mkdir_ok)
353 {
354 print STDERR "util::mk_all_dir could not create directory $dirsofar\n";
355 return;
356 }
357 }
358 }
359}
360
361# make hard link to file if supported by OS, otherwise copy the file
362sub hard_link {
363 my ($src, $dest) = @_;
364
365 # remove trailing slashes from source and destination files
366 $src =~ s/[\\\/]+$//;
367 $dest =~ s/[\\\/]+$//;
368
369 # a few sanity checks
370 if (-e $dest) {
371 # destination file already exists
372 return;
373 }
374 elsif (!-e $src) {
375 print STDERR "util::hard_link source file $src does not exist\n";
376 return 1;
377 }
378 elsif (-d $src) {
379 print STDERR "util::hard_link source $src is a directory\n";
380 return 1;
381 }
382
383 my $dest_dir = &File::Basename::dirname($dest);
384 mk_all_dir($dest_dir) if (!-e $dest_dir);
385
386 # link not supported on windows 9x
387 if (($ENV{'GSDLOS'} =~ /^windows$/i) && (Win32::FsType() !~ /^ntfs$/i)) {
388require Win32::Hardlink;
389 print STDERR "util::hard_link: win32: using copy for hard link.\n";
390 &File::Copy::copy ($src, $dest);
391 } else {
392 if (!link($src, $dest)) {
393 print STDERR "util::hard_link: unable to create hard link. ";
394 print STDERR " Attempting to copy file: $src -> $dest\n";
395 &File::Copy::copy ($src, $dest);
396 }
397 }
398 return 0;
399}
400
401# make soft link to file if supported by OS, otherwise copy file
402sub soft_link {
403 my ($src, $dest) = @_;
404
405 # remove trailing slashes from source and destination files
406 $src =~ s/[\\\/]+$//;
407 $dest =~ s/[\\\/]+$//;
408
409 # a few sanity checks
410 if (!-e $src) {
411 print STDERR "util::soft_link source file $src does not exist\n";
412 return 0;
413 }
414
415 my $dest_dir = &File::Basename::dirname($dest);
416 mk_all_dir($dest_dir) if (!-e $dest_dir);
417
418 # symlink not supported on windows
419 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
420 if ( (Win32::FsType() =~ /^ntfs$/i) &&
421 ($src =~ /^.:\\.*/) && ($dest =~ /^.:\\.*/) &&
422 (substr($src,0,3) eq substr($dest,0,3)) ) {
423 # if filesystem is NTFS and both source and destination is on the same local drive,
424 # use hardlink instead of symlink
425 #print STDERR "util::soft_link: win32: using hard link instead of soft ink.\n";
426 hard_link($src,$dest);
427 } else {
428 #print STDERR "util::soft_link: win32: using copy for soft link.\n ";
429 &File::Copy::copy ($src, $dest);
430 }
431
432 } elsif (!eval {symlink($src, $dest)}) {
433 print STDERR "util::soft_link: unable to create soft link.\n";
434 return 0;
435 }
436
437 return 1;
438}
439
440
441
442
443# updates a copy of a directory in some other part of the filesystem
444# verbosity settings are: 0=low, 1=normal, 2=high
445# both $fromdir and $todir should be absolute paths
446sub cachedir {
447 my ($fromdir, $todir, $verbosity) = @_;
448 $verbosity = 1 unless defined $verbosity;
449
450 # use / for the directory separator, remove duplicate and
451 # trailing slashes
452 $fromdir=~s/[\\\/]+/\//g;
453 $fromdir=~s/[\\\/]+$//;
454 $todir=~s/[\\\/]+/\//g;
455 $todir=~s/[\\\/]+$//;
456
457 &mk_all_dir ($todir);
458
459 # get the directories in ascending order
460 if (!opendir (FROMDIR, $fromdir)) {
461 print STDERR "util::cachedir could not read directory $fromdir\n";
462 return;
463 }
464 my @fromdir = grep (!/^\.\.?$/, sort(readdir (FROMDIR)));
465 closedir (FROMDIR);
466
467 if (!opendir (TODIR, $todir)) {
468 print STDERR "util::cacedir could not read directory $todir\n";
469 return;
470 }
471 my @todir = grep (!/^\.\.?$/, sort(readdir (TODIR)));
472 closedir (TODIR);
473
474 my $fromi = 0;
475 my $toi = 0;
476
477 while ($fromi < scalar(@fromdir) || $toi < scalar(@todir)) {
478# print "fromi: $fromi toi: $toi\n";
479
480 # see if we should delete a file/directory
481 # this should happen if the file/directory
482 # is not in the from list or if its a different
483 # size, or has an older timestamp
484 if ($toi < scalar(@todir)) {
485 if (($fromi >= scalar(@fromdir)) ||
486 ($todir[$toi] lt $fromdir[$fromi] ||
487 ($todir[$toi] eq $fromdir[$fromi] &&
488 &differentfiles("$fromdir/$fromdir[$fromi]","$todir/$todir[$toi]",
489 $verbosity)))) {
490
491 # the files are different
492 &rm_r("$todir/$todir[$toi]");
493 splice(@todir, $toi, 1); # $toi stays the same
494
495 } elsif ($todir[$toi] eq $fromdir[$fromi]) {
496 # the files are the same
497 # if it is a directory, check its contents
498 if (-d "$todir/$todir[$toi]") {
499 &cachedir ("$fromdir/$fromdir[$fromi]",
500 "$todir/$todir[$toi]", $verbosity);
501 }
502
503 $toi++;
504 $fromi++;
505 next;
506 }
507 }
508
509 # see if we should insert a file/directory
510 # we should insert a file/directory if there
511 # is no tofiles left or if the tofile does not exist
512 if ($fromi < scalar(@fromdir) && ($toi >= scalar(@todir) ||
513 $todir[$toi] gt $fromdir[$fromi])) {
514 &cp_r ("$fromdir/$fromdir[$fromi]", "$todir/$fromdir[$fromi]");
515 splice (@todir, $toi, 0, $fromdir[$fromi]);
516
517 $toi++;
518 $fromi++;
519 }
520 }
521}
522
523# this function returns -1 if either file is not found
524# assumes that $file1 and $file2 are absolute file names or
525# in the current directory
526# $file2 is allowed to be newer than $file1
527sub differentfiles {
528 my ($file1, $file2, $verbosity) = @_;
529 $verbosity = 1 unless defined $verbosity;
530
531 $file1 =~ s/\/+$//;
532 $file2 =~ s/\/+$//;
533
534 my ($file1name) = $file1 =~ /\/([^\/]*)$/;
535 my ($file2name) = $file2 =~ /\/([^\/]*)$/;
536
537 return -1 unless (-e $file1 && -e $file2);
538 if ($file1name ne $file2name) {
539 print STDERR "filenames are not the same\n" if ($verbosity >= 2);
540 return 1;
541 }
542
543 my @file1stat = stat ($file1);
544 my @file2stat = stat ($file2);
545
546 if (-d $file1) {
547 if (! -d $file2) {
548 print STDERR "one file is a directory\n" if ($verbosity >= 2);
549 return 1;
550 }
551 return 0;
552 }
553
554 # both must be regular files
555 unless (-f $file1 && -f $file2) {
556 print STDERR "one file is not a regular file\n" if ($verbosity >= 2);
557 return 1;
558 }
559
560 # the size of the files must be the same
561 if ($file1stat[7] != $file2stat[7]) {
562 print STDERR "different sized files\n" if ($verbosity >= 2);
563 return 1;
564 }
565
566 # the second file cannot be older than the first
567 if ($file1stat[9] > $file2stat[9]) {
568 print STDERR "file is older\n" if ($verbosity >= 2);
569 return 1;
570 }
571
572 return 0;
573}
574
575
576sub get_tmp_filename {
577 my $tmpdir = filename_cat($ENV{'GSDLHOME'}, "tmp");
578 &mk_all_dir ($tmpdir) unless -e $tmpdir;
579
580 my $count = 1000;
581 my $rand = int(rand $count);
582 while (-e &filename_cat($tmpdir, "F$rand")) {
583 $rand = int(rand $count);
584 $count++;
585 }
586
587 return filename_cat($tmpdir, "F$rand");
588}
589
590
591sub filename_cat {
592 my $first_file = shift(@_);
593 my (@filenames) = @_;
594
595 # Check for empty first filename
596 if ($first_file =~ /\S/) {
597 unshift(@filenames, $first_file);
598 }
599
600 my $filename = join("/", @filenames);
601
602 # remove duplicate slashes and remove the last slash
603 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
604 $filename =~ s/[\\\/]+/\\/g;
605 } else {
606 $filename =~ s/[\/]+/\//g;
607 # DB: want a filename abc\de.html to remain like this
608 }
609 $filename =~ s/[\\\/]$//;
610
611 return $filename;
612}
613
614
615sub envvar_prepend {
616 my ($var,$val) = @_;
617
618 my $current_val = $ENV{$var};
619
620 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
621 $ENV{$var} .= "$val;$current_val";
622 }
623 else {
624 $ENV{$var} .= "$val:$current_val";
625 }
626}
627
628sub envvar_append {
629 my ($var,$val) = @_;
630
631 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
632 $ENV{$var} .= ";$val";
633 }
634 else {
635 $ENV{$var} .= ":$val";
636 }
637}
638
639
640# returns the path of a file without the filename -- ie. the directory the file is in
641sub filename_head {
642 my $filename = shift(@_);
643
644 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
645 $filename =~ s/[^\\\\]*$//;
646 }
647 else {
648 $filename =~ s/[^\\\/]*$//;
649 }
650
651 return $filename;
652}
653
654
655# returns 1 if filename1 and filename2 point to the same
656# file or directory
657sub filenames_equal {
658 my ($filename1, $filename2) = @_;
659
660 # use filename_cat to clean up trailing slashes and
661 # multiple slashes
662 $filename1 = filename_cat ($filename1);
663 $filename2 = filename_cat ($filename2);
664
665 # filenames not case sensitive on windows
666 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
667 $filename1 =~ tr/[A-Z]/[a-z]/;
668 $filename2 =~ tr/[A-Z]/[a-z]/;
669 }
670 return 1 if $filename1 eq $filename2;
671 return 0;
672}
673
674sub filename_within_collection
675{
676 my ($filename) = @_;
677
678 my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
679
680 if (defined $collect_dir) {
681 my $dirsep = &util::get_dirsep();
682 if ($collect_dir !~ m/$dirsep$/) {
683 $collect_dir .= $dirsep;
684 }
685
686 $collect_dir =~ s/\\/\\\\/g; # escape DOS style file separator
687
688 if ($filename =~ /^$collect_dir(.*)$/) {
689 $filename = $1;
690 }
691 }
692
693 return $filename;
694}
695
696
697sub get_dirsep {
698
699 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
700 return "\\";
701 } else {
702 return "\/";
703 }
704}
705
706sub get_os_dirsep {
707
708 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
709 return "\\\\";
710 } else {
711 return "\\\/";
712 }
713}
714
715sub get_re_dirsep {
716
717 return "\\\\|\\\/";
718}
719
720
721# if this is running on windows we want binaries to end in
722# .exe, otherwise they don't have to end in any extension
723sub get_os_exe {
724 return ".exe" if $ENV{'GSDLOS'} =~ /^windows$/i;
725 return "";
726}
727
728
729# test to see whether this is a big or little endian machine
730sub is_little_endian {
731 # To determine the name of the operating system, the variable $^O is a cheap alternative to pulling it out of the Config module;
732 # What we do here is, if it is a Macintosh machine (i.e. the Darwin operating system), regardless it is running on the IBM power-pc cpu or it is the x86 Intel-based chip with a power-pc emulator running on top of it, it requires the big-endian data format in the gdbm database file, we make the file extension .bdb; otherwise it's .ldb extension.
733
734 #return 0 if $^O =~ /^darwin$/i;
735 return 0 if $ENV{'GSDLOS'} =~ /^darwin$/i;
736 return (ord(substr(pack("s",1), 0, 1)) == 1);
737}
738
739
740# will return the collection name if successful, "" otherwise
741sub use_collection {
742 my ($collection, $collectdir) = @_;
743
744 if (!defined $collectdir || $collectdir eq "") {
745 $collectdir = &filename_cat ($ENV{'GSDLHOME'}, "collect");
746 }
747
748 # get and check the collection
749 if (!defined($collection) || $collection eq "") {
750 if (defined $ENV{'GSDLCOLLECTION'}) {
751 $collection = $ENV{'GSDLCOLLECTION'};
752 } else {
753 print STDOUT "No collection specified\n";
754 return "";
755 }
756 }
757
758 if ($collection eq "modelcol") {
759 print STDOUT "You can't use modelcol.\n";
760 return "";
761 }
762
763 # make sure the environment variables GSDLCOLLECTION and GSDLCOLLECTDIR
764 # are defined
765 $ENV{'GSDLCOLLECTION'} = $collection unless defined $ENV{'GSDLCOLLECTION'};
766 $ENV{'GSDLCOLLECTDIR'} = &filename_cat ($collectdir, $collection);
767
768 # make sure this collection exists
769 if (!-e $ENV{'GSDLCOLLECTDIR'}) {
770 print STDOUT "Invalid collection ($collection).\n";
771 return "";
772 }
773
774 # everything is ready to go
775 return $collection;
776}
777
778sub hyperlink_text
779{
780 my ($text) = @_;
781
782 $text =~ s/(http:\/\/[^\s]+)/<a href=\"$1\">$1<\/a>/mg;
783 $text =~ s/(^|\s+)(www\.(\w|\.)+)/<a href=\"http:\/\/$2\">$2<\/a>/mg;
784
785 return $text;
786}
787
788
7891;
Note: See TracBrowser for help on using the repository browser.