/[socialtext-import]/tamtam/tamtam2socialtext.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /tamtam/tamtam2socialtext.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 9 by dpavlin, Wed Dec 12 13:22:32 2007 UTC revision 13 by dpavlin, Wed Dec 12 17:14:58 2007 UTC
# Line 11  use Encode; Line 11  use Encode;
11  use HTTP::Date;  use HTTP::Date;
12  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
13    
14  my $max = 5;  my $max = 999;
15    
16  my $page;  my $page;
17  my $page_date;  my $page_date;
# Line 40  find({ Line 40  find({
40                          $ref->{widgets}->{widget}->{Body}->{data} ||                          $ref->{widgets}->{widget}->{Body}->{data} ||
41                          die "no data in $path ",dump( $ref );                          die "no data in $path ",dump( $ref );
42    
43                    $data .= qq{
44    ----
45    
46    Original: http://www.razmjenavjestina.org/$path
47    };
48    
49                  $page->{ $name } = [ $data, $date ];                  $page->{ $name } = [ $data, $date ];
50    
51                  #warn dump( $ref );                  # strip path from page name
52                    $name =~ s,^.+/([^/]+)$,$1,;
53                    push @page_names, $name;
54    
55    #               warn dump( $ref );
56          },          },
57  }, shift @ARGV || '.');  }, shift @ARGV || '.');
58    
59  my @pages = ( keys %$page );  my @pages = ( keys %$page );
60    
61  warn "found following pages: ", join(", ", @pages),"\n";  warn "found following pages: ", join(", ", @page_names),"\n";
62    
63    my $page_link_re = '\b(' . join('|', @page_names) . ')\b';
64    
65  my $Rester = Socialtext::Resting->new(  my $Rester = Socialtext::Resting->new(
66          username => 'tamtam',          username => 'tamtam',
# Line 64  sub header { Line 76  sub header {
76                  my $level = length($1);                  my $level = length($1);
77                  return "\n" . ( '^' x $level ) . " $2\n";                  return "\n" . ( '^' x $level ) . " $2\n";
78          } else {          } else {
79                  die "can't parse header: $h";                  return $h;
80          }          }
81  }  }
82    
# Line 73  sub surround { Line 85  sub surround {
85          return $with . $what . $with;          return $with . $what . $with;
86  }  }
87    
88    sub pre {
89            my $text = shift;
90            $text =~ s/^{{{//;
91            $text =~ s/}}}$//;
92            return '.pre' . $text . '.pre';
93    }
94    
95  my $count = 0;  my $count = 0;
96    
97  foreach my $name ( keys %$page ) {  foreach my $name ( keys %$page ) {
# Line 87  foreach my $name ( keys %$page ) { Line 106  foreach my $name ( keys %$page ) {
106          $body =~ s/''''(.+?)''''/surround('`',$1)/gse;          $body =~ s/''''(.+?)''''/surround('`',$1)/gse;
107          $body =~ s/'''(.+?)'''/surround('*',$1)/gse;          $body =~ s/'''(.+?)'''/surround('*',$1)/gse;
108          $body =~ s/''(.+?)''/surround('_',$1)/gse;          $body =~ s/''(.+?)''/surround('_',$1)/gse;
109            $body =~ s/$RE{balanced}{-begin => "{{{"}{-end => "}}}"}{-keep}/pre($1)/gse;
110    
111          # fix bullets          # fix bullets
112          $body =~ s/^\s+([\*])/$1/gm;          $body =~ s/^\s+([\*])/$1/gm;
113    
114          # fix links          # fix links
115          $body =~ s/\["([^"]+)"\]/[$1]/gs;          $body =~ s/\["([^"]+)"\]/[$1]/gs;
116            $body =~ s,\[(http://\S+)\s+([^\]]+)\],"$2"<$1>,gs;
117            $body =~ s,\[(http://[^\]]+)\],$1,gs;
118            $body =~ s,$page_link_re,[$1],gs;
119    
120          Encode::_utf8_off( $body );          Encode::_utf8_off( $body );
121    
Legend:
Removed from v.9  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26